简单人生
幻想指点江山,梦中激扬文字
基本算法
      
      1.数论算法
      求两数的最大公约数
      function gcd(a,b:integer):integer;
      begin  
          if b=0 then gcd:=a
          else gcd:=gcd (b,a mod b);
      end ;
      
      求两数的最小公倍数
      function lcm(a,b:integer):integer;
      begin
           if a< b then swap(a,b);
           lcm:=a;
           while lcm mod b >0 do inc(lcm,a);
      end;
      
      素数的求法
      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< 50000 do
           begin
                if p[i] then
                begin
                     j:=i*2;
                     while j< 50000 do
                     begin
                          p[j]:=false;
                          inc(j,i);
                     end;
                end;
                inc(i);
          end;
          l:=0;
          for i:=1 to 50000 do
               if p[i] then
               begin
                    inc(l);
                    pr[l]:=i;
               end;
      end;{getprime}
      function prime(x:longint):integer;
      var i:integer;
      begin
           prime:=false;
           for i:=1 to l do
               if pr[i] >=x then break
               else if x mod pr[i]=0 then exit;
           prime:=true;
      end;{prime}
      
      2.
      
      3.
      
      
      4.求最小生成树
      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[i]:=cost[v0,i];
                    closest[i]:=v0;
               end;
           for i:=1 to n-1 do
           begin
                {寻找离生成树最近的未加入顶点k}
                min:=maxlongint;
                for j:=1 to n do
                if (lowcost[j]< min) and (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]< lwocost[j] then
                begin
                      lowcost[j]:=cost[k,j];
                      closest[j]:=k;
                end;
          end;
      end;{prim}
B.Kruskal算法:(贪心)
按权值递增顺序删去图中的边,若不形成回路则将此边加入最小生成树。
function find(v:integer):integer; {返回顶点v所在的集合}
var i:integer;
begin
     i:=1;
     while (i< =n) and (not v in vset[i]) do inc(i);
     if i< =n then find:=i
     else find:=0;
end;
procedure kruskal;
var
tot,i,j:integer;
begin
      for i:=1 to n do vset[i]:=[i];{初始化定义n个集合,第I个集合包含一个元素I}
      p:=n-1; q:=1; tot:=0; {p为尚待加入的边数,q为边集指针}
      sort;
      {对所有边按权值递增排序,存于e[I]中,e[I].v1与e[I].v2为边I所连接的两个顶点的序号,e[I].len为第I条边的长度}
      while p >0 do
      begin
           i:=find(e[q].v1);j:=find(e[q].v2);
           if i< >j then
           begin
                inc(tot,e[q].len);
                vset[i]:=vset[i]+vset[j];vset[j]:=[];
                dec(p);
           end;
           inc(q);
      end;
      writeln(tot);
end;
      
      
      5.最短路径
      A.标号法求解单源点最短路径:
      var
      a:array[1..maxn,1..maxn] of integer;
      b:array[1..maxn] of integer; {b[i]指顶点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[i] then {对每一个已计算出最短路径的点}
                     for j:=1 to n do
                          if (not mark[j]) and (a[i,j] >0) then  
                               if (best=0) or (b[i]+a[i,j]< best) then
                               begin
                                    best:=b[i]+a[i,j]; best_j:=j;
                               end;
                          if best >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]< a[i,j] then
                          begin
                               a[i,j]:=a[i,k]+a[k,j];
                               p[I,j]:=p[k,j];
                          end;
       end;
C. Dijkstra 算法:
类似标号法,本质为贪心算法。
var
a:array[1..maxn,1..maxn] of integer;
b,pre:array[1..maxn] of integer; {pre[i]指最短路径上I的前驱结点}
mark:array[1..maxn] of boolean;
procedure dijkstra(v0:integer);
begin
      fillchar(mark,sizeof(mark),false);
      for i:=1 to n do
           begin
                d[i]:=a[v0,i];
                if d[i]< >0 then pre[i]:=v0 else pre[i]:=0;
           end;
      mark[v0]:=true;
      repeat {每循环一次加入一个离1集合最近的结点并调整其他结点的参数}
           min:=maxint; u:=0; {u记录离1集合最近的结点}
           for i:=1 to n do
                if (not mark[i]) and (d[i]< min) then
                begin
                     u:=i; min:=d[i];
                end;
           if u< >0 then
           begin
                mark[u]:=true;  
                for i:=1 to n do
                     if (not mark[i]) and (a[u,i]+d[u]< d[i]) then
                     begin
                           d[i]:=a[u,i]+d[u];
                           pre[i]:=u;
                     end;
           end;
       until u=0;
end;
D.计算图的传递闭包
Procedure Longlink;
Var
T:array[1..maxn,1..maxn] of boolean;
Begin
      Fillchar(t,sizeof(t),false);
      For k:=1 to n do
           For I:=1 to n do
                For j:=1 to n do
                    T[I,j]:=t[I,j] or (t[I,k] and t[k,j]);
End;
posted on 2007-04-16 09:34 简单人生 阅读(385) 评论(0)  编辑 收藏 引用 所属分类: Loving PHP
只有注册用户登录后才能发表评论。