顶~~~~~~~  

向二叉排序树中插入节点:
procedure insert(var tree:treetype; x{需要插入的数据},root:integer; var count:integer);
begin
  if count=0 then {树中无节点的情况}
  begin
    count:=count+1;
    tree[count].data:=x;
  end
  else
    if x<=tree[root].data then
    begin
      if tree[root].lch=0 then
      begin
        count:=count+1;
        tree[root].lch:=count;
        tree[count].data:=x;
      end
      else insert(tree,x,tree[root].lch,count);
    end
    else
      if tree[root].rch=0 then
      begin
        count:=count+1;
        tree[root].rch:=count;
        tree[count].data:=x;
      end
      else insert(tree,x,tree[root].rch,count);
end;

不错不错~~~

建立哈夫曼树:
{已知n个权值a[i],生成一棵以root为根的哈夫曼树}
procedure create_huffmantree(var tree:treetype; var root:byte; a:rectype);
var
  i,count:integer;
begin
  for i:=1 to n do
  begin
    tree[i].data:=a[i].data;
    tree[i].lch:=0;
    tree[i].rch:=0;
    a[i].addr:=i;
  end;
  root:=n+1;
  count:=n;
  while count>1 do
  begin
    sort(a,count); {对a的前count个元素按data域升序排序}
    tree[root].data:=a[1].data+a[2].data;
    tree[root].lch:=a[1].addr;
    tree[root].rch:=a[2].addr;
    a[1].data:=tree[root].data;
    a[1].addr:=root;
    a[2].data:=a[count].data;
    a[2].addr:=a[count].addr;
    count:=count-1;
    root:=root+1;
  end;
  root:=root-1;
end;

高精度加法:
function add(s1,s2:string):string;
var
  a,b:array[1..255] of byte;
  ch,ans:string;
  i,len,len1,len2,k:byte;
begin
  {init}
  ans:='';
  len1:=length(s1);
  len2:=length(s2);
  if len1>len2 then len:=len1
  else len:=len2;
  k:=0;
  for i:=len1 downto 1 do
  begin
    k:=k+1;
    a[k]:=ord(s1[i])-ord('0');
  end;
  k:=0;
  for i:=len2 downto 1 do
  begin
    k:=k+1;
    b[k]:=ord(s2[i])-ord('0');
  end;
  {work}
  for i:=1 to len do
  begin
    a[i]:=a[i]+b[i];
    if a[i]>=10 then
    begin
      a[i]:=a[i]-10;
      a[i+1]:=a[i+1]+1;
    end;
  end;
  if a[len+1]=0 then len:=len-1;
  for i:=(len+1) downto 1 do
  begin
    str(a[i],ch);
    ans:=ans+ch;
  end;
  add:=ans;
end;

高精度减法:
function sub(s1,s2:string):string;
var
  a,b:array[1..255] of shortint;
  ch,ans:string;
  i,len,len1,len2,k:byte;
begin
  {init}
  同高精度加法;
  {work}
  for i:=1 to len do
    if a[i]<b[i] then
    begin
      a[i+1]:=a[i+1]-1;
      a[i]:=a[i]+10;
      a[i]:=a[i]-b[i];
    end
    else a[i]:=a[i]-b[i];
  while (a[len]=0) and (len>1) do len:=len-1;
  for i:=len downto 1 do
  begin
    str(a[i],ch);
    ans:=ans+ch;
  end;
  sub:=ans;
end;

高精度乘法:
function mul(s1,s2:string):string;
var
  a,b,c:array[1..255] of byte;
  ch,ans:string;
  len1,len2,len,k,x,y,z,i,j,w:byte;
begin
  {init}
  ans:='';
  len1:=length(s1);
  len2:=length(s2);
  len:=len1+len2;
  k:=0;
  for i:=len1 downto 1 do
  begin
    k:=k+1;
    a[k]:=ord(s1[i])-ord('0');
  end;
  k:=0;
  for i:=len2 downto 1 do
  begin
    k:=k+1;
    b[k]:=ord(s2[i])-ord('0');
  end;
  {work}
  for i:=1 to len1 do
    for j:=1 to len2 do
    begin
      x:=a[i]*b[j];
      y:=x div 10;
      z:=x mod 10;
      w:=i+j-1;
      c[w]:=c[w]+z;
      c[w+1]:=c[w+1]+c[w] div 10+y;
      c[w]:=c[w] mod 10;
    end;
  while (c[len]=0) and (len>1) do len:=len-1;
  for i:=len downto 1 do
  begin
    str(c[i],ch);
    ans:=ans+ch;
  end;
  mul:=ans;
end;

十进制数转N进制数:
function int_to_n(x:cardinal; n:byte):string;
var
  a:array[1..255] of byte;
  ans:string;
  count,i:byte;
begin
  ans:='';
  count:=0;
  if x=0 then ans:='0';
  while x>0 do
  begin
    count:=count+1;
    a[count]:=x mod n;
    x:=x div n;
  end;
  for i:=count downto 1 do
    if a[i]<10 then ans:=ans+chr(ord('0')+a[i])
    else ans:=ans+chr(ord('a')-10+a[i]);
  int_to_n:=ans;
end;

N进制数转十进制数:
function n_to_int(x:string; n:byte):cardinal;
var
  a:array[1..255] of byte;
  ans,y:cardinal;
  count,i,j:byte;
begin
  ans:=0;
  for i:=1 to length(x) do
    if x[i] in ['0'..'9'] then a[i]:=ord(x[i])-ord('0')
    else a[i]:=ord(x[i])-ord('a')+10;
  count:=0;
  for i:=length(x) downto 1 do
  begin
    y:=1;
    for j:=1 to count do y:=y*n;
    count:=count+1;
    ans:=ans+y*a[i];
  end;
  n_to_int:=ans;
end;

拓扑排序(改进1):
procedure topsort(g:graphtype);
var
  s:stucktype;
  delnode:settype;
  b:boolean;
  i,y:integer;
begin
  s.top:=0;
  delnode:=[];
  repeat
    b:=false;
    for i:=1 to n do
      if (tryindegree(g,i)=0) and (not (i in delnode)) then
      begin
        push(s,i);
        b:=true;
      end;
    while s.top>0 do
    begin
      y:=pop(s);
      write(y,' ');
      for i:=1 to n do g[y,i]:=0;
      delnode:=delnode+[y];
    end;
  until not b;
end;