排序算法

Turbo Pascal 7.0运行
基数排序,选择排序,插入排序,冒泡排序,快速排序,希尔排序,归并排序,计数排序,桶排序,堆排序

program sort_program;

const max = 10;
type arr = array  [1..max] of integer;
	Sort = object
		private
			data : arr;
			backup1 : arr;
			procedure _Quick(s : integer; e : integer);
			procedure _Merge(s : integer; e : integer);
			procedure _Heap(l : integer);
			procedure swap(i : integer; j: integer);
			function  NumLength(i : integer) : integer;
		public
			constructor init;
			procedure backup;
			procedure restore;
			procedure display(s : string);

			procedure Radix;
			procedure Selection;
			procedure Insertion;
			procedure Bubble;
			procedure Quick;
			procedure Shell;
			procedure Merge;
			procedure Count;
			procedure Bucket;
			procedure Heap;
	end;

procedure Sort.Radix;
var d : array [0..9, 1..max] of integer;
var l : array [0..9] of integer;
var i,j,k : integer;
var m, n, p : integer;
begin
	m := 0;
	for i:=1 to max do
	begin
		k := NumLength(data[i]);
		if k>m then m := k
	end;

	for i:=1 to m do
	begin
		for j:=0 to 9 do
			l[j] := 0;

		for j:=1 to max do
		begin
			n := 1;
			for k:=2 to i do
				n := 10 * n;

			p := data[j] div n mod 10;
			l[p] := l[p] + 1;
			d[p][l[p]] := data[j]
		end;
		
		n := 1;
		for j:=0 to 9 do
			for k:=1 to l[j] do
			begin
				data[n] := d[j][k];
				n := n + 1
			end
	end

end;

procedure Sort.Selection;
var i, j : integer;
var min : integer;
begin
	for i:=1 to max do
	begin
		min := i;
		for j:=i to max do
		begin
			if data[j] < data[min]  then
			begin
				min := j;
			end;
		end;

		swap(i, min);
	end;
end;

procedure Sort.Insertion;
var i, j : integer;
var p : integer;
begin
	for i:=1 to max-1 do
	begin
		j:= i+1;
		p := data[j];
		while (j>1) and ( p < data[j-1]) do
		begin
			data[j] := data[j-1];
			j:= j-1;
		end;

		data[j] := p;
	end;
end;

procedure Sort.Bubble;
var i,j: integer;
begin
	for i:=1 to max-1 do
		for j:=i+1 to max do
		begin
			if data[i]> data[j] then
				swap(i,j);
		end;
end;

procedure Sort._Quick(s : integer; e : integer);
var i,j : integer;
var p,f, t : integer;
begin
	p := s;
	f := s+1;

	while f<=e do
	begin
		if data[f] < data[p] then
		begin
			t := data[f];
			for j:=f downto p+1 do
				data[j] := data[j-1];
			data[p] := t;
			p := p+1
		end;

		f := f+ 1
	end;

 	if s<p then
		_Quick(s, p-1);
	if p<e then
		_Quick(p+1, e);

end;

procedure  Sort.Quick;
begin
	_Quick(1, max);
end;

procedure Sort.Shell;
var i, j, k : integer;
var d, p: integer;
begin
	d := max div 2;

	while d <> 0 do
	begin
		for i:=1 to max do
			if i+d <=max then
				for j:=i to i+d-1 do
				begin
					k := j+1;
                    p := data[k];

					while (k>i) and ( p < data[k-1]) do
					begin
						data[k] := data[k-1];
						k:= k-1
					end;

					data[k] := p
				end;
		d := d div 2
	end
end;

procedure Sort.Count;
var d : array [0..99] of integer;
var i, j, k : integer;
begin
	for i:=0 to 99 do
		d[i] := 0;

	for i:=1 to max do
		d[data[i]] := d[data[i]] + 1;

	k := 1;
	for i:=0 to 99 do
		for j:=1 to d[i] do
		begin
			data[k] := i;
			k := k+1
		end
end;

procedure Sort._Merge(s : integer; e : integer);
var c : integer;
var i, j, k: integer;
var t : array[1..max] of integer;
var m, n : integer;
begin
	if e - s > 1 then
	begin
		c := (s + e) div 2 ;
		_Merge(s, c);
		_Merge(c+1, e);

		m := s;
		n := c+1;
		k :=0;

		while (m <= c ) and (n <=e) do
		begin
			k := k+1;
			if data[m] < data[n] then
			begin
				t[k] := data[m];
				m := m+1
			end
			else
			begin
				t[k] := data[n];
				n := n+1
			end
		end;

		while m <=c do
		begin
			k := k+1;
			t[k] := data[m];
			m := m+1
		end;

		while n<=e do
		begin
			k := k+1;
			t[k] := data[n];
			n := n+1
		end;

		for k:=0 to e-s do
		begin
			data[s+k] := t[k+1]
		end
	end
	else 
		if (data[s] > data[e]) then
			swap(s, e);

end;

procedure Sort.Merge;
begin
	_Merge(1, max);
end;

procedure Sort.Bucket;
var d : array[0..9, 1..max] of integer;
var l : array[0..9] of integer;
var i, j, k, n, m : integer;
begin
	for i:=0 to 9 do
		l[i] := 0;
		
	for i:=1 to max do
	begin
		n := data[i] div 10;

		m := 1;
		while (m <= l[n]) and (data[i] > d[n][m]) do
			m := m + 1;
			
		l[n] := l[n] + 1;
		for j:=l[n] downto m+1 do
			d[n][j] := d[n][j-1];
		
		d[n][m] := data[i];
	end;

	k := 1;
	for i:=0 to 9 do
		for j := 1 to l[i] do
			begin
				data[k] := d[i][j];
				k := k+1
			end;
end;

procedure Sort._Heap(l : integer);
var i : integer;
var p, m : integer;
var b : boolean;
begin
	for i:=l div 2 downto 1 do 
	begin
		b := true;
		p := i;

		while (b=true) and (p * 2 <= l) do
		begin
			if p * 2 + 1 > l then
				m := p * 2
			else if data[p*2] < data[p*2+1] then
				m := p*2+1
			else
				m := p*2;
				
			if data[p] < data[m] then
			begin
				swap(p, m);
				p := m;
			end
			else
				b := false ;
		end;
	end;
	

end;

procedure Sort.Heap;
var l : integer; 
begin
	for l:= max downto 2 do
	begin
		_Heap(l);
		swap(1, l);
	end;
	
end;