Скачиваний:
21
Добавлен:
01.05.2014
Размер:
1.82 Кб
Скачать
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

left [1]:=1;
right [1]:=n;
sp:=1;

while sp>0 do
begin

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;

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

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

swap(x[i ], x[ j ]) ;
end;
end;
end;

pivot:=x[j ];
while i<j do begin
while x[i]<pivot do begin
i:=i+1;
end;

j:=j-1;
while (i<j)and(pivot<x[j]) do begin
j:=j-1;
end;

if i<j then swap(x[i],x[j ]) ;

end;

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;

end;
end;

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
sample(name, 1);
randomize;
sample(name, 2);
init (a, n);
sample(name, 3);
qsort(a, n);
sample(name, 4);
verify (a, n);
sample(name, 5);
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