4.txt

数论算法 求两数的最大公约数 等程序 ！欢迎下载

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 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 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 >=x then break 
        else if x mod pr=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:=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]< 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) 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:=;{初始化定义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:=vset+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到源点的最短路径} 
  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]< best) then 
                    begin 
                      best:=b+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的前驱结点} 
mark:array[1..maxn] of boolean; 
procedure dijkstra(v0:integer); 
begin 
  fillchar(mark,sizeof(mark),false); 
  for i:=1 to n do 
      begin 
          d:=a[v0,i]; 
          if d< >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 (d< min) then 
          begin 
            u:=i; min:=d; 
          end; 
      if u< >0 then 
      begin 
          mark:=true; 
          for i:=1 to n do 
            if (not mark) and (a[u,i]+d< d) then 
            begin 
                d:=a[u,i]+d; 
                pre:=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;