var
temp:integer;
begin
temp:=x;
x:=y;
y:=temp;
end;
//冒泡排序
procedure BubbleSort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := High(A) downto Low(A) do
for J := Low(A) to High(A) - 1 do
if A[J] > A[J + 1] then
begin
swap(A[J], A[J + 1]);
T := A[J];
A[J] := A[J + 1];
A[J + 1] := T;
end;
end;
//選擇排序
procedure SelectionSort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := Low(A) to High(A) - 1 do
for J := High(A) downto I + 1 do
if A[I] > A[J] then
begin
Swap(A[I], A[J]);
T := A[I];
A[I] := A[J];
A[J] := T;
if Terminated then Exit;
end;
end;
//快速排序
procedure QuickSort(var A: array of Integer);
procedure QuickSortSub(var A: array of Integer; iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid do Inc(Lo);
while A[Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
Swap(A[Lo], A[Hi]);
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSortSub(A, iLo, Hi);
if Lo < iHi then QuickSortSub(A, Lo, iHi);
end;
begin
QuickSortSub(A, Low(A), High(A));
end;
直接插入排序（Pascal)2007-04-18 16:16program InsSort;
const max=100;
type arr=array[0..max]of integer;
var a:arr;
i,n:integer;
fin:text;
procedure InsSort(var r:arr; rn:integer); { 直接插入排序算法 }
var i,j:integer;
begin
for i:=2 to rn do
begin
r[0]:=r[i]; { 將待插入記錄存放到監視哨r[0]裏 }
j:=i-1;
while(r[0]<r[j]) do { 尋找插入位置 }
begin
r[j+1]:=r[j]; { 記錄後移 }
dec(j);
end;
r[j+1]:=r[0]; { 將待插入記錄插入到已排序的序列中 }
end;
end;
begin
assign(fin,'input.txt');
reset(fin);
readln(fin,n);
for i:=1 to n do read(fin,a[i]);
write('before sort:');
for i:=1 to n do write(a[i]:5); writeln;
InsSort(a,n);
write('after sort: ');
for i:=1 to n do write(a[i]:5); writeln;
close(fin);
readln;
end.
歸並排序[Pascal]
type element=array[0..10001]of integer;
var arrhead,arrend:longint;
n,i:longint;
a:element;
procedure merge(var a:element;x,y,z:longint);
var temp1,temp2:element;
lengthA,lengthB,i,j,count:longint;
begin
for i:=x to y do temp1[i-x+1]:=a[i];
for j:=y+1 to z do temp2[j-y]:=a[j];
lengthA:=y-x+1;
lengthB:=z-y;
i:=1; j:=1; count:=x-1;
while (i<=lengthA)and(j<=lengthB) do
begin
inc(count);
if temp1[i]>temp2[j] then begin a[count]:=temp2[j]; inc(j); end
else begin a[count]:=temp1[i]; inc(i); end;
end;
if i>lengthA then for i:=j to lengthB do a[count+i-j+1]:=temp2[i]
else for j:=i to lengthA do a[count+j-i+1]:=temp1[j];
end;
procedure sort(var a:element;x,y:longint);
var mid:longint;
begin
mid:=(x+y) div 2;
if mid<>x then sort(a,x,mid);
if mid+1<>y then sort(a,mid+1,y);
merge(a,x,mid,y);
end;
begin
read(n);
for i:=1 to n do read(a[i]);
arrhead:=1;
arrend:=n;
sort(a,arrhead,arrend);
for i:=1 to n do begin write(a[i],' '); if i mod 5=0 then writeln; end;
end.
起泡法排序
procedure Bubblesort (var R:filetype)
begin
for i:=1 to n-1 do //做N-1次排序
noswap:=true;//交換的標誌
for j:=n-1 downto i do //從後往前掃描
if R[j+1].key < R[j].key then
temp :=R[j+1];
R[j+1]:=R[j];
R[j]:=temp;
noswap:=false
endif
endfor;
if noswap then //未發生交換則停止算法
return;
endif
endfor
end;
直接選擇排序
procedure selectsort (var R:filetype);
begin
for i:=1 to n-1 do
k:=i;
for j:=i+1 to n do
if R[j].key < R[k].key then
k:=j
endif
endfor;
if k不等於i then//靠TMD不能用那個符號,屏蔽的夠多的
temp:R[i];
R[i]:=R[k];
R[k]:=temp
endif
endfor
end;
.堆排序的pascal實現
//此程序實現的為小根堆（滿足性質父親要比兒子小）
//程序實現的功能有:堆排序，以及取最小的元素
//數組最終將排序成降序
const maxn=1000;
var a:array[1..maxn] of longint;
size:longint;
i,n:longint;
procedure swap(var a,b:longint);
var t:longint;
begin
t:=a;
a:=b;
b:=t;
end;
procedure insert(x:longint);
var p:longint;
begin
inc(size);
p:=size;
while (a[p div 2]>x) and (p>1) do begin
a[p]:=a[p div 2];
p:=p div 2;
end;
a[p]:=x;
end;
procedure heapfy(idx:longint);
var l,r,low:longint;
begin
l:=2*idx;
r:=2*idx+1;
if (a[l]<a[idx]) and (l<=size) then low:=l
else low:=idx;
if (a[r]<a[low]) and (r<=size) then low:=r;
if idx<>low then begin
swap(a[idx],a[low]);
heapfy(low);
end;
end;
function getmin:longint;
begin
exit(a[1]);
end;
function pop:longint;
begin
pop:=a[1];
a[1]:=a[size];
dec(size);
heapfy(1);
end;
begin
readln(n);
size:=0;
for i:=1 to n do
insert(random(1000));
for i:=1 to n do
a[n-i+1]:=pop;
for i:=1 to n do write(a[i],' ');
writeln;
end.
9