1、程序一栏一、高精度算法高精度存储 fillchar(a,sizeof(a),0); fillchar(b,sizeof(b),0); for i:=1 to la do ai:=ord(sala-i+1)-ord(0); for i:=1 to lb do bi:=ord(sblb-i+1)-ord(0);高精度加法 if lalb then len:=la else len:=lb; for i:=1 to len do begin ai+1:=ai+1+(ai+bi) div 10; ai:=(ai+bi) mod 10; end; if alen+10 then len:=len+1;高
2、精度减法 if sa=sb then begin writeln(0); halt; end; if (length(sb)length(sa) or(length(sb)=length(sa)and(sasb) then begin s:=sa; sa:=sb; sb:=s; end; len:=la; for i:=1 to len do begin if aibi then begin ai:=ai+10; ai+1:=ai+1-1; end; ai:=ai-bi; end; while alen=0 do dec(len);高精度数乘高精度数 if (sa=0) or (sb=0) t
3、hen begin writeln(0); halt; end; len:=la+lb; for i:=1 to la do for j:=1 to lb do ci+j-1:=ci+j-1+ai*bj; for i:=1 to len do begin ci+1:=ci+1+ci div 10; ci:=ci mod 10; end;高精度数乘单精度数 if (n=0) or (sa=0) then begin writeln(0); halt; end; la:=length(sa); for i:=1 to la do ai:=ai*n; for i:=1 to la do begin
4、ai+1:=ai+1+ai div 10; ai:=ai mod 10; end; la:=la+1; while ala0 do begin ala+1:=ala div 10; ala:=ala mod 10; la:=la+1; end; while ala=0 do dec(la);高精度压位 if (sa=0) or (sb=0) then begin writeln(0); halt; end; while la mod 80 do begin sa:=0+sa; la:=la+1; end; while lb mod 80 do begin sb:=0+sb; lb:=lb+1;
5、 end; yla:=la div 8; for i:=1 to yla do val(copy(sa,8*i-7,8),ayla-i+1); ylb:=lb div 8; for i:=1 to ylb do val(copy(sb,8*i-7,8),bylb-i+1); for i:=1 to yla do for j:=1 to ylb do ci+j-1:=ci+j-1+ai*bj; len:=yla+ylb; for i:=1 to len do begin ci+1:=ci+1+ci div 100000000; ci:=ci mod 100000000; end; len:=le
6、n+1; while clen=0 do dec(len); for i:=len downto 1 do begin if ilen then begin if (ci10) and(ci100) and (ci1000) and (ci10000) and (ci100000) and (ci1000000) and (ciaj then k:=j; j:=ai; ai:=ak; ak:=j; end;冒泡排序 for i:=1 to n-1 do begin sorted:=true; for j:=n downto i+1 do if aj0) and (ajk) do begin a
7、j+1:=aj; dec(j); end; aj+1:=k; end;快速排序 procedure qsort(l,r:longint); var i,j,x,y,z:longint; begin i:=l; j:=r; z:=random(r-l)+l+1; x:=az; while ij do begin while aix do dec(j); if i=j then begin y:=ai; ai:=aj; aj:=y; inc(i); dec(j); end;end; if ir then qsort(i,r); if lj then qsort(l,j);堆排序 procedure
8、 down(i:longint); var j,t:longint; begin while i=total div 2 do begin j:=2*i; if (jtotal) and (dj+1dj) then j:=j+1; if djdi then begin t:=dj； dj:=di; di:=t; i:=j; end else break; end; end;total:=n;for i:=total div 2 downto 1 do down(i); for i:=1 to n do begin tmp:=dtotal; dtotal:=d1; d1:=tmp; total:
9、=total-1; down(1); end;合并排序procedure merge(s,m,t:longint); var i,j,k:longint; begin i:=s; j:=m+1; k:=s-1; while (i=m)and (j=t) do begin inc(k); if ai=aj then begin bk:=ai; i:=i+1; end else begin bk:=aj; j:=j+1; end; end; while i=m do begin inc(k); bk:=ai; i:=i+1; end; while j=t do begin inc(k); bk:=
10、aj; j:=j+1; end; for i:=s to t do ai:=bi; end;procedure mergesort(s,t:longint); var m:longint; begin if st then begin m:=(s+t) div 2; mergesort(s,m); mergesort(m+1,t); merge(s,m,t); end; end;三、栈 队列 线性表线性表操作procedure insert(x:longint); var j:longint; begin a0:=x; j:=n; while a0aj do begin aj+1:=aj; d
11、ec(j); end; aj+1:=a0; n:=n+1; end;procedure delete(k:longint); var i:longint; begin for i:=k to n-1 do ai:=ai+1; dec(n); end;栈操作procedure init; begin t:=0; end;procedure push( x:stype)； begin t:=t+1； st:=x； endfunction pop:stype； begin pop:=st； t:=t-1；end；function top :stype； begin if t=0 then write
12、ln (stack empty) else top:=st； end四、搜索算法哈希函数function hash(s:string):longint; var k,i:longint; begin k:=0; for i:=n downto 1 do k:=k*2+ord(si)-65; hash:=k;end;base:array1.9of longint=(1,4,16,64,256,1024,4096,16384,65536);function hasht:longint; var i,h:longint; begin h:=0; for i:=1 to 9 do inc(h,base
13、i*testi); exit(h);end;五、查找二分查找function find1(s,t:integer;x:integer):integer; var m:integer; begin while s=t do begin m:=(s+t)div 2; if x=am then exit(m); if xam then s:=m+1; end; exit(0)； end;六、树树的三种遍历procedure front(i:integer);begin if ti.name# then begin write(ti.name); if ti.Left0 then front(ti.L
14、eft); if ti.right0 then front(ti.right);end; end;先序中序确定后序var sx,sz:string; 算法procedure work(sx,sz:string);sx:先序序列; sz：中序序列 var L,k:integer; begin if sx then begin L:=Length(sx); k:=pos(sx1,sz); work(copy(sx,2,k-1),copy(sz,1,k-1); work(copy(sx,k+1,L-k),copy(sz,k+1,L-k); write(sx1); end; end;begin rea
15、dLn(sx); readLn(sz); work(sx,sz); end;哈夫曼树procedure hufm(var tree:treetype);function min (h:integer):integer;在前h个结点中选择父指针为0且权值最小的结点min var m1,p,i:integer; begin m1:=32767; for p := 1 to h do if (treep.prt=0)and(m1treep.data) 没有父亲结点且较小的结点 then begin i:= p; m1:= treep.data; end; min:= i; end;begin for
16、 k:= n+1 to m do 构造最优二叉树生成n-1个新结点 begin 计算k为根的左儿子和右儿子 i:= min(k-1); treei.prt:= k; treek.Lch:= i; j:= min(k-1); treej.prt:= k; treek.rch:= j; treek.data:= treei.data+treej.data; end;end;七、动态规划背包问题 原始问题：已知背包总容量和k个物件的体积和价值。物件要末装入背包要末不装入。求价值和最大的装入方案。 一般方法： 阶段i：按照递增顺序枚举物件数i； 状态j:在不超过背包总容量的前提下,按递减顺序枚举前i件
17、物件的可能体积j; 决策：要使得价值和最大，第i个物件装还是不装子序列左右取数问题阶段l：序列长度(1ln)；状态i:当前序列的首指针(1 in+1-l);由此得出当前序列为i，j(j=i+l-1)fi,j为取子序列gi,j的最优解。决策有两个 左端取数：fi+1,j+gi 右端取数：fi,j-1+gj显然 fi,i=gi*取1个数的价值 fi,j=maxfi+1,j+gi, fi,j-1+gj*取1 个数的价值阶段l:子序列长度（2ln）状态i：子序列首指针（1in-l+1），子序列尾指针j=i+l-1决策：取i位置的数还是j位置的数递增子序列在数列中寻求未必连续的最长递增子序列。例如3 2
18、 4 4 5 6递增子序列： 3 4 4 5 6 或者 2 4 4 5 6一般方法：设bi为前i个数中最长递增子序列的长度 阶段i：按照递增方向枚举子序列长度(1in) 状态j：前一个个数的可能位置（1ji-1） 决策：若（aiaj)and(bj+1bi)则bi设为 bj+1；否则bi不变。另外，可以采用二分法。 左右子序列合并 阶段l：区间长度(2ln) 状态i：区间首元素指针(1in)，即区间为i，(i+l-2)mod n+1 决策k：左子区间的尾指针k(i-1)mod n+1k(i+l-3)mod n+1),即左子区间为i，k，右子区间为(k+1)mod n+1,(i+l-2)mod n
19、+1，最后枚举尾指针为i、长度为n的所有可能区间i mod n+1)，i（1in）从中找出最佳合并方案。指定合并次数 阶段p：当前子序列划分出的部分数(1pm-1) 状态(i,j):当前子序列的首尾指针(1in,ijn)； 决策k:第p部分的首指针在什么位置时最佳(i+pkj)；注意:当i1或者jn时,总有一部分跨过an、a1,因此先对前m-1部分进行规划,最后处理m部分的最佳划分问题。圆排列的活动方案计数 n个元素组成一个圆排列,一次活动在相邻两元素间进行。在指定活动m次内完成一周的传递共有多少种方案？ 阶段i：传递次数,1im 状态j：第i次传递到的元素序号，1jn。注意圆排列的特殊情况：
20、即元素1的左右元素序号为n和2。 决策：第i次传球时元素j接到来自左右邻的信息； 设fi,j为第i次传递，信息传到元素j的方案数。显然最初信息掌握在初始元素，即f0,初始元素序号=1，目标是计算fm,初始元素序号 八、图论图的遍历procedure dfs(i:longint); var j:longint; begin write(ti, ); vi:=true; for j:=1 to n do if (not vj) and (ai,j=1) then dfs(j); end;procedure bfs(i:longint); var q:array1.map of longint; h
21、ead,tail,j:longint; begin fillchar(q,sizeof(q),0); head:=0; tail:=1; q1:=i; vi:=true; write(ti, ); while headtail do begin inc(head); for j:=1 to n do if (not vj) and (aqhead,j=1)then begin inc(tail); qtail:=j; write(tj, ); vj:=true; end; end; end;拓扑排序procedure topsort; var i,j,k:longint; begin for
22、i:=1 to n do begin j:=1; while (j=n) and (intoj0) do inc(j); if j=n+1 then begin f:=false; exit; end else begin inc(t); dt:=j; intoj:=$fF; for k:=1 to n do if aj,k=1 then dec(intok); end;end;end;哈密顿路（哈密顿回路）procedure dfs(i:longint); var j:longint; begin visitedi:=true; m:=m+1; bm:=i; if (m=n) and (ab
23、n,b1=1) then begin for i:=1 to n do write(bi, ); halt; end; for j:=1 to n do if (not visitedj) and (aj,i=1) then dfs(j); m:=m-1; visitedi:=false; end;begin for i:=1 to n do begin fillchar(visited,sizeof(visited),false); m:=0; dfs(i); end;end.Floyedprocedure init; var i,j:longint; begin for i:=1 to n
24、 do for j:=1 to n do begin read(costi,j); if (costi,j=0) or (costi,j=-1) then begin costi,j:=maxint; pi,j:=0; end; ai,j:=costi,j; end; end;procedure floyed; var i,j,k:longint; begin for k:=1 to n do for i:=1 to n do for j:=1 to n do if(ai,k+ak,jai,j )then begin ai,j:=ai,k+ak,j; pi,j:=k; end;end;proc
25、edure path(i,j:longint); var k:longint; begin k:=pi,j; if k0 then beginpath(i,k); write(k, ); path(k,j); end; end;begin readln(n,x,y); init; floyed; writeln(ax,y); if px,y=0 then writeln(No Road) else begin write(x, ); path(x,y); writeln(y); end;end.Dijkstraprocedure dijkstra; var i,j,min,minj:longint; begin fillchar(mark,sizeof(mark),false); for i:=1 to n do di:=maxlongint; dk:=0; for i:=1 to n do begin min:=maxlongint; for j:=1 to n do if (not markj) and (dj0
