Matlab 版 (精华区)

发信人: zjliu (秋天的萝卜), 信区: Matlab
标  题: 基本算法(转)--数论与图论
发信站: BBS 哈工大紫丁香站 (Tue May 25 16:12:23 2004)

基本算法(转)
(转自 中国开发者联盟)

基本算法

     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);
          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);
          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;
     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;
     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
               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为边集指针}
     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;
     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;
                              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
          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;


9.树的遍历顺序转换
     A. 已知前序中序求后序
     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;

     B.已知中序后序求前序
     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;
     end;

     C.已知前序后序求中序

     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[i]=s2[j] then p:=true;
               if not p then
               begin
                    ok:=false;exit;
               end;
          end;
     end;

     procedure solve(pre,post:string);
     var i:integer;
     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;

     10.求图的弱连通子图(DFS)
     procedure dfs ( now,color: integer);
     begin
          for i:=1 to n do
               if a[now,i] and c[i]=0 then
               begin
                    c[i]:=color;
                    dfs(I,color);
               end;
     end;

          midstr:=midstr+pre[1];
     10.求图的弱连通子图(DFS)
     procedure dfs ( now,color: integer);
     begin
          for i:=1 to n do
               if a[now,i] and c[i]=0 then
               begin
                    c[i]:=color;
                    dfs(I,color);
               end;
     end;
--
╔═══════════════════╗
║★★★★★友谊第一  比赛第二★★★★★║
╚═══════════════════╝


※ 来源:·哈工大紫丁香 http://bbs.hit.edu.cn·[FROM: 202.118.229.*]
[百宝箱] [返回首页] [上级目录] [根目录] [返回顶部] [刷新] [返回]
Powered by KBS BBS 2.0 (http://dev.kcn.cn)
页面执行时间:207.504毫秒