算法及编程语言 - 声振论坛 - 振动,动力学,声学,信号处理,故障诊断

gghhjj 发表于 2005-8-28 14:56

[分享]一些基本算法

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&lt; b then swap(a,b); lcm:=a; while lcm mod b &gt; 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 of boolean; begin fillchar(p,sizeof(p),true); p:=false; i:=2; while i&lt; 50000 do begin if p then begin j:=i*2; while j&lt; 50000 do begin p:=false; inc(j,i); end; end; inc(i); end; l:=0; for i:=1 to 50000 do if p then begin inc(l); pr:=i; end; end;{getprime} function prime(x:longint):integer; var i:integer; begin prime:=false; for i:=1 to l do if pr &gt;=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 of integer; i,j,k,min:integer; begin for i:=1 to n do begin lowcost:=cost; closest:=v0; end; for i:=1 to n-1 do begin {寻找离生成树最近的未加入顶点k} min:=maxlongint; for j:=1 to n do if (lowcost&lt; min) and (lowcost&lt; &gt;0) then begin min:=lowcost; k:=j; end; lowcost:=0; {将顶点k加入生成树} {生成树中增加一条新的边k到closest} {修正各点的lowcost和closest值} for j:=1 to n do if cost&lt; lwocost then begin lowcost:=cost; closest:=k; end; end; end;{prim} 
B.Kruskal算法：(贪心) 按权值递增顺序删去图中的边，若不形成回路则将此边加入最小生成树。 function find(v:integer):integer; {返回顶点v所在的集合} var i:integer; begin i:=1; while (i&lt; =n) and (not v in vset) do inc(i); if i&lt; =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中，e.v1与e.v2为边I所连接的两个顶点的序号，e.len为第I条边的长度} while p &gt;0 do begin i:=find(e.v1); j:=find(e.v2); if i&lt; &gt;j then begin inc(tot,e.len); vset:=vset+vset; vset:=[]; dec(p); end; inc(q); end; writeln(tot); end;

gghhjj 发表于 2005-8-28 14:57

回复：（ggggggl）[分享]一些基本算法

5.最短路径 
A.标号法求解单源点最短路径： var a:array of integer; b:array of integer; {b指顶点i到源点的最短路径} mark:array of boolean; procedure bhf; var best,best_j:integer; begin fillchar(mark,sizeof(mark),false); mark:=true; b:=0;{1为源点} repeat best:=0; for i:=1 to n do If mark then {对每一个已计算出最短路径的点} for j:=1 to n do if (not mark) and (a &gt;0) then if (best=0) or (b+a&lt; best) then begin best:=b+a; best_j:=j; end; if best &gt;0 then begin b:=best; mark:=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 &gt;0 then p:=I else p:=0; {p表示I到j的最短路径上j的前驱结点} for k:=1 to n do {枚举中间结点} for i:=1 to n do for j:=1 to n do if a+a&lt; a then begin a:=a+a; p:=p; end; end; 
C. Dijkstra 算法： 类似标号法，本质为贪心算法。 var a:array of integer; b,pre:array of integer; {pre指最短路径上I的前驱结点} mark:array of boolean; procedure dijkstra(v0:integer); begin fillchar(mark,sizeof(mark),false); for i:=1 to n do begin d:=a; if d&lt; &gt;0 then pre:=v0 else pre:=0; end; mark:=true; repeat {每循环一次加入一个离1集合最近的结点并调整其他结点的参数} min:=maxint; u:=0; {u记录离1集合最近的结点} for i:=1 to n do if (not mark) and (d&lt; min) then begin u:=i; min:=d; end; if u&lt; &gt;0 then begin mark:=true; for i:=1 to n do if (not mark) and (a+d&lt; d) then begin d:=a+d; pre:=u; end; end; until u=0; end; 
D.计算图的传递闭包 Procedure Longlink; Var T:array 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:=t or (t and t); End; 
7.排序算法 
A.快速排序： procedure sort(l,r:integer); var i,j,mid:integer; begin i:=l;j:=r; mid:=a[(l+r) div 2]; {将当前序列在中间位置的数定义为中间数} repeat while a&lt; mid do inc(i); {在左半部分寻找比中间数大的数} while mid&lt; a do dec(j);{在右半部分寻找比中间数小的数} if i&lt; =j then begin {若找到一组与排序目标不一致的数对则交换它们} swap(a,a); inc(i); dec(j); {继续找} end; until i &gt;j; if l&lt; j then sort(l,j); {若未到两个数的边界，则递归搜索左右区间} if i&lt; r then sort(i,r); end;{sort} 
B.插入排序： 
procedure insert_sort(k,m:word); {k为当前要插入的数，m为插入位置的指针} var i:word; p:0..1; begin p:=0; for i:=m downto 1 do if k=a then exit; repeat If k &gt;a then begin a:=k; p:=1; end else begin a:=a; dec(m); end; until p=1; end;{insert_sort} l 主程序中为： a:=0; for I:=1 to n do insert_sort(b,I-1); 
C.选择排序： procedure sort; var i,j,k:integer; begin for i:=1 to n-1 do begin k:=i; for j:=i+1 to n do if a&lt; a then k:=j; {找出a..a中最小的数与a作交换} if k&lt; &gt;i then begin a:=a; a:=a; a:=a; end; end; end; 
D. 冒泡排序 procedure sort; var i,j,k:integer; begin for i:=n downto 1 do for j:=1 to i-1 do if a &gt;a then begin a:=a; a:=a; a:=a; end; end; 
E.堆排序： procedure sift(i,m:integer);{调整以i为根的子树成为堆,m为结点总数} var k:integer; begin a:=a; k:=2*i;{在完全二*树中结点i的左孩子为2*i,右孩子为2*i+1} while k&lt; =m do begin if (k&lt; m) and (a&lt; a) then inc(k);{找出a与a中较大值} if a&lt; a then begin a:=a; i:=k; k:=2*i; end else k:=m+1; end; a:=a; {将根放在合适的位置} end; 
procedure heapsort; var j:integer; begin for j:=n div 2 downto 1 do sift(j,n); for j:=n downto 2 do begin swap(a,a); sift(1,j-1); end; end; 
F. 归并排序 {a为序列表，tmp为辅助数组} procedure merge(var a:listtype; p,q,r:integer); {将已排序好的子序列a与a合并为有序的tmp} var I,j,t:integer; tmp:listtype; begin t:=p; i:=p; j:=q+1;{t为tmp指针，I,j分别为左右子序列的指针} while (t&lt; =r) do begin if (i&lt; =q){左序列有剩余} and ((j &gt;r) or (a&lt; =a)) then{满足取左边序列当前元素的要求} begin tmp:=a; inc(i); end else begin tmp:=a; inc(j); end; inc(t); end; for i:=p to r do a:=tmp; end;{merge} 
procedure merge_sort(var a:listtype; p,r: integer); {合并排序a} var q:integer; begin if p&lt; &gt;r 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.

gghhjj 发表于 2005-8-28 14:57

回复：（ggggggl）[分享]一些基本算法

9.树的遍历顺序转换 
A. 已知前序中序求后序 procedure Solve(pre,mid:string); var i:integer; begin if (pre='') or (mid='') then exit; i:=pos(pre,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; {加上根，递归结束后post即为后序遍历} end; 
B.已知中序后序求前序 procedure Solve(mid,post:string); var i:integer; begin if (mid='') or (post='') then exit; i:=pos(post,mid); pre:=pre+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; 
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=s2 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; 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 and c=0 then begin c:=color; dfs(I,color); end; end; 
12.进制转换 A.整数任意正整数进制间的互化 NOIP1996数制转换 设字符串A$的结构为: A$='mp' 其中m为数字串(长度&lt; =20),而n,p均为1或2位的数字串(其中所表达的内容在2-10之间) 程序要求:从键盘上读入A$后(不用正确性检查),将A$中的数字串m(n进制)以p进制的形式输出. 例如:A$='48&lt; 10 &gt;8' 其意义为:将10进制数48,转换为8进制数输出. 输出结果:48&lt; 10 &gt;=60&lt; 8 &gt; B.实数任意正整数进制间的互化 C.负数进制： NOIP2000 设计一个程序，读入一个十进制数的基数和一个负进制数的基数， 并将此十进制数转换为此负进制下的数：-R∈{-2，-3，-4,....-20} 
13.全排列与组合的生成排列的生成：（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; 
组合的生成(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 &gt;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;

gghhjj 发表于 2005-8-28 14:57

回复：（ggggggl）[分享]一些基本算法

14 递推关系计算字串序号模型 USACO1.2.5 StringSobits 长度为N (N&lt; =31)的01串中1的个数小于等于L的串组成的集合中找出按大小排序后的第I个01串。 数字划分模型 *NOIP2001数的划分 将整数n分成k份，且每份不能为空， 任意两种分法不能相同(不考虑顺序)。 d:=1; for p:=1 to n do for i:=p to n do for j:=k downto 1 do inc(d,d); writeln(d); *变形1：考虑顺序 d[ i, j] : = d [ i-k, j-1] (k=1..i) *变形2：若分解出来的每个数均有一个上限m d[ i, j] : = d [ i-k, j-1] (k=1..m) 
15.算符优先法求解表达式求值问题 const maxn=50; var s1:array of integer; {s1为数字栈} s2:array of char; {s2为算符栈} t1,t2:integer; {栈顶指针} procedure calcu; var x1,x2,x:integer; p:char; begin p:=s2; dec(t2); x2:=s1; dec(t1); x1:=s1; dec(t1); case p of '+':x:=x1+x2; '-':x:=x1-x2; '*':x:=x1*x2; '/':x:=x1 div 2; end; inc(t1); s1:=x; end; procedure work; var c:char; v:integer; begin t1:=0; t2:=0; read(c); while c&lt; &gt;';' do case c of '+','-': begin while (t2 &gt;0) and (s2&lt; &gt;'(') do calcu; inc(t2);s2:=c; read(c); end ; '*','/': begin if (t2 &gt;0) and ((s2='*') or (s2='/')) then calcu; inc(t2);s2:=c; read(c); end; '(': begin inc(t2); s2:=c; read(c); end; ')': begin while s2&lt; &gt; '(' do calcu; dec(t2); read(c); end; '0'..'9': begin v:=0; repeat v:=10*v+ord(c)-ord('0'); read(c); until (c&lt; '0') or (c &gt;'9'); inc(t1); s1:=v; end; end; while t2 &gt;0 do calcu; writeln(s1); end; 
16.查找算法 折半查找 function binsearch(k:keytype):integer; var low,hig,mid:integer; begin low:=1; hig:=n; mid:=(low+hig) div 2; while (a.key&lt; &gt;k) and (low&lt; =hig) do begin if a.key &gt;k then hig:=mid-1 else low:=mid+1; mid:=(low+hig) div 2; end; if low &gt;hig then mid:=0; binsearch:=mid; end; 树形查找 二*排序树：每个结点的值都大于其左子树任一结点的值而小于其右子树任一结点的值。 查找 function treesrh(k:keytype):pointer; var q:pointer; begin q:=root; while (q&lt; &gt;nil) and (q^.key&lt; &gt;k) do if k&lt; q^.key then q:=q^.left else q:=q^.right; treesrh:=q; end;

linqus 发表于 2005-8-28 15:23

不知楼主用的是什么代码， vb/ada？还是伪代码？ 只用过fortran，c及matlab语言。

christy 发表于 2005-8-28 20:55

回复：（ggggggl）[分享]一些基本算法

怎么看这像是脚本程序？

FSI 发表于 2005-8-29 09:27

像是pascal。呵呵能看明白就行了，反正讲的是算法原理。

Xavier_kai 发表于 2005-10-9 23:30

谢谢　楼主

Frigoris 发表于 2006-4-22 18:54

好东西啊，全面总结 好像的确是Pascal，不过我已经忘光了pascal 现在Pascal对我来说就等于一种伪代码:P

页: [1]

声振论坛's Archiver

[分享]一些基本算法

回复：（ggggggl）[分享]一些基本算法

回复：（ggggggl）[分享]一些基本算法

回复：（ggggggl）[分享]一些基本算法

回复：（ggggggl）[分享]一些基本算法