算法合集一、数论算法 1．求两数的最大公约数 function gcd(a,b:integer

ubuntuer

[color="#555555"]一、数论算法
1．求两数的最大公约数
function  gcd(a,b:integer):integer;
begin
  if b=0 then gcd:=a
    else gcd:=gcd (b,a mod b);
end ;
2．求两数的最小公倍数
function  lcm(a,b:integer):integer;
begin
  if a0 do inc(lcm,a);
end;
3．素数的求法
A.小范围内判断一个数是否为质数：
function prime (n: integer): Boolean;
  var I: integer;
  begin
    for I:=2 to trunc(sqrt(n)) do
      if n mod I=0 then begin
prime:=false; exit;
end;
    prime:=true;
  end;
B.判断longint范围内的数是否为素数（包含求50000以内的素数表）：
  procedure getprime;
    var
      i,j:longint;
      p:array[1..50000] of boolean;
     begin
       fillchar(p,sizeof(p),true);
p[1]:=false;
i:=2;
while i=x then break
    else if x mod pr=0 then exit;
prime:=true;
     end;{prime}
二、图论算法
1．最小生成树
A.Prim算法：
   procedure prim(v0:integer);
     var
       lowcost,closest:array[1..maxn] of integer;
i,j,k,min:integer;
     begin
       for i:=1 to n do begin
  lowcost:=cost[v0,i];
  closest:=v0;
end;
for i:=1 to n-1 do begin
  {寻找离生成树最近的未加入顶点k}
  min:=maxlongint;
  for j:=1 to n do
    if (lowcost[j]0) then begin
      min:=lowcost[j];
      k:=j;
    end;
  lowcost[k]:=0; {将顶点k加入生成树}
     {生成树中增加一条新的边k到closest[k]}
  {修正各点的lowcost和closest值}
  for j:=1 to n do
    if  cost[k,j]0 do begin
    i:=find(e[q].v1);j:=find(e[q].v2);
    if ij then begin
      inc(tot,e[q].len);
      vset:=vset+vset[j];vset[j]:=[];
      dec(p);
    end;
    inc(q);
  end;
  writeln(tot);
end;
2.最短路径
A.标号法求解单源点最短路径：
  var
    a:array[1..maxn,1..maxn] of integer;
    b:array[1..maxn] of integer; {b指顶点i到源点的最短路径}
    mark:array[1..maxn] of boolean;
  procedure bhf;
    var
      best,best_j:integer;
    begin
      fillchar(mark,sizeof(mark),false);
   mark[1]:=true; b[1]:=0;{1为源点}
   repeat
     best:=0;
       for i:=1 to n do
        If mark then {对每一个已计算出最短路径的点}
         for j:=1 to n do
           if (not mark[j]) and (a[i,j]>0) then
          if (best=0) or (b+a[i,j]0 then begin
        b[best_j]:=best；mark[best_j]:=true;
      end;
    until best=0;
    end;{bhf}
B.Floyed算法求解所有顶点对之间的最短路径：
    procedure floyed;
      begin
for I:=1 to n do
for j:=1 to n do
if a[I,j]>0 then p[I,j]:=I else p[I,j]:=0; {p[I,j]表示I到j的最短路径上j的前驱结点}
for k:=1 to n do {枚举中间结点}
   for i:=1 to n do
     for j:=1 to n do
       if a[i,k]+a[j,k]0 then pre:=v0 else pre:=0;
  end;
  mark[v0]:=true;
  repeat   {每循环一次加入一个离1集合最近的结点并调整其他结点的参数}
    min:=maxint; u:=0; {u记录离1集合最近的结点}
    for i:=1 to n do
      if (not mark) and (d0 then begin
      mark:=true;
      for i:=1 to n do
       if (not mark) and (a[u,i]+d表示，则Ee[I] = Ve[j];
d. 边活动最晚开始时间 El[I], 若边I由表示，则El[I] = Vl[k] – w[j,k];
若 Ee[j] = El[j] ，则活动j为关键活动，由关键活动组成的路径为关键路径。
求解方法：
a. 从源点起topsort,判断是否有回路并计算Ve;
b. 从汇点起topsort,求Vl;
c. 算Ee 和 El;
6．拓扑排序
找入度为0的点，删去与其相连的所有边，不断重复这一过程。
例  寻找一数列，其中任意连续p项之和为正，任意q 项之和为负，若不存在则输出NO.
7.回路问题
Euler回路(DFS)
定义：经过图的每条边仅一次的回路。（充要条件：图连同且无奇点）
Hamilton回路
定义：经过图的每个顶点仅一次的回路。
一笔画
充要条件：图连通且奇点个数为0个或2个。
9．判断图中是否有负权回路 Bellman-ford 算法
x[I],y[I],t[I]分别表示第I条边的起点，终点和权。共n个结点和m条边。
procedure bellman-ford
  begin
for I:=0 to n-1 do d[I]:=+infinitive;
d[0]:=0;
for I:=1 to n-1 do
for j:=1 to m do {枚举每一条边}
  if d[x[j]]+t[j]=best then exit; {s[n]为前n个物品的重量和}
    if kw[k] then search(k+1,v-w[k]);
      search(k+1,v);
    end;
  end;
l DP
F[I,j]为前i个物品中选择若干个放入使其体积正好为j的标志，为布尔型。
实现:将最优化问题转化为判定性问题
f [I, j] = f [ i-1, j-w ] (w[I]0 then
        if j+now=0 Then
  Begin
    t:=problem[j].point+f[i-problem[j].time];
    If t>f Then f:=t;
  End;
Writeln(f[M]);
End.
C.求恰好装满的情况数。
Ahoi2001 Problem2
求自然数n本质不同的质数和的表达式的数目。
思路一，生成每个质数的系数的排列，在一一测试，这是通法。
procedure try(dep:integer);
  var i,j:integer;
  begin
    cal; {此过程计算当前系数的计算结果，now为结果}
    if now>n then exit; {剪枝}
    if dep=l+1 then begin {生成所有系数}
      cal;
      if now=n then inc(tot);
      exit;
    end;
    for i:=0 to n div pr[dep]  do  begin
      xs[dep]:=i;
      try(dep+1);
      xs[dep]:=0;
    end;
  end;
思路二，递归搜索效率较高
procedure try(dep,rest:integer);
  var i,j,x:integer;
  begin
    if (rest0 then
      for k:=1 to n div now do
        if j+now*k
四、排序算法
1.快速排序：
procedure qsort(l,r:integer);
var i,j,mid:integer;
begin
      i:=l;j:=r; mid:=a[(l+r) div 2]; {将当前序列在中间位置的数定义为中间数}
  repeat
    while amid do dec(j);{在右半部分寻找比中间数小的数}
    if ij;
if la[j] then swap(a,a[j]);
end;
D. 冒泡排序
procedure bubble_sort;
var i,j,k:integer;
begin
  for i:=1 to n-1 do
    for j:=n downto i+1 do
      if a[j]r) or (ar then begin
    q:=(p+r-1) div 2;
    merge_sort (a,p,q);
    merge_sort (a,q+1,r);
    merge (a,p,q,r);
  end;
end;
{main}
begin
merge_sort(a,1,n);
end.
G.基数排序
思想：对每个元素按从低位到高位对每一位进行一次排序
五、高精度计算
高精度数的定义：
type
  hp=array[1..maxlen] of integer;
1．高精度加法
procedure plus ( a,b:hp; var c:hp);
var i,len:integer;
begin
fillchar(c,sizeof(c),0);
if a[0]>b[0] then len:=a[0] else len:=b[0];
for i:=1 to len do begin
  inc(c,a+b);
if c>10 then begin dec(c,10); inc(c[i+1]); end; {进位}
end;
if c[len+1]>0 then inc(len);
c[0]:=len;
end;{plus}
2．高精度减法
procedure substract(a,b:hp;var c:hp);
var i,len:integer;
begin
  fillchar(c,sizeof(c),0);
  if a[0]>b[0] then len:=a[0] else len:=b[0];
  for i:=1 to len do begin
    inc(c,a-b);
    if c1) and (c[len]=0) do dec(len);
  c[0]:=len;
end;
3．高精度乘以低精度
procedure multiply(a:hp;b:longint;var c:hp);
var i,len:integer;
begin
  fillchar(c,sizeof(c),0);
  len:=a[0];
  for i:=1 to len do begin
    inc(c,a*b);
    inc(c[i+1],(a*b) div 10);
    c:=c mod 10;
  end;
  inc(len);
  while (c[len]>=10) do begin {处理最高位的进位}
    c[len+1]:=c[len] div 10;
    c[len]:=c[len] mod 10;
    inc(len);
   end;
  while (len>1) and (c[len]=0) do dec(len); {若不需进位则调整len}
  c[0]:=len;
end;{multiply}
4．高精度乘以高精度
procedure high_multiply(a,b:hp; var c:hp}
var i,j,len:integer;
begin
  fillchar(c,sizeof(c),0);
  for i:=1 to a[0] do
    for j:=1 to b[0] do begin
      inc(c[i+j-1],a*b[j]);
   inc(c[i+j],c[i+j-1] div 10);
   c[i+j-1]:=c[i+j-1] mod 10;
    end;
  len:=a[0]+b[0]+1;
  while (len>1) and (c[len]=0) do dec(len);
  c[0]:=len;
end;
5．高精度除以低精度
procedure devide(a:hp;b:longint; var c:hp; var d:longint);
{c:=a div b; d:= a mod b}
var i,len:integer;
begin
  fillchar(c,sizeof(c),0);
  len:=a[0]; d:=0;
  for i:=len downto 1 do begin
    d:=d*10+a;
    c:=d div b;
    d:=d mod b;
  end;
  while (len>1) and (c[len]=0) then dec(len);
  c[0]:=len;
end;
6．高精度除以高精度
procedure high_devide(a,b:hp; var c,d:hp);
var
  i,len:integer;
begin
  fillchar(c,sizeof(c),0);
  fillchar(d,sizeof(d),0);
  len:=a[0];d[0]:=1;
  for i:=len downto 1 do begin
    multiply(d,10,d);
    d[1]:=a;
    while(compare(d,b)>=0) do {即d>=b}
    begin
      Subtract(d,b,d);
      inc(c);
    end;
  end;
  while(len>1)and(c.s[len]=0) do dec(len);
  c.len:=len;
end;
六、 树的遍历
1．已知前序中序求后序
procedure Solve(pre,mid:string);
var i:integer;
begin
  if (pre='''') or (mid='''') then exit;
  i:=pos(pre[1],mid);
  solve(copy(pre,2,i),copy(mid,1,i-1));
  solve(copy(pre,i+1,length(pre)-i),copy(mid,i+1,length(mid)-i));
  post:=post+pre[1]; {加上根，递归结束后post即为后序遍历}
end;
2．已知中序后序求前序
procedure Solve(mid,post:string);
var i:integer;
begin
  if (mid='''') or (post='''') then exit;
  i:=pos(post[length(post)],mid);
  pre:=pre+post[length(post)]; {加上根，递归结束后pre即为前序遍历}
  solve(copy(mid,1,I-1),copy(post,1,I-1));
  solve(copy(mid,I+1,length(mid)-I),copy(post,I,length(post)-i));
end;
3．已知前序后序求中序的一种
function ok(s1,s2:string):boolean;
var i,l:integer;   p:boolean;
begin
  ok:=true;
  l:=length(s1);
  for i:=1 to l do begin
    p:=false;
    for j:=1 to l do
      if s1=s2[j] then p:=true;
    if not p then begin ok:=false;exit;end;
  end;
end;
procedure solve(pre,post:string);
var i:integer;
begin
   if (pre='''') or (post='''') then exit;
   i:=0;
   repeat
     inc(i);
   until ok(copy(pre,2,i),copy(post,1,i));
   solve(copy(pre,2,i),copy(post,1,i));
   midstr:=midstr+pre[1];
   solve(copy(pre,i+2,length(pre)-i-1),copy(post,i+1,length(post)-i-1));
end;
七 进制转换
1.任意正整数进制间的互化
除n取余
2.实数任意正整数进制间的互化
乘n取整
3.负数进制：
   设计一个程序，读入一个十进制数的基数和一个负进制数的基数，并将此十进制数转换为此负 进制下的数：-R∈{-2，-3，-4,....-20}
八 全排列与组合的生成
1.排列的生成：（1..n）
procedure solve(dep:integer);
  var
    i:integer;
  begin
    if dep=n+1 then begin writeln(s);exit; end;
    for i:=1 to n do
      if not used then begin
        s:=s+chr(i+ord(''0''));used:=true;
        solve(dep+1);
        s:=copy(s,1,length(s)-1); used:=false;
    end;
  end;
2.组合的生成(1..n中选取k个数的所有方案)
procedure solve(dep,pre:integer);
  var
    i:integer;
  begin
    if dep=k+1 then begin writeln(s);exit; end;
    for i:=1 to n do
      if (not used) and (i>pre) then begin
        s:=s+chr(i+ord(''0''));used:=true;
        solve(dep+1,i);
        s:=copy(s,1,length(s)-1); used:=false;
    end;
end;
九.查找算法
1.折半查找
function binsearch(k:keytype):integer;
var low,hig,mid:integer;
begin
  low:=1;hig:=n;
  mid:=(low+hig) div 2;
  while (a[mid].keyk) and (lowk then hig:=mid-1
      else low:=mid+1;
    mid:=(low+hig) div 2;
  end;
  if low>hig then mid:=0;
  binsearch:=mid;
end;
2.树形查找
二叉排序树：每个结点的值都大于其左子树任一结点的值而小于其右子树任一结点的值。
查找
function treesrh(k:keytype):pointer;
var q:pointer;
begin
  q:=root;
  while (qnil) and (q^.keyk) do
    if kgoal then begin  {若未移到目标}
  Move(k-1,6-now-goal);  {剩下的先移到没用的柱上}
  Writeln(k moved from now to goal);
  H[goal,h[goal,0]+1]:=h[now,nowp]; h[now,nowp]:=0;
  Inc(h[goal,0]); dec(h[now,0]);
  Move(k-1,goal); {剩下的移到目标上}
End;
十二、DFS框架
NOIP2001 数的划分
procedure work(dep,pre,s:longint); {入口为work(1,1,n)}
{dep为当前试放的第dep个数,pre为前一次试放的数,s为当前剩余可分的总数}
var j:longint;
begin
  if dep=n then begin
    if s>=pre then inc(r); exit;
  end;
  for j:=pre to s div 2 do work(dep+1,j,s-j);
end;
类似：
procedure try(dep:integer);
  var i:integer;
  begin
    if dep=k then begin
      if tot>=a[dep-1] then inc(sum);
        exit; end;
    for i:=a[dep-1] to tot div 2 do begin
      a[dep]:=i; dec(tot,i);
try(dep+1);
      inc(tot,i);
    end;
  end;{try}
十三、BFS框架
IOI94 房间问题
head:=1; tail:=0;
while tail=1) and (I


[color="#000099"]原文地址
http://www.yuanma.org/data/2006/0628/article_1006.htm
               
               
               

本文来自ChinaUnix博客，如果查看原文请点：http://blog.chinaunix.net/u2/76292/showart_1388530.html