Question

Алгоритм сортировки фон Неймана. Упорядочить массив а1, а2, ..., ат по неубыванию с алгоритма сортировки слияниями:

Answer 1

uses crt;
type mas=array[0..100] of integer;
procedure MergeSort(var m:mas;n:integer);
var
c:boolean;
i,i1,i2,n1,n2,j,k,tmp,len:integer;
b:mas;
begin
len:=1;
c:=true;
while len<n do
 begin
  if c then
   begin
    i:=0;
    while i+len<=n do
     begin
      i1:=i+1;
      i2:=i+len+1;
      n1:=i+len;
      n2:=i+2*len;
      if n2>n then
       begin
        n2:=n;
       end;
      while(i1<=n1)or(i2<=n2)do
       begin
        if i1>n1 then
         begin
          while i2<=n2 do
           begin
            i:=i+1;
            b[i-1]:=m[i2-1];
            i2:=i2+1;
           end;
         end
        else
         begin
          if i2>n2 then
           begin
            while i1<=n1 do
             begin
              i:=i+1;
              b[i-1]:=m[i1-1];
              i1:=i1+1;
             end;
            end
          else
           begin
            if m[i1-1]>m[i2-1] then
             begin
              i:=i+1;
              b[i-1]:=m[i2-1];
              i2:=i2+1;
             end
            else
             begin
              i:=i+1;
              b[i-1]:=m[i1-1];
              i1:=i1+1;
             end;
           end;
         end;
       end;
     end;
    i:=i+1;
    while i<=n do
     begin
      b[i-1]:=m[i-1];
      i:=i+1;
     end;
   end
  else
   begin
    i:=0;
    while i+len<=n do
     begin
      i1:=i+1;
      i2:=i+len+1;
      n1:=i+len;
      n2:=i+2*len;
      if n2>n then
       begin
        n2:=n;
       end;
      while (i1<=n1)or(i2<=n2)do
       begin
        if i1>n1 then
         begin
          while i2<=n2 do
           begin
            i:=i+1;
            m[i-1]:=b[i2-1];
            i2:=i2+1;
           end;
         end
        else
         begin
          if i2>n2 then
           begin
            while i1<=n1 do
             begin
              i:=i+1;
              m[i-1]:=b[i1-1];
              i1:=i1+1;
             end;
           end
          else
           begin
            if b[i1-1]>b[i2-1] then
             begin
              i:=i+1;
              m[i-1]:=b[i2-1];
              i2:=i2+1;
             end
            else
             begin
              i:=i+1;
              m[i-1]:=b[i1-1];
              i1:=i1+1;
             end;
           end;
         end;
       end;
     end;
    i:=i+1;
    while i<=n do
     begin
      m[i-1]:=b[i-1];
      i:=i+1;
     end;
   end;
   len:=2*len;
   c:= not c;
  end;
 if not c then
  begin
   i:=1;
   repeat
   m[i-1]:=b[i-1];
   i:=i+1;
   until not(i<=n);
  end;
end;
var a:mas;
    n,i:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
writeln('Исходный массив:');
for i:=0 to n-1 do
 begin
  a[i]:=random(20);
  write(a[i],' ');
 end;
writeln;
MergeSort(a,n);
writeln('Сортировка:');
for i:=0 to n-1 do
write(a[i],' ');
readln
end.