fto3.pas

用delphi实现的各种排序算法

       a[i+1]:=x;  flag:=1;   v:=v+3;
      end;
      c:=c+1;
    end;
    k:=k-1;
   end;
   display;
 end;

procedure TForm1.Button14Click(Sender: TObject);
//顺序选数。
begin
 spinedit1.Value:=1;
 spinedit2.Value:=2;
 spinedit3.Value:=3;
 spinedit4.Value:=4;
 spinedit5.Value:=5;
 spinedit6.Value:=6;
 spinedit7.Value:=7;
 spinedit8.Value:=8;
 spinedit9.Value:=9;
 spinedit10.Value:=10;
end;

procedure TForm1.Button15Click(Sender: TObject);
//逆序选数。
begin
 spinedit1.Value:=10;
 spinedit2.Value:=9;
 spinedit3.Value:=8;
 spinedit4.Value:=7;
 spinedit5.Value:=6;
 spinedit6.Value:=5;
 spinedit7.Value:=4;
 spinedit8.Value:=3;
 spinedit9.Value:=2;
 spinedit10.Value:=1;
end;
procedure TForm1.partition(t,h:integer);
//快速排序的划分过程。
 var x,i,j,k:integer;
begin
 if t<h then
  begin
   i:=t;
   j:=h;
   x:=a[t];
   repeat    
    while (a[j]>=x) and (i<j) do
     begin j:=j-1; c:=c+1; end;
    c:=c+1;
    if i<j then begin a[i]:=a[j]; i:=i+1; v:=v+1; end;
    while (a[i]<x) and (i<j) do
     begin i:=i+1;  c:=c+1; end;
    c:=c+1;
    if i<j then begin a[j]:=a[i]; j:=j-1; v:=v+1; end;
   until i=j;
   a[i]:=x; v:=v+1;
   partition(t,i-1);
   partition(i+1,h);
 end;
end;


procedure TForm1.Button8Click(Sender: TObject);
//交换排序（快速排序）
begin
 ina;
 partition(1,n);
 display;
end;

procedure TForm1.Button13Click(Sender: TObject);
//简单选择排序
var i,j,k,x:integer;
begin
 ina;
 for j:=n downto 2 do
 begin
 k:=1;
 for i:=2 to j do
  begin
  if a[i]>a[k] then k:=i;
  c:=c+1;
  end;
 x:=a[j];
 a[j]:=a[k];
 a[k]:=x;  v:=v+3;
 end;
 display;
end;

procedure TForm1.heapfy1(i,j:integer);
//重新堆化过程(用递归实现)。
var x,k:integer;
begin
 if 2*i<=j then
 begin
  k:=2*i;
  if ((k+1)<=j) and (a[k]<a[k+1]) then
     k:=2*i+1;
  c:=c+1;
  if a[i]<a[k] then
   begin
    x:=a[k];
    a[k]:=a[i];
    a[i]:=x;  v:=v+3;
   end;
  c:=c+1;
 heapfy1(k,j);
 end;
end;

procedure TForm1.heapfy2(i,j:integer);
//重新堆化过程(用循环实现)。
var x,k:integer;
begin
 while 2*i<=j do
 begin
  k:=2*i;
  if ((k+1)<=j) and (a[k]<a[k+1]) then
     k:=2*i+1;
  c:=c+1;
  if a[i]<a[k] then
   begin
    x:=a[k];
    a[k]:=a[i];
    a[i]:=x;  v:=v+3;
   end;
  c:=c+1;
 i:=k;
 end;
end;

procedure TForm1.Button10Click(Sender: TObject);
//递归堆排序。
var i,j,k,x:integer;
begin
 ina;
 k:=n div 2;
 for i:=k downto 1 do
  heapfy1(i,n);
 for j:=n downto 2 do
  begin
   x:=a[1];
   a[1]:=a[j];
   a[j]:=x;   v:=v+3;
   heapfy1(1,j-1);
  end;
 display;
end;

procedure TForm1.Button16Click(Sender: TObject);
 //循环堆排序。
var i,j,k,x:integer;
begin
 ina;
 k:=n div 2;
 for i:=k downto 1 do
  heapfy2(i,n);
 for j:=n downto 2 do
  begin
   x:=a[1];
   a[1]:=a[j];
   a[j]:=x;   v:=v+3;
   heapfy2(1,j-1);
  end;
 display;
end;

procedure TForm1.Button17Click(Sender: TObject);
 {改进的重新堆化过程。其主要思想是：删除根元素之后（实际上
是用x:=a[1]将根暂存在变量x中），通过一次比较，把两个子堆
根之最大者上升为堆之根，那个缺少根的子堆又将被分成两个子堆
，重复上述合并过程，直至某叶的上一层，把原堆最后一片叶所存
的元素放入这个缺少元素的叶之处，这个叶可能会上升，可逐一与
其祖先比较，为其找至适当的位置，每上升一次只作一次比较，通
常可在少数几步内找到它的应在的位置，最坏情况下至多上升至第
二层。最后把原堆根元素入在最后一片叶的位置上（a[j]:=x）这
样便完成了一次循环。}
var i,j,x,k:integer;
begin
 ina;
 k:=n div 2;
 for i:=k downto 1 do
  heapfy2(i,n);
 for j:=n downto 2 do
  begin
   x:=a[1];  v:=v+1;
   i:=1;
   while 2*i<=j do
     begin
      k:=2*i;
       if ((k+1)<=j) and (a[k]<a[k+1]) then
        k:=2*i+1;
       c:=c+1;
      a[i]:=a[k]; v:=v+1;
      i:=k;
     end;
   k:=i div 2;   
   while a[k]<a[j] do
    begin
     c:=c+1;
     a[i]:=a[k];  v:=v+1;
     i:=k;
     k:=i div 2;
    end;
    c:=c+1;
   a[i]:=a[j];
   a[j]:=x;  v:=v+2;
   end;
  display;
end;

procedure Tform1.merge(p,q,r:integer;var a,b:arr);
//将a中相临两有序段，下标从p至q,从q+1至r,
//合并成一个有序段到b中，下面的i,j分别表示两有序段之首，
//e是一个全局变量，它b中的移入位置。
var i,j:integer;
 begin
  i:=p;
  j:=q+1;
  e:=p;
  while (i<=q) and (j<=r) do
   begin
    if a[i]<=a[j] then  begin b[e]:=a[i]; i:=i+1; end
       else begin b[e]:=a[j]; j:=j+1; end;
    e:=e+1;
   end;
  if i>q then move(j,r,a,b);
  if j>r then move(i,q,a,b);
 end;

procedure Tform1.move(i,j:integer;var a,b:arr);
 var k:integer;
  begin
   for k:=0 to (j-i) do
    b[e+k]:=a[i+k];
  end;

procedure Tform1.scan(l:integer;var a,b:arr);
 var i,j,k:integer;
 begin
  i:=1;
  while i<=n do
   begin
   j:=i+l-1;
   k:=j+l;
   if j>n then i:=n;
   if k>n then k:=n;
   merge(i,j,k,a,b);
   i:=k+1;
   end;
 end;

procedure TForm1.Button11Click(Sender: TObject);
var i,l:integer;
    c,d:arr;
begin
 ina;
 for i:=1 to n do
  begin
   c[i]:=a[i];
   d[i]:=0;
  end;
 l:=1;
 while l<n do
  begin
   scan(l,c,d);
   scan(2*l,d,c);
   l:=4*l;
  end;
 for i:=1 to n do
  a[i]:=c[i];
 display;
end;

procedure TForm1.Button18Click(Sender: TObject);
begin
  Randomize;
 spinedit1.Value:=(random(9)+1)*100+random(100);
 spinedit2.Value:=(random(9)+1)*100+random(100);
 spinedit3.Value:=(random(9)+1)*100+random(100);
 spinedit4.Value:=(random(9)+1)*100+random(100);
 spinedit5.Value:=(random(9)+1)*100+random(100);
 spinedit6.Value:=(random(9)+1)*100+random(100);
 spinedit7.Value:=(random(9)+1)*100+random(100);
 spinedit8.Value:=(random(9)+1)*100+random(100);
 spinedit9.Value:=(random(9)+1)*100+random(100);
 spinedit10.Value:=(random(9)+1)*100+random(100);
 spinedit11.Value:=(random(9)+1)*100+random(100);
end;

procedure TForm1.Button12Click(Sender: TObject);
//基数排序。
 var p,q:pointer;
     i,j,m,k,l,r:integer;
     h,t:array [0..9] of pointer;
begin
 ina;
 q:=nil;
 for i:=n downto 1 do
  begin
   new(p);
   p^.a[1]:=(a[i] div 100);
   p^.a[2]:=((a[i] mod 100) div 10);
   p^.a[3]:=(a[i] mod 10);
   p^.next:=q;
   q:=p;
  end;
  m:=10;   //m=10表示每位上数的范围为０～９）。
  k:=3;
  //以上构造将排序的队列及变量初始化。
  for j:=k downto 1 do     //依次对个位、十位、百位进行分组。
   begin
    for i:=0 to m-1 do
      h[i]:=nil;
    while p<>nil do
     begin
      l:=p^.a[j];
      if h[l]=nil then
        h[l]:=p
      else
        t[l]^.next:=p;
      t[l]:=p;
      p:=p^.next;
     end;
    r:=0;
    while h[r]=nil do
      r:=r+1;
    p:=h[r];
    q:=t[r];
    for i:=r+1 to m-1 do
      if h[i]<>nil then
        begin
         q^.next:=h[i];
         q:=t[i];
        end;
    q^.next:=nil;
  end;
  for i:=1 to n do
  begin
   a[i]:=10*(10*p^.a[1]+p^.a[2])+p^.a[3];;
   q:=p;
   p:=p^.next;
   dispose(q);
  end;
  display;
end;

procedure TForm1.N24Click(Sender: TObject);
begin
showmessage('雷新锋二OO二年十二月于通院！');
end;

procedure TForm1.N26Click(Sender: TObject);
begin
close;
end;

end.