pascal快速排序问题
发布网友
发布时间:2024-09-26 22:27
我来回答
共2个回答
热心网友
时间:2024-10-06 06:42
program quicksort;
const maxn=10000;
type q=record
num:longint;
data:longint;
end;
var a:array [1..maxn] of q;
i,n:longint;
procedure switch(var a,b:q);
var x:q;
begin
x:=a;
a:=b;
b:=x;
end;
function compare(x,y:longint):boolean;
begin
if a[x].data>=a[y].data then exit(true);
exit(false);
end;
procedure mp(f,l:integer);
var i,j:integer;
begin
for i:=1 to l-f do
for j:=f to l-i do
if not compare(j,j+1) then
switch(a[j],a[j+1]);
end;
procedure kp(f,l:integer);
var i,j:integer;
x:longint;
begin
i:=f; j:=l;
randomize;
x:=random(l-f)+f;
repeat
while compare(i,x) do inc(i);
while compare(x,j) do dec(j);
if i<=j then
begin
switch(a[i],a[j]);
if x=i then x:=j
else if x=j then x:=i;
inc(i); dec(j);
end;
until i>j;
if i<l then
if l-i<=20 then mp(i,l)
else kp(i,l);
if f<j then
if j-f<=20 then mp(f,j)
else kp(f,j);
end;
begin
assign(input,'a.txt');
reset(input);
assign(output,'b.txt');
rewrite(output);
readln(n);
for i:=1 to n do
begin
read(a[i].data);
a[i].num:=i;
end;
kp(1,n);
for i:=1 to n do
writeln(a[i].data,' ',a[i].num);
close(input);
close(output);
end.
热心网友
时间:2024-10-06 06:43
我的程序短一点。
var
n,i:longint;
a,b:array [1..10000] of longint;
procedure sort(l,r: longint);
var
i,j,x,y: longint;
begin
i:=l;
j:=r;
x:=a[(l+r) div 2];
repeat
while a[i]<x do
inc(i);
while x<a[j] do
dec(j);
if not(i>j) then
begin
y:=a[i];
a[i]:=a[j];
a[j]:=y;
inc(i);
j:=j-1;
end;
until i>j;
if l<j then
sort(l,j);
if i<r then
sort(i,r);
end;
begin
readln(n);
for i:=1 to n do read(a[i]);
readln;
b:=a;
for i:=n downto 1 do write(a[i]);
writeln;
for i:=1 to n do write(b[i]);
writeln;
end.
热心网友
时间:2024-10-06 06:42
program quicksort;
const maxn=10000;
type q=record
num:longint;
data:longint;
end;
var a:array [1..maxn] of q;
i,n:longint;
procedure switch(var a,b:q);
var x:q;
begin
x:=a;
a:=b;
b:=x;
end;
function compare(x,y:longint):boolean;
begin
if a[x].data>=a[y].data then exit(true);
exit(false);
end;
procedure mp(f,l:integer);
var i,j:integer;
begin
for i:=1 to l-f do
for j:=f to l-i do
if not compare(j,j+1) then
switch(a[j],a[j+1]);
end;
procedure kp(f,l:integer);
var i,j:integer;
x:longint;
begin
i:=f; j:=l;
randomize;
x:=random(l-f)+f;
repeat
while compare(i,x) do inc(i);
while compare(x,j) do dec(j);
if i<=j then
begin
switch(a[i],a[j]);
if x=i then x:=j
else if x=j then x:=i;
inc(i); dec(j);
end;
until i>j;
if i<l then
if l-i<=20 then mp(i,l)
else kp(i,l);
if f<j then
if j-f<=20 then mp(f,j)
else kp(f,j);
end;
begin
assign(input,'a.txt');
reset(input);
assign(output,'b.txt');
rewrite(output);
readln(n);
for i:=1 to n do
begin
read(a[i].data);
a[i].num:=i;
end;
kp(1,n);
for i:=1 to n do
writeln(a[i].data,' ',a[i].num);
close(input);
close(output);
end.
热心网友
时间:2024-10-06 06:45
我的程序短一点。
var
n,i:longint;
a,b:array [1..10000] of longint;
procedure sort(l,r: longint);
var
i,j,x,y: longint;
begin
i:=l;
j:=r;
x:=a[(l+r) div 2];
repeat
while a[i]<x do
inc(i);
while x<a[j] do
dec(j);
if not(i>j) then
begin
y:=a[i];
a[i]:=a[j];
a[j]:=y;
inc(i);
j:=j-1;
end;
until i>j;
if l<j then
sort(l,j);
if i<r then
sort(i,r);
end;
begin
readln(n);
for i:=1 to n do read(a[i]);
readln;
b:=a;
for i:=n downto 1 do write(a[i]);
writeln;
for i:=1 to n do write(b[i]);
writeln;
end.