Скачиваний:
21
Добавлен:
01.05.2014
Размер:
1.97 Кб
Скачать
program prog_pas;
uses sampler;
const
N = 100;
name = 'QS.pas';
type
TArray = array [1..N] of real;
procedure swap(var p,q: real);
var hold : real ;
begin
hold:=p;
p:=q;
q:=hold
end;
procedure qsort(var x: TArray; n: integer);
var left , right : array[1..20] of integer ;
i , j ,sp,mid : integer ;
pivot : real ;

begin
sample(name, 11);
left [1]:=1;
right [1]:=n;
sp:=1;
sample(name, 12);
while sp>0 do
begin
sample(name, 13);
if left [sp]>=right[sp] then begin
sp:=sp-1
end
else begin
i:=left [sp ];
j:=right[sp ];
pivot:=x[j ];
mid:=(i+j)div 2;
sample(name, 14);
if ( j-i)>5 then begin
if ((x[mid]<pivot)and(x[mid]>x[i])) or ((x[mid]>pivot)and(x[mid]<x[i])) then
begin
sample(name, 15);
swap(x[mid],x[j ])
end
else begin
if ((x[ i]<x[mid])and(x[i]>pivot)) or ((x[i]>x[mid])and(x[i]<pivot)) then begin
sample(name, 16);
swap(x[i ], x[ j ]) ;
end;
end;
end;
sample(name, 17);
pivot:=x[j ];
while i<j do begin
while x[i]<pivot do begin
i:=i+1;
end;
sample(name, 19);
j:=j-1;
while (i<j)and(pivot<x[j]) do begin
j:=j-1;
end;
sample(name, 20);
if i<j then swap(x[i],x[j ]) ;
sample(name, 21);
end;
sample(name, 22);
j:=right[sp ]; { pivot to i }
swap(x[i ], x[ j ]) ;
if i-left [sp]>=right[sp]-i then begin
left [sp+1]:=left[sp ];
right [sp+1]:=i-1;
left [sp]:=i+1
end
else begin
left [sp+1]:=i+1;
right [sp+1]:=right[sp];
right [sp]:=i-1
end;
sp:=sp+1;
sample(name, 23);
end;
end;
sample(name, 24);
end;
function verify(var x: TArray; dim: integer) : boolean;
var
i : integer ;
begin
i := 1;
while (x[i] <= x[i+1]) and (i+1 <= dim) do begin
i := i+1;
end;
if ( i = dim) then
verify := true
else
verify := false ;
end;

procedure init(var x: TArray; dim: integer);
var
i : integer ;
begin
for i := 1 to dim do begin
x[ i ] := random(100);
end;
end;


var
a: TArray;
t : integer ;
begin

randomize;

init (a, n);

qsort(a, n);

verify (a, n);

end.
Соседние файлы в папке pas
  • #
    01.05.20143.57 Кб21QS.SMP
  • #
    01.05.2014458 б21QS.SMV
  • #
    01.05.20141.82 Кб21QS1.PAS
  • #
    01.05.20141.34 Кб21QS1.SMP
  • #
    01.05.2014172 б21QS1.SMV
  • #
    01.05.20141.97 Кб21QS2.PAS
  • #
    01.05.20142.86 Кб21QS2.SMP
  • #
    01.05.2014373 б21QS2.SMV