排序算法模板

1.快速排序

procedure qsort(l,r:word);
var pl,pr,m,t:integer;
begin
    pl:=l;pr:=r;
    m:=a[l+random(r-l+1)];
    repeat
        while a[pl]<m do inc(pl);
        while a[pr]>m do dec(pr);
        if pl<=pr then
            begin
                t:=a[pl];a[pl]:=a[pr];a[pr]:=t;
                inc(pl);dec(pr);
            end;
    until pl>pr;
    if pl<r then qsort(pl,r);
    if pr>l then qsort(l,pr);
end;{qsort}

2.归并排序

procedure Merge(var a:arr; l,m,r:word);
var pt,pl,pr:word;
    tmp:arr;
begin
    pt:=l;pl:=l;pr:=m+1;
    while(pl<=m)and(pr<=r)do
        if a[pl]<a[pr] then
            begin
                tmp[pt]:=a[pl];
                inc(pt);inc(pl);
            end
        else begin
            tmp[pt]:=a[pr];
            inc(pt);inc(pr);
        end;
    while pl<=m do
        begin
            tmp[pt]:=a[pl];
            inc(pt);inc(pl);
        end;
    while pr<=r do
        begin
            tmp[pt]:=a[pr];
            inc(pt);inc(pr);
        end;
    for pt:=l to r do a[pt]:=tmp[pt];
end;{Merge}

procedure MergeSort(var a:arr; l,r:word);
var m:word;
begin
    if l>=r then exit;
    m:=(l+r)shr 1;
    MergeSort(a,1,m);
    MergeSort(a,m+1,r);
    Merge(a,l,m,r);
end;{MergeSort}

3.冒泡排序

procedure bubble ;
var
i,j:word;
bo:boolean;
begin
i:=1;
repeat
   bo:=false;
   for j:=1 to n-i do
    if a[j]<a[j+1] then
     begin
      swap(a[j],a[j+1]);
      bo:=true;
     end;
   inc(i);
until not bo;
end;

4.插入排序

procedure InsertSort;
var i,j:word;
begin
    for i:=2 to n do
        begin
            a[0]:=a[i];
            j:=i-1;
            while a[0]<a[j] do
                begin
                    a[j+1]:=a[j];
                    dec(j);
                end;
            a[j+1]:=a[0];
        end;
end;{InsertSort}

5.堆

procedure up(t:word);
var tmp:integer;
begin
    while t>1 do
        if heap[t shr 1]>heap[t] then
            begin
                tmp:=heap[t shr 1];heap[t shr 1]:=heap[t];heap[t]:=tmp;
                t:=t shr 1;
            end
        else break;
end;{up}

procedure down(t:word);
var p,tmp:integer;
begin
    while t shl 1 <= tot do
        begin
            p:=t shl 1;
            if(p+1<=tot)and(heap[p+1]<heap[p])then inc(p);
            if heap[p]<heap[t] then
                begin
                    tmp:=heap[p];heap[p]:=heap[t];heap[t]:=tmp;
                    t:=p;
                end
                else break;
        end;
end;{down}

procedure insert(x:integer);
begin
    inc(tot);heap[tot]:=x;
    up(tot);
end;{insert}

procedure del_min;
begin
    heap[1]:=heap[tot];dec(tot);
    down(1);
end;{del_min}