Program Algorithm;

{ Batcher's parallel method.
  Algorithm M on page 111 of "The Art of Computer Programming"
  volume 3 / "Sorting and Searching" by Donald E. Knuth. }

const
  N = 25;
var
  rij : array[1..N] of word;
  m : word;

function grens(w : word) : word;

var
  p, g : word;

begin
  grens := 0;
  if w = 0 then Exit;
  g := 1;
  p := w - 1;
  while p > 0 do
  begin
    p := p shr 1;
    if p = 0 then Break;
    g := g shl 1;
  end;
  grens := g;
end;

procedure Batchers;

var
  t : byte;
  p, q, r, i, d, c : word;
  uit : boolean;

begin
  p := grens(N);
  while p > 0 do
  begin
    q := grens(N);
    d := p;
    r := 0;
    repeat
      for i := 0 to (N-d-1) do
      begin
        if ((i and p) = r) then
        begin
          if rij[i+1] > rij[i+d+1] then
          begin
            c := rij[i+d+1];
            rij[i+d+1] := rij[i+1];
            rij[i+1] := c;
          end;
        end;
      end;
      uit := (p = q);
      d := q - p;
      q := q shr 1;
      r := p;
    until uit;
    p := p shr 1;
  end;
end;

{ *********************** }

begin
  m := Random(3*N)+1;
  for m := 1 to N do
  begin
    rij[m] := Random(3*N)+1;
  end;
  for m := 1 to N do
    Write(rij[m],' ');
  Writeln;

  Batchers;

  for m := 1 to N do
    Write(rij[m],' ');
  Writeln;
end.