program ind;                      {Demonstrate the HeapSort algorithm}
{$N+,E+}
uses CRT, nothy;
{$I GetInput.i }

type
Sequence = array[1..10000] of longint;

var
p,                                {the modulus; presumed to be prime}
g,                                {the base; presumed to be a primitive root}
h,                                {gh ð 1 (mod p)}
a,                                {number whose index is sought}
c,                                {g^s (mod p)}
d,                                {g^(i*s) (mod p)}
i                                 {exponent is  i*s + j}
  : comp;
z                                 {variable used for testing inputs}
  : extended;
B                                 {the sequence to be sorted}
  : Sequence;
Index                             {original index of member of sorted array}
  : array[1..10000] of integer;
j,                                {an index of terms in the sequence}
j0,                               {index returned by Search}
s                                 {the number of terms in the sequence}
  : integer;
t                                 {temporary variable used for swapping}
  : longint;
InputOk
  : Boolean;
code                              {error level when reading inputs}
  : word;

procedure HeapSort;

var
  i
  : integer;

procedure Drop(i, k : integer);

var
i0,
i1,
j,
t,
t1
   : longint;

begin
  i1 := i;
  t  := B[i];
  t1 := Index[i];
  repeat
    i0 := i1;
    j := 2*i1;
    if (j = k) and (B[k] > B[t])
    then
      begin
        B[i1] := B[k];
        Index[i1] := Index[k];
        i1 := k
      end;
    if j < k
    then
      begin
        if B[j+1] > B[j]
        then j := j + 1;
        if B[j] > t
        then
          begin
            B[i1] := B[j];
            Index[i1] := Index[j];
            i1 := j
          end
      end;
  until i0 = i1;
  B[i1] := t;
  Index[i1] := t1
end;                              {of Drop}

begin                             {main body of HeapSort}
  for i := s div 2 downto 1 do Drop(i, s);
  for i := s downto 2 do
    begin
      t := B[i];
      B[i] := B[1];
      B[1] := t;
      t := Index[i];
      Index[i] := Index[1];
      Index[1] := t;
      if i > 2
      then Drop(1, i-1)
    end
end;                              {of HeapSort}

function Search(d : comp) : integer;
                                  {Search for d in array B, return Index
                                   if found; else return -1}
var
i0,                               {lower endpoint of window}
i1,                               {upper endpoint of window}
im,                               {middle of window}
j                                 {the index sought}
  : integer;

begin
  if d = B[1]
  then
    begin
      Search := Index[1];
      Exit
    end;
  if d = B[s]
  then
    begin
      Search := Index[s];
      Exit
    end;
  if d < B[1]
  then
    begin
      Search := -1;
      Exit
    end;
  if d > B[s]
  then
    begin
      Search := -1;
      Exit
    end;
  i0 := 1;
  i1 := s;
  j := -1;
  repeat
    im := (i0+i1) div 2;
    if d = B[im]
    then j := Index[im];
    if d < B[im]
    then i1 := im;
    if d > B[im]
    then i0 := im
  until (j >= 0) or (i1 - i0 = 1);
  Search := j
end;                              {of function Search}


begin                             {main}
  InputOk := False;
  if ParamCount = 3
  then
    begin
      InputOk := True;
      Val(ParamStr(1), z, code);
      if (Abs(z) <= 999999999) and (frac(z) = 0) and (code = 0)
      then g := z
      else InputOk := False;
      Val(ParamStr(2), z, code);
      if (Abs(z) <= 999999999) and (frac(z) = 0) and (code = 0)
      then a := z
      else InputOk := False;
      Val(ParamStr(3), z, code);
      if (z > 1) and (z <= 999999999) and (frac(z) = 0) and (code = 0)
      then p := z
      else InputOk := True
    end;
  if not InputOk
  then
    begin
      WriteLn;
      Write('Will solve g');
      GoToXY(WhereX, WhereY-1);
      Write('x');
      GoToXY(WhereX, WhereY+1);
      WriteLn(' ð a (mod p), so that x = ind a.');
      g := GetInput(WhereX, WhereY, 'Enter g = ', '   (|g| ó 999999999)',
                    -999999999, 999999999);
      a := GetInput(WhereX, WhereY, 'Enter a = ', '   (|a| ó 999999999)',
                    -999999999, 999999999);
      p := GetInput(WhereX, WhereY, 'Enter p = ', ' (2 ó p ó 999999999)',
                    2, 999999999);
      for j := 1 to 6 do
        begin
          ClrEoL;
          GoToXY(1, WhereY - 1)
        end;
      WriteLn
    end;
  WriteLn;
  z := gcd(g, p);
  if z > 1
  then
    begin
      WriteLn('ERROR!  This program works only when (g, p) = 1, but');
      WriteLn('(', g:1:0, ', ', p:1:0, ') = ', z:1:0, ' > 1.');
      Halt
    end;
  if gcd(a, p) > 1
  then
    begin
      Write(a:1:0, ' is not a power of ', g:1:0);
      WriteLn(' modulo ', p:1:0, '.');
      Halt
    end;
  lincon(g, 1, p, h, p);      {gh ð 1 (mod p)}
  if p > 100000000
  then s := 10000
  else s := round(sqrt(p));
  if s < 3
  then s := 3;
  B[1] := round(condition(a, p));
  Index[1] := 0;
  for j := 2 to s do
    begin
      Index[j] := j - 1;
      B[j] := round(mult(B[j-1], h, p));
      if B[j] = 1
      then
        begin
          Write(g:1:0);
          GoToXY(WhereX, WhereY-1);
          Write((j-1):1);
          GoToXY(WhereX, WhereY+1);
          WriteLn(' ð ', a:1:0, ' (mod ', p:1:0, ')');
          Halt
        end;
      if B[j] = B[1]
      then
        begin
          Write(a:1:0, ' is not a power of ', g:1:0);
          WriteLn(' modulo ', p:1:0, '.');
          Halt
        end
    end;
  HeapSort;
  i := 1;
  c := power(g, s, p);
  d := c;
  while i*s <= p do
    begin
      j0 := Search(d);
      if j0 >= 0
      then
        begin
          Write(g:1:0);
          GoToXY(WhereX, WhereY-1);
          Write((i*s + j0):1:0);
          GoToXY(WhereX, WhereY+1);
          WriteLn(' ð ', a:1:0, ' (mod ', p:1:0, ')');
          Halt
        end;
      d := mult(c, d, p);
      i := i + 1
    end;
  Write(a:1:0, ' is not a power of ', g:1:0);
  WriteLn(' modulo ', p:1:0, '.')
end.