program RAZENI (input, output );
{ program umoznuje testovat zakladni algoritmz razeni }


const
     MAX = 10001;

type
    TYP_KLIC    = integer;
    TYP_HODNOTA = real;
    INDEX       = 0..MAX;
    PRVEK       = record KLIC : TYP_KLIC;
    {                     HODNOTA : TYP_HODNOTA}
                  end;
    POLE_PRVKU  = array [INDEX ] of  PRVEK;
    NORM = 1..8;

var A : POLE_PRVKU;
    HOD1,MIN1,SEC1,SSEC1,HOD2,MIN2,SEC2,SSEC2  :WORD;
    PPOR,PPRES : longint;
    I,N,OPAKUJ : integer;
    ZN : char;
    DRUHCIN : NORM;
    POKR : Boolean;

procedure RAZENI_VYBEREM (var A:POLE_PRVKU;        {Razene pole     }
                              N: INDEX             {Pocet prvku pole});
           {Procedura seradi pole vzestupne vyberem nejvetsiho prvku}

var I,J,M : INDEX;
    MAX   : TYP_KLIC;
    X     : PRVEK;

begin
  for I := N downto 2 do
    begin
    M := I;
    MAX := A[I].KLIC;
{    PPRES:=PPRES+1;}
    for J := 1 to I-1 do
     begin                  { výběr maximálního prvku }
      if A[J].KLIC > MAX then begin
                              M := J;
                              MAX := A[J].KLIC;
{                              PPRES:=PPRES+1}
                         end;
{      PPOR:=PPOR+1;}
     end;
    X := A[I];              { přesun maximálního prvku na konec pole }
    A[I] := A[M];
    A[M] := X;
{    PPRES:=PPRES+3;}
  end
end;  { konec procedury RAZENI_VYBEREM}


procedure BINARNI_VKLADANI(var A:POLE_PRVKU;  {Razene pole     }
                               N:INDEX       {Pocet prvku pole});

{Procedura seradi zadane pole metodou vkladani prvku.
 Vyhledani mista  vlozeni se provadi binarnim pulenim  }

var I,J,L,M,R : INDEX;
    X   : PRVEK;

begin
  for I := 2 to N do
  begin
    X := A[I];
    L:=1; R:=I-1;
    { nalezeni mista pro prvek X v poli A[L..R] }

    while L<=R do  
          begin
               M:= (L+R) div 2;
               if X.KLIC < A[M].KLIC then R:=M-1

                                     else L:=M+1
          end;
          { uvolneni mista pro vkladany prvek }

    for J:=I-1 downto L do A[J+1] := A[J];

    A[L]:= X                   { vlozeni prvku }
  end
end;  {konec procedury VKLADANI_VKLADANI }


procedure RAZENI_VKLADANIM (var A:POLE_PRVKU;  {Razene pole     }
                                N:INDEX       {Pocet prvku pole});

{Procedura seradi zadane pole metodou vkladani prvku }

var I,J : INDEX;
    X   : PRVEK;

begin
  for I := 2 to N do
  begin
    X := A[I];
    A[0] := X;                 { nastavení zarážky }
    J := I-1;
    ppres := ppres+1;
    
    while X.KLIC < A[J].KLIC do   { nalezeni mista pro vlozeni prvku }
          begin
               A[J+1] := A[J];ppres := ppres+1;
               J := J-1;
               PPOR := PPOR+1;
          end;
    A[J+1] := X; ppres := ppres+1;
    PPOR := PPOR+1;
                       { vlozeni prvku }
  end
end;  {konec procedury RAZENI_VKLADANIM }


procedure RAZENI_ZAMENOVANIM_1 (var A:POLE_PRVKU;      {Razene pole }
                                    N:INDEX        {Pocet prvku pole});

{ Procedura seradi zadane pole metodou jednosmerneho zamenovani }

var I,J : INDEX;
    X : PRVEK;

begin
  for I := 1 to N-1 do
    for J := 1 to N-I do
    begin
      if A[J].KLIC > A[J+1].KLIC then
                                 begin   { zamena sousednich prvku }
                                  X := A[J];
                                  A[J] := A[J+1];
                                  A[J+1] := X;
                                  PPRES := PPRES+3;
                                 end;
      PPOR:= PPOR+1;
    end;

end;  { konec predury RAZENI_ZAMENOVANIM 1}


procedure RAZENI_ZAMENOVANIM_2 (var A:POLE_PRVKU;      {Řzené pole }
                                    N:INDEX        {Počet prvků pole});

{ Procedura seřadí zadané pole metodou jednosměrného zaměňování }

var I,J,K,M : INDEX;
    X : PRVEK;

begin
  M := 2;
  repeat
  K:=N;
  for J := N  downto M do
    begin

      if A[J-1].KLIC > A[J].KLIC then
                                 begin   { záměna sousedních prvků }
                                  X := A[J];
                                  A[J] := A[J-1];
                                  A[J-1] := X;
                                  K := J;
{                                  PPRES := PPRES+3;}
                                 end;
{      PPOR:= PPOR+1;}
    end;
      M := K+1                 { uschování indexu poslední záměny prvků }
  until M >= N { průchod končí indexem poslední záměny v předchozím průchodu }

end;  { konec predury RAZENI_ZAMENOVANIM 2}


procedure SHELLSORT(var A:POLE_PRVKU;      {Řazené pole     }
                    N:integer              {Počet prvků pole});
 {Procedura seřadi zadané pole metodou Shell-sort}

const T=4;

var I,J,K,S : INDEX;
    M : 1..T;
    H : array[1..T] of integer;
    X : PRVEK;

begin
  H[1] := 9;
  H[2] := 5;
  H[3] := 3;
  H[4] := 1;
  for M := 1 to T do
  begin
    K := H[M];
    S := -K;
    for I := K+1 to N do
    begin
      X := A[I];
      J := I-K;
      if S=0 then S := -K;
      S := S+1;
      A[S] := X;
      while X.KLIC < A[J].KLIC do
      begin
        A[J+K] := A[J];
        J := J-K
      end;
      A[J+K] := X
    end
  end
end;  {Procedura SHELLSORT}


procedure HEAP_SORT (var A:POLE_PRVKU;      {Razene pole     }
                         N:integer          {Pocet prvku pole});

var K,R : INDEX;
    X : PRVEK;

  procedure ZARAD;  {Provede zarazeni jednoho prvku do hromady }

  label 1;

  var I,J : INDEX;

  begin
    I := K;
    J := 2*I;
    X := A[I];
    while J <= R do
    begin
      if J < R then if A[J].KLIC < A[J+1].KLIC
         then
         begin
           J := J+1;                 { výběr menšího ze synů }
           PPOR := PPOR+1;
         end;
      PPOR := PPOR+1;
      if X.KLIC >= A[J].KLIC then goto 1;   { zbytek je hromada }
      A[I] := A[J];                         { záměna syna a otce }
      PPRES := PPRES+1;
      I := J;                                 { postup k synovi }
      J := 2*I
    end;
    1:A[I] := X;
      PPRES := PPRES+1;
  end;  { konec pomocné procedury ZARAD}

begin

{ vytvoření hromady }
  K := (N div 2)+1;
  R := N;
  while K > 1 do
  begin
    K := K-1;
    ZARAD
  end;

 { přesun nejmenšího prvku na konec posloupnosti a zařazení posledního
   prvku do hromady }
  while R > 1 do
  begin
    X := A[1];
    A[1] := A[R];
    A[R] := X;
    R := R-1;
    ZARAD
  end
end;  { konec procedury HEAP_SORT}


procedure BOTTOM_UP_HEAP_SORT (var A:POLE_PRVKU;      {Razene pole     }
                                   N:integer          {Pocet prvku pole});


var K,R : INDEX;
    X : PRVEK;

function BIN ( I: Integer ): integer;
{ deleni  mocninou 2 }
var Pom :integer;
begin
     while I <> 0 do
           begin I:=I shr 1; Pom := Pom + 1; end;
     BIN := Pom
end;
procedure LEAF_SEARCH (L,R:integer;
                       var J:integer);
{ hleda  se list    }
begin
     J:= L;
     while 2*J < N do
           if A[2*J].KLIC < A[2*J+1].KLIC then J:=J*2
                                          else J:=J*2+1;
           if 2*J = R then J:=R
end;

procedure BOTTOM_UP_SEARCH ( L:integer;
                             var J:integer);
begin
     while (L < J) and ( A[L].KLIC < A[J].KLIC) do J:=J div 2;
end;
procedure INTERCHANGE(L,J:integer);
{ zamena x}
var X:PRVEK;
    P,K : integer;
begin
     P:= bin(J)-bin(L);
     X:= A[L];
     for K:= P-1 downto 0 do
         A[J shr (K+1)] := A[J shr K];
     A[J]:= X
end;
procedure BOTTOM_UP_REHEAP (L,R:integer);
var J: integer;
begin
     LEAF_SEARCH(L,R,J);
     BOTTOM_UP_SEARCH(L,J);
     INTERCHANGE(L,R)
end;
begin
 {}
  K := (N div 2)+1;
  R := N;
  while K > 1 do
  begin
    K := K-1;
    BOTTOM_UP_REHEAP(K,R)
  end;

 { přesun nejmenšího prvku na konec posloupnosti a zařazení posledního
   prvku do hromady }
  while R > 1 do
  begin
    X := A[1]; A[1] := A[R]; A[R] := X;
    R := R-1;
    BOTTOM_UP_REHEAP(K,R)
  end
end;  { konec procedury BOTTOM_UP_HEAP_SORT}



procedure QUICK_SORT(var A:POLE_PRVKU;         {Razene pole     }
                        N:integer          {Pocet prvku pole});
          {Procedura seradi zadane pole metodou Quick-sort}

  procedure TRIDENI(K,M:INDEX);

  var I,J : INDEX;
      W : PRVEK;
      X : TYP_KLIC;

  begin
    I := K;
    J := M;
    X := A[(K+M) div 2].KLIC;      { výběr pivota }
    repeat
      while A[I].KLIC < X do begin I := I+1;PPOR:=PPOR+1 end;
      while X < A[J].KLIC do begin J := J-1;PPOR:=PPOR+1 end;
      if I <= J then begin         { záměna prvků }
                     W := A[I];
                     A[I] := A[J];
                     A[J] := W;
                     I := I+1;    PPRES:=PPRES+3;
                     J := J-1
                   end;
    until I > J;
    if K < J then TRIDENI(K,J);
    if I < M then TRIDENI(I,M)
  end;  {konec pomocné procedury TRIDENI }

begin
  TRIDENI(1,N)
end;  {konec procedury QUICK_SORT}






procedure  MERGE_SORT (var A:POLE_PRVKU;     {Razene pole     }
                           N:INDEX           {Pocet prvku pole});
{Procedura seřadi zadané pole metodou slučováni po 2,4,8,.. prvcích}

var I,J,          { indexy prvku ve zdrojovych polich }
    K,L,          { indexy prvku v cilovych polich }
    P,            { pocet prvku p-tice }
    Q,R,          { pocty prvku, ktere zbyva sloucit v p-tici }
    M,            { kolik prvku zbyva celkem }
    H,            { smer ukladani v cilovem poli }
    POM : INDEX;
    NAHORU : Boolean;
    B : array [0..2*MAX] of PRVEK;    { pomocne pole }

begin

  for I:=1 to N do B[I]:=A[I]; { kopírování pole A do pomocného pole B }
  NAHORU := true;
  P := 1;
  repeat
    H := 1;
    M := N;
    if NAHORU then
               begin
                 I := 1;  { počáteční hodnoty indexů ve zdrojovém poli}
                 J := N;
                 K := N+1;  { počáteční hodnoty indexů v cílovém poli }
                 L := 2*N
               end
              else
               begin
                 K := 1;   { počáteční hodnoty indexů ve zdrojovém poli}
                 L := N;
                 I := N+1;   { počáteční hodnoty indexů v cílovém poli }
                 J := 2*N
               end;
    repeat
      if M >= P then Q := P
                else Q := M;
      M := M-Q;
      if M >= P then R := P
                else R := M;
      M := M-R;

     { slučování dílčích posloupností délky R a Q }

      while (Q <> 0)and(R <> 0) do
      begin
        if B[I].KLIC < B[J].KLIC
                    then
                         begin
                             B[K] := B[I];
                             K := K+H;
                             I := I+1;
                             Q := Q-1
                         end
                    else
                         begin
                             B[K] := B[J];
                             K := K+H;
                             J := J-1;
                             R := R-1
                         end;
       PPOR:=PPOR+1;PPRES:=PPRES+1;
     end;

{ kopírování  nesloučeného zbytku jedné z dílčích posloupností }

      while R <> 0 do
            begin
                 B[K] := B[J];
                 K := K+H;
                 J := J-1;
                 R := R-1;
                 PPRES:=PPRES+1;
            end;

      while Q <> 0 do
            begin
               B[K] := B[I];
               K := K+H;
               I := I+1;
               Q := Q-1;
               PPRES:=PPRES+1;
            end;

    { zmena smeru ukladani v cilovem poli }

      H := -H;     
      POM := K; K := L; L := POM;

    until M = 0; { všechny dílčí posloupnosti délky P jsou sloučeny }

    NAHORU := not NAHORU;
    P := 2*P;
  until P >= N;   { celé pole je jediná dílčí posloupnost }

 { kopírování z pomocného pole B do pole A }

  if not NAHORU then for I := 1 to N do A[I] := B[I+N]
                else for I := 1 to N do A[I] := B[I] ;

  PPRES:=PPRES+N;
end;  {konec procedury RAZENI SLUCOVANIM}






procedure RADIX_SORT (var A:POLE_PRVKU;       {Razene pole     }
                          N:INDEX             {Pocet prvku pole});

{ Procedura seřadí zadané pole postupným tříděním podle číslic v jednotlivých řádech
  celočíselného klíče počínaje nejnižsím řádem klíče }

const ZAKLAD   = 10;
      MAXCIF   = 9;
      PRAZDNY  = 0;

var B :POLE_PRVKU;                                   { pomocné pole prvků }
    P :array [INDEX] of INDEX;         {Pole ukazatelů na následující prvek}
    KONFRONTY : array[-ZAKLAD..MAXCIF] of INDEX;
    ZACFRONTY : array[-ZAKLAD..ZAKLAD] of INDEX;
    RAD,MAXIM,POCCIF,CIF,UKMIN,I,J : integer;
    WP : PRVEK;
    W,SEZNAM,POM : INDEX;

begin                   {Inicializace pomocnych promenych}
  RAD := 1;
  SEZNAM := N;
  { nalezení maximální hodnoty klíče }

  MAXIM := abs(A[1].KLIC);
  for I := 2 to N do if MAXIM < abs(A[I].KLIC) then MAXIM := abs(A[I].KLIC);

  { výpočet délky maximálního klíče }

  POCCIF := 0;
  while MAXIM<>0 do
  begin
    MAXIM := MAXIM div ZAKLAD;
    POCCIF := succ(POCCIF)
  end;
  { pocatecni zretezeni v poli P }

  for I:= N downto 2 do P[I] := I-1;
  P[1] := PRAZDNY;

  { začátek třídění }

  for J := 1 to POCCIF do
  begin
    {Inicializace pole ZACFRONTY}
    for I := -ZAKLAD to ZAKLAD do ZACFRONTY[I] := PRAZDNY;

    {Třídění podle J-té číslice}
    repeat
      if A[SEZNAM].KLIC>=0
       then CIF := (A[SEZNAM].KLIC mod (ZAKLAD*RAD)) div RAD
       else CIF := -(abs(A[SEZNAM].KLIC mod (ZAKLAD*RAD)) div RAD) -1;

       PPOR:=PPOR+1;

      if ZACFRONTY[CIF]=PRAZDNY then begin       {Fronta je prázdná}
				      ZACFRONTY[CIF] := SEZNAM;
				      KONFRONTY[CIF] := SEZNAM
				    end
			       else begin       {Fronta je neprázdná}
				      P[KONFRONTY[CIF]] := SEZNAM;
				      KONFRONTY[CIF] := SEZNAM
				    end;
      SEZNAM := P[SEZNAM];   { dalsi prvek seznamu }
    until SEZNAM = PRAZDNY;

    RAD := RAD*ZAKLAD;     { další řád klíče }
    I := -ZAKLAD;
    while ZACFRONTY[I]=PRAZDNY do I := I + 1;
    UKMIN := I;
    repeat                      {Spojení front do jediného seznamu}
      POM := KONFRONTY[I];
      I := I + 1;
      while (I <> ZAKLAD) and (ZACFRONTY[I] = PRAZDNY) do I := I + 1;
      P[POM] := ZACFRONTY[I]
    until I=ZAKLAD;
    SEZNAM := ZACFRONTY[UKMIN]
  end;                          { konec třídění }

 {
  for I := 1to N do
  begin
    B[I] := A[SEZNAM];
    SEZNAM := P[SEZNAM]
  end;
  for I := 1 to N do A[I] := B[I]
}

  { prechod od spojoveho seznamu k sekvencni posloupnosti }

  begin
    J:=1;             { index v poli A }
    W:=SEZNAM;
    while J<N do
      begin
        while W<J do         { nenicit zacatek pole A }
                    W:=P[W];
        WP := A[W];          { zamena prvku }
        A[W] := A[J];
        A[J] := WP;
        POM  := P[W];         { zamena ukazatelu }
        P[W] := P[J];
        P[J] := W;

        PPRES:= PPRES+3;

        J := J+1; W := POM;   { dalsi prvek }
      end;
  end;
 
end;  { konec procedurz RADIX SORT}






procedure VZESTUP(var A:POLE_PRVKU ;N:integer);
begin
  for I := 1 to N do A[I].KLIC := I
end;

procedure SESTUP(var A:POLE_PRVKU ;N:integer);
begin
  for I := 1 to N do A[I].KLIC := N-I
end;

procedure NAHOD(var A:POLE_PRVKU; N:integer);
begin

    RANDOMIZE;
for I := 1 to N do A[I].KLIC := RANDOM(1000)
end;

procedure TISK(var A:POLE_PRVKU ;N:integer);
begin
  writeln;
  for I := 1 to N do write(A[I].KLIC,'  ');
  writeln
end;

procedure HELP;
begin
  writeln;
  writeln(' VZESTUP-naplni pole vzestupnymi hodnotami');
  writeln(' NAHOD-naplni pole nahodnymi hodnotami');
  writeln(' SESTUP-naplni pole sestupnymi hodnotami');
  writeln(' TISK-vytiskne dane pole na terminal');
  writeln(' MENU-nabizi moznosti dalsi prace');
  writeln;
  writeln('       Po stisknuti ENTER dalsi cinnost');
  repeat
  until KeyPressed;
end;



procedure MENU;
begin
  writeln;
  writeln('1-Prislusne razeni');
  writeln('2-Inicializace daneho pole nahodnymi hodnotami');
  writeln('3-Inicializace daneho pole sestupnymi hodnotami');
  writeln('4-Inicializace daneho pole vzestupnymi hodnotami');
  writeln('5-Tisk daneho pole');
  writeln('6-Novy pocet prvku pole');
  writeln('7-HELP');
  writeln('8-Konec prace')
end;

begin

  POKR := false;
  ClrScr;
  HELP;

  ClrScr;
  write('Zadej pocet prvku pole (maximalne   ',MAX,') :  ');
  read(N);
  MENU;
  repeat
{    write('Dle menu zadej dalsi druh cinnosti : '); }
    read(DRUHCIN);
{    ClrScr; }

    case DRUHCIN of
    1:begin
        GetTime(hod1,min1,sec1,ssec1);

        for OPAKUJ:= 1 to 1 do
          begin
           PPRES:=0; PPOR:=0;
           NAHOD(A,N);
           RADIX_SORT(A,N); {Doplnit zadanou proceduru}
          end;

        GetTime(hod2,min2,sec2,ssec2);
        writeln('n= ',N,' ppor= ',PPOR,' ppres= ',PPRES);
        writeln('cas pred ',hod1,min1,sec1,'  ',ssec1);
        writeln('cas po=  ',hod2,min2,sec2,'  ',ssec2);
      end;
    2:NAHOD(A,N);
    3:SESTUP(A,N);
    4:VZESTUP(A,N);
    5:TISK(A,N);
    6:begin
	writeln;
	write('Zadej novy pocet prvku pole maximalne  ',MAX,' : ');
        read(N);
	writeln
      end;
    7:HELP;
    8:POKR := true;
    end;

 { MENU;}

  until POKR
end.