pascal-基本算法模块.doc

基本算法模块For NOIP2007Billy.Linux对于NOIP，基础是相当重要的，在3个小时之内做完4道题，那么就要求我们有相当快的速度。特别是对于一些简单的、常用的算法模块，一定要要熟练掌握并灵活运用。由于NOIP是一个比较基础的比赛，因此基本算法的掌握尤为重要，所以要求能够把这些基本的模块快速、准确的移植到不同的程序中，才能在稳中取胜。基本算法模块中最重要的是基本程序框架，也就是说，要养成适合于自己的程序风格，这样对于程序编写的速度与程序的准确度都有较大的提高。模块目录一、 排序1 选择排序2 插入排序3 冒泡排序4 快速排序5 堆排序6 归并排序7 线性时间排序二、 高精度1 高精度比较2 高精度加法3 高精度减法4 单精度乘法5 高精度乘法6 单精度除法7 高精度除法8 进制转换三、 数论1 欧几里德算法2 扩展欧几里德3 求最小公倍数4 求解线形同余方程5 素数的判断6 素数的生成四、 排列组合1 排列生成算法2 组合生成算法3 排列按序生成法4 排列字典序生成法五、 图论1 图的读入2 深度优先搜索3 广度优先搜索4 强连同分量5 拓扑排序6 最小生成树7 最短路径六、 背包问题1 装满背包2 一维价值最大背包3 二位价值最大背包一、 排序算法var a:array1.maxnof longint;排序对象1 选择排序Select_sortprocedure select_sort;beginfor i:=1 to n-1 do for j:=i+1 to n doif aiaj then begin temp:=ai;ai:=aj;aj:=temp;end;end;2 插入排序Insert_sortprocedure insert_sort; beginfor i:=2 to n do beginkey:=ai;j:=i-1;while (key0) do begin aj+1:=aj;dec(j);end;aj+1:=key; end;end;3 冒泡排序Bubble_sortprocedure bubble_sort; beginfor i:=1 to n-1 do for j:=n downto i+1 do if ajaj-1 then begin temp:=aj;aj:=aj-1;aj-1:=temp;end; end;4 快速排序Quick_sortprocedure qsort(s,t:longint); var i,j,x:longint; begini:=s;j:=t;x:=a(i+j)div 2;repeat while aix do dec(j);找右边比他小的 if ij;if sj then qsort(s,j);if it then qsort(i,t); end;5 堆排序Heap_sortprocedure heap(i,n:longint);将第i个元素向下筛 var j,x:longint; beginj:=i*2;x:=ai;while j=n do beginif (jn)and(ajaj+1) then inc(j);if xajthen begin ai:=aj;i:=j;j:=i*2; endelse j:=n+1;end;ai:=x;end;procedure heap_sort; beginfor i:=n div 2 downto 1 do heap(i,n);for i:=n downto 2 do begin temp:=ai;ai:=a1;a1:=temp; heap(1,i-1); end; end;6 归并排序Merge_sortprocedure mergesort(s,t:longint); varm,i,j,k:longint;beginif t-s=0 then exit;m:=(s+t)div 2; mergesort(s,m); mergesort(m+1,t); for i:=1 to m-s+1 do bi:=as+i-1; for j:=m+1 to t do cj-m:=aj; i:=1;j:=1;bm-s+2:=max;ct-m+1:=max; for k:=s to t do if bi0 do inc(a0); while bb0+10 do inc(b0); if a0b0 then exit(1); if a0bi then exit(1); if aib0 then c0:=a0else c0:=b0; for i:=1 to a0 do inc(ci,ai); for i:=1 to b0 do inc(ci,bi); for i:=1 to c0 do begin inc(ci+1,ci div maxcount); ci:=ci mod 10; end; while cc0+10 do begin inc(c0); inc(cc0+1,cc0 div maxcount); cc0:=cc0 mod maxcount; end;end;3 高精度减法procedure minus(a,b:bignum;var c:bignum); var i:longint; beginfillchar(c,sizeof(c),0);c0:=a0;for i:=1 to c0 do ci:=ai-bi;for i:=1 to c0 do if ci1)and(cc0=0) do dec(c0);end;4 单精度乘法procedure mulnum(a:bignum;x:longint,var c:bignum); vari:longint; begin fillchar(c,sizeof(c),0);c0:=a0; for i:=1 to c0 do ci:=ai*x; for i:=1 to c0 do begin inc(ci+1,ci div maxcount); ci:=ci mod 10; end; while cc0+10 do begin inc(c0); inc(cc0+1,cc0 div maxcount); cc0:=cc0 mod maxcount;end;end;5 高精度乘法procedure mul(a,b:bignum;var c:bignum); vari,j:longint; begin fillchar(c,sizeof(c),0);c0:=a0+b0-1; for i:=1 to a0 do for j:=1 to b0 do inc(ci+j-1,ai*bj); for i:=1 to c0 do begin inc(ci+1,ci div maxcount); ci:=ci mod 10; end; while cc0+10 do begin inc(c0); inc(cc0+1,cc0 div maxcount); cc0:=cc0 mod maxcount; end;end;6 单精度除法function divnum(a:bignum;x:longint;var c:bignum):longint; var i,temp:longint; begin fillchar(c,sizeof(c),0);c0:=a0;temp:=0;for i:=a0 downto 1 do begin temp:=temp*maxcount+ai; ci:=temp div x; temp:=temp mod x; end;while (co1)and(cc0=0) do dec(c0);exit(temp);end;7 高精度除法procedure div(a,b:bignum;var c,d:bignum); var i:longint; beginfillchar(c,sizeof(c),0);c0:=a0-b0+1;fillchar(d,sizeof(d),0);d0:=1;for i:=c0 downto 1 do begin ci:=maxcount; repeat dec(ci);mul(c,b,temp); until compare(a,temp)=0; end;while (co1)and(cc0=0) do dec(c0);minus(a,temp,d);end;8 进制转换10进制数用bignum记，maxcount=10k进制数用string记const repchar:array0.35of string=(0,1,2,a,b,z);数码对应的字符 repnum:array48.122of longint=(0,1,2,34,35);字符的ASCCI码对应的数码k进制转十进制：procedure change_to_ten(s:string;k:longint):bignum; var i,l:longint; temp:bignum; begin l:=length(s); temp0:=1;temp1:=repnumord(sl); for i:=1 to l-1 do begin inc(temp1,repnumord(sl-i); mulnum(temp,k); end; exit(temp);end;十进制转k进制：procedure change_to_k(num:bignum;k:longint):string; var i,temp:longint; s:string; begin if (num0=1)and(num1=0) then exit(0); while not(num0=1)and(num1=0) do begin temp:=divnum(num,k,num); s:=repchartemp+s; end; exit(s); end;三、 数论算法1 求最大公约数gcd（欧几里德算法）递归(recursion)： function gcd(a,b:longint):longint; begin if b=0 then exit(a); exit(gcd(b,a mod b); end;非递归(iterative)： function gcd(a,b:longint):longint; var t:longint; begin while b0 do begin t:=a;a:=b;b:=t mod b; end; exit(a); end;2 扩展欧几里德算法 function extended_euclid(a,b:longint;var x,y:longint):longint; var p,q:longint; begin if b=0 then begin x:=1;y:=0; exit(a); end; p:=extended_euclid(b, a mod b,x,y); q:=x;x:=y;y:=q-a div b *y; exit(p); end;3 求最小公倍数k:=a*b div gcd(a,b);4 求解线性同余方程typeansnode=record ansnum:longint;解的个数 num:array1.maxnnumof longint;解 end;procedure modular_linear_equation(a,b,n:longint;var ans:ansnode); var d,i,x,y,temp:longint; begin d:=extended_euclid(a,n,x,y); if b mod d 0 then ans.ansnum:=0 else begin ans.ansnum:=d;temp:=(x*(b div d)mod n; for i:=1 to d do ans.numi:=(temp+i*(n div d)mod n; end; end;5 素数的判断function prime_bool(x:longint):boolean; var i:longint; begin for i:=2 to trunc(sqrt(x) do if x mod i=0 then exit(false); exit(true); end;6 素数的生成maxnum=生成质数的范围maxprime=对应范围中的质数个数var prime:array0.maxprimeof longint;存储质数 bool:array1.maxnnumof boolean;存储每个数是不是质数procedure prime_make; var i,j:longint; begin fillchar(bool,sizeof(bool),0); i:=2; while i=maxnnum do begin if not pi then begin j:=2*i; while i=maxnnum do begin pj:=true; inc(j,i); end; inc(prime0);primeprime0:=i; end; inc(i); end;end;四、 排列组合算法1 排列生成算法m的n排列var a:array0.maxnof longint;排列方案 b:array0.maxmof boolean;每个数是否被用过递归(recursion)：procedure make_permutation_recursion(t:longint) var i:longint; begin if t=n+1 then begin write(a1);for i:=2 to n do write( ,ai);writeln; exit; end; for i:=1 to m do if not bi then begin bi:=true;at:=i; make(t+1); bi:=false; end;end;非递归(iterative)：procedure make_permutation_iterative(m,n:longint); var i,j:longint; begin i:=1;a1:=0; repeat j:=ai+1; while (j=m)and(bj) do inc(j); if j1)and(aiai-1) do dec(i); j:=n; while aj=closed; end;4 强连通分量var connected:array1.maxn,0.maxnof longint;connecti,0为此分量包含的节点数 total:longint;强连同分量的个数procedure strongly_connected; var i,time:longint; flag:array1.maxnof boolean; sign:array1.maxnof longint; procedure sort1(t:longint); var i:longint; begin flagt:=true; for i:=1 to n do if (mapt,i0)and(not flagi) then sort1(i); inc(time);signtime:=t; end; procedure sort2(t:longint); var i:longint; begin flagt:=true; for i:=1 to n do if (not flagi)and(mapi,t0) then sort2(i); inc(connectedtotal,0);connectedtotal,connetedtotal,0:=t; end; begin fillchar(flag,sizeof(flag),0); for i:=1 to n do if not flagi then sort1(i); for i:=n downto 1 do if not flagsigni then begin inc(total); sort(signi); end; end;5 拓扑排序procedure topological_sort; var i,open,closed:longint; flag:array1.maxnof boolean; begin open:=0;closed:=0; for i:=1 to n do if invi=0 then begin inc(closed); flagi:=true;AOVclosed:=i; end; if closed=0 then exiterror; repeat inc(open);v:=AOVopen; for i:=1 to vetexv,0 do if not flagvetexv,i then begin dec(invvetexv,i); if invvetexv,i=0 then begin inc(closed); AOVclosed:=vetexv,i;flagvetexv,i:=true; end; end; until open=closed; if closedn then exiterror; end;6 最小生成树Prime:procedure prime_normal; var i,j,min,mj:longint; flag:array1.maxnof boolean; lowcost:array1.maxnof longint; begin fillchar(lowcost,sizeof(lowcost),$5F); lowcost1:=0;flag1:=true; for i:=1 to v1,0 do lowcostv1,i:=map1,v1,i; for i:=2 to n do begin min:=maxlongint; for j:=1 to n do if (not flagj)and(lowcostjmapmj,vmj,j) then lowcostvmj,j:=mapmj,vmj,j; end; end;Kruskal以边为基础读入:procedure kruskal; var set1,set2,vetex_pointer,last_set_num:longint; function find(x:longint):longint; begin if fatherx=x then find:=fatherx else begin fatherx:=find(fatherx);find:=fatherx;end; end; begin qsort(1,e);对vetex以w为关键字从小到大排序 for i:=1 to n do fatheri:=i; vetex_pointer:=1;last_set_num:=n; while (last_set_num1)and(vetex_pointer=e) do begin set1:=find(vetexvetex_pointer.u); set2:=find(vetexvetex_pointer.v); if set1set2 then begin inc(totallen,vetexvetex_pointer.w); dec(last_set_num); fatherset1:=set2; end; inc(vetex_pointer); end; writeln(totallen); end;7 最短路径Dijktra:procedure Dijkstra(s:longint); var i,j,min,mi:longint; begin fillchar(shortest,sizeof(shortest),$5F); shortests:=0; for i:=1 to n do begin min:=max; for j:=1 to n do if (not flagj)and(shortestjmin+mapmi,vetexmi,j) then shortestvetexmi,j:=min+mapmi,vetexmi,j; end; end;Floyd:procedure Floyd; var i,j,k:longint; begin fillchar(len,sizeof(len),$5F); for i:=1 to n do begin leni,i:=0; for j:=1 to vetexi,0 do leni,vetexi,j:=mapi,vetexi,j; end; for k:=1 to n do for i:=1 to n do for j:=1 to n do if leni,k+lenk,jshortestvetexj.u+vetexj.w then begin shortestvetexj.v:=shortestvetexj.u+vetexj.w; bool:=true; end; end; for j:=1 to e do if shortestvetexj.vshortestvetexj.u+vetexj.w then exit(flase); exit(true); end;SPFA:procedure SPFA(s:longint); var u,i:longint; x0:array1.maxnof longint; begin fillchar(shortest,sizeof(shortest),$5f); fillchar(flag,sizeof(flag),0); open:=0;closed:=1;x01:=s;shortests:=0;flags:=true; repeat inc(open);u:=x0open; for i:=1 to vetexu,0 do if shortestvetexu,i=