Множество сортировок — Pascal(Паскаль)

program Project_1;

{$APPTYPE CONSOLE}

uses
 SysUtils;

procedure change(var x,y: integer);
var
  b: integer;
begin
  b:= x;
  x:= y;
  y:= b;
end;

procedure ReadArray(FileName:string; var A:array of integer; var N:integer);
var
 f: text;
begin
 N:= 0;
 AssignFile(f, FileName);
 Reset(f);
 while not eof(f) do
 begin
   readln(f, A[N]);
   N:= N+1;
 end;
 CloseFile(f);
end;

procedure SimpleExchange(var A: array of integer; var N: integer;
                         var S, P: integer);
var
 i, j, b: integer;
begin
 P:= 0; S:= 0;
 for i:= 0 to N-2 do
 begin
   for j:= 0 to N-2 do
   begin
     inc(S);
     if A[j] > A[j+1] then change(A[j], A[j+1]);
     inc(P);
   end;
 end;
end;

procedure SimpleSelection(var A: array of integer; var N: integer; var
S, P: integer);
var
 j, i,k, min: integer;
begin
  S:= 0; P:= 0;
  for i:= 0 to N-2 do
  begin
    k:= i;
    min:= a[i];
    inc(S);
    for j:= i to N-1 do
    if a[j]< min then
    begin
      min:= A[j];
      k:= j;
    end;
    a[k]:= a[i];
    a[i]:= min;
    inc(P);
  end;
end;

procedure SimpleInsertion(var A: array of integer; var N: integer; var
S, P: integer);
var
 j, i, b: integer;
begin
 P:= 0;  S:= 0;
 for i:= 1 to N-1 do
 begin
   for j:=i downto 1 do
   begin
     inc(S);
     if A[j] < A[j-1] then
     begin
       change(a[j], a[j-1]);
       inc(P);
     end
     else break;
   end;
 end;
end;

procedure HeapStep(var A: array of integer; N,i:integer; var S,P: integer);
var
  k: integer;
begin
  if (2*i+1)>=N then exit;
  if (2*i+2)>=N then k:= 2*i+1
  else
  begin
    inc(S);
    if A[2*i+1]> A[2*i+2] then k:= 2*i+1
    else k:= 2*i+2;
  end;
  inc(S);
  if A[i]<A[k] then
  begin
    inc(P);
    change(A[i],A[k]);
    HeapStep(A,N,S,P,K);
  end;
end;

procedure HeapSort(var A: array of integer; var N: integer; var S, P: integer);
var
  i: integer;
begin
  for i:= N div 2 downto 0 do HeapStep(A,N,S,P,i);
  for i:= N-1 downto 1 do
  begin
    inc(P);
    change(A[0], A[i]);
    HeapStep(A,i,0,S,P);
  end;
end;

procedure SheikerSort(var A: array of integer; var N: integer; var S, P: integer);
var
  i,j,l, min, max: integer;
begin
  for i:=0 to N div 2 do
  begin
    if A[i]>A[i+1] then
    begin
      min:= i+1;
      max:= i;
    end
    else
    begin
      min:= i;
      max:= i+1;
    end;
    for j:= i+2 to N-i do
    if A[j]>A[max] then max:= j
    else if A[j]<A[min] then min:=j;
    inc(P);
    change(A[i], A[min]);
    if max=i then max:= min;
    inc(P);
    change(A[N-i], A[max]);
  end;
end;

procedure ShellSort(var A: array of integer; var N: integer; var S, P: integer);
var
  i,b,h,j:integer;
begin
  b:= N-1;
  h:= b div 2;
  while h>=1 do
  begin
    for i:= 0 to b-h do
    begin
      j:= i;
      inc(S);
      while (A[j]> A[j+h]) do
      begin
        change(A[j],A[j+h]);
        inc(P);
        dec(j);
      end;
    end;
    h:= h div 2;
  end;
end;

procedure sort(var A: array of integer; l,r: integer; var S,P:integer);
var
  i,j,x: integer;
begin
  i:= l;
  j:= r;
  x:= a[(i+j) div 2];
  repeat
    while a[i]<x do inc(i);
    while a[j]>x do dec(j);
    inc(S);
    if j>=i then
    begin
      inc(P);
      change(a[i], a[j]);
      inc(i);
      dec(j);
    end;
  until i>j;
  inc(S);
  if l<j then sort(A,l,j,S,P);
  inc(S);
  if i<r then sort(A,i,r,S,P);
end;

procedure QuickSort(var A: array of integer; var N: integer; var S, P: integer);
begin
  sort(A,0, N-1,S,P);
end;



procedure WriteArray(FileName: string; var A: array of integer; N: integer);
var
 f: text;
 i: integer;
begin
 assignFile(f, FileName);
 rewrite(f);
 for i:= 0 to N-1 do
 begin
   writeln(f, A[i]);
 end;
 closefile(f);
end;

var
 B: array[0..10000] of integer;
 N: integer;
 S,P: integer;
 q: integer;
begin
  ReadArray('task.txt', B, N);

  writeln('1 - simpleexchange; 2 - simpleselection; 3 - simpleinsertion; 4-piramida; 5-sheikersort; 6-shellsort; 7-quicksort');
  readln(q);

  case q of
    1:  SimpleExchange(B, N, S, P);
    2:  SimpleSelection(B, N, S, P);
    3:  SimpleInsertion(B, N, S, P);
    4:  HeapSort(B,N,S,P);
    5:  SheikerSort(B,N,S,P);
    6:  ShellSort(B,N,S,P);
    7:  QuickSort(B,N,S,P);
  end;
  writeln('izpildito salidzinajumu skaits = ', S);
  writeln('izpildito parvietojumu skaits = ', P);

  WriteArray('ok.txt', B, N);
  readln;
end.

Leave a Comment

6 + 1 =