pascal省选模板

1、pascal省选模板算法线段树 . 1平衡二叉树 . 3匈牙利算法 . 8Km算法 . 9Sap 算法 . 10Rmq问题的 St 算法 . 12树状数组 . 13最小费用最大流 . 15Tarjan 算法 . 17根堆 . 21并查集 . 22Prim 算法 . 23计算几何 . 26A*算法 . 31矩阵乘法 . 34快速幂 . 38线段树 线段树示范程序Program IntervalTree;ConstInf='Input.txt'Ouf='Output.txt'Maxn=10000;TypeTreeNode=Record/a,b:区间左右边界， lef

2、t,right:左右儿子 ,cover:是否被覆盖a,b,Left,Right,Cover:Longint;End;VarTree:array 1.Maxn of TreeNode;Number,Tot,c,d:Longint; /tot:线段树节点总数Procedure MakeTree(a,b:Longint); / Var建树Now:Longint; /now必须为局部变量!(dfs中枚举变量一样的道理)BeginInc(Tot); /Now:=Tot;节点总数 +11TreeNow.a:=a; TreeNow.b:=b; TreeNow.Cover:=0; /把a,b数据写入到 tre

3、etot;If a+1<b then beginTreeNow.Left:=Tot+1;MakeTree(a,(a+b) div 2); /建左子树TreeNow.Right:=Tot+1; /(若 now为全局变量，建左子树会修改now 的值，导致此处建树不正确)MakeTree(a+b) div 2,b); /End;End;建右子树Procedure Insert(Num:Longint); /插入线段 c,d(c,d为全局变量) 到线段树第num个节点区间BeginIf (c<=TreeNum.a) and (TreeNum.b<=d) then /若当前区间被 c,

4、d覆盖，则 cover+1TreeNum.Cover:=TreeNum.Cover+1Else begin /否则将区间 c,d插到左右子树中If c<(TreeNum.a+TreeNum.b) div 2 then Insert(TreeNum.Left);If d>(TreeNum.a+TreeNum.b) div 2 then Insert(TreeNum.Right);End;End;Procedure Delete(Num:Longint);/在线段树第 num个节点区间中删除线段c,d BeginIf (c<=TreeNum.a) and (TreeNum.b&l

5、t;=d) then /若当前区间被 c,d覆盖，则 cover-1Dec(TreeNum.Cover)Else begin /否则将区间 c,d在左右子树中删除If c<(TreeNum.a+TreeNum.b) div 2 then Delete(TreeNum.Left);If d>(TreeNum.a+TreeNum.b) div 2 then Delete(TreeNum.Right);End;End;Procedure Count(Num:longint); /计算整个线段树的测度 ( 被覆盖区间的总长度 )BeginIf TreeNum.Cover>0 then

6、 /若当前区间被完全覆盖，则累加到number 全局变量中Number:=Number+(TreeNum.b-TreeNum.a)Else begin /否则，若为部分覆盖，则累加左右子树的测度If TreeNum.Left>0 then Count(TreeNum.Left);If TreeNum.Right>0 then Count(TreeNum.Right);End;End;BeginAssign(Input,Inf);Reset(Input);Assign(Output,ouf);Rewrite(Output);Readln(c,d); /读入总区间大小2MakeTree

7、(c,d); / While not eof do Begin建树Readln(c,d); /向线段树中插入线段c,dInsert(1);End;Count(1); /计算线段树的测度Writeln(Number);Close(Output);Close(Input);End.平衡二叉树treap示范代码 :标准的代码缩进风格，优美的算法实现。经典标程，完全掌握后水平会提高很多不改变 bst 的性质 ( 在 bst 所有子树中均满足 : 左子树的所有节点 <=根 <=右子树的所有节点 )通过旋转操作，使根的hr 最小 ( 即所有的 hr 构成堆的关系 ) $inline onvar

8、/li,ri,vi:i号结点的左儿子、右儿子，关键值/hri:i号节点的优先值 (treap所有子树中 , 根的 hr 必须是最小的 )/si:i号节点为根的子树节点总数l,r,hr,s,v:array0.2000000of longint;n,root,m:longint;procedure init;/beginreadln(n);m:=0;初始化/randomize; /考试要求程序每次运行结果必须一致, 慎用。确实要用 :randomize 100;fillchar(s,sizeof(s),0);fillchar(l,sizeof(l),0);fillchar(r,sizeof(r),

9、0);root:=0;end;/ 旋转是平衡二叉树的精髓，它不会改变bst 的性质 ( 左子树 <=根 <=右子树 )/ 左旋使树的左子树深度 +1, 右子树深度 -13/ 右旋使树的右子树深度 +1, 左子树深度 -1procedure l_rotate(var x:longint);inline;/左旋以 x 为根的子树 ( 注意var 参数及意义 )vary:longint;beginy:=rx; /保存x的右儿子到y 中rx:=ly; /将 y的左儿子作为x 的右儿子ly:=x; /x作为y 的左儿子sy:=sx; /维护旋转后的子树大小sx:=slx+srx+1;x:=y

10、; /yend;为根procedure r_rotate(var x:longint);inline;/右旋以x 为根的子树vary:longint;beginy:=lx;lx:=ry;ry:=x;sy:=sx;sx:=slx+srx+1;x:=y;end;/ 插入 ( 递归， if key<=root, 则插入到左子树，否则到右子树，直到尽头再新建节点 )procedure insert(var k,key:longint);inline; beginif k=0 then/已到尽头，新建节点并写入begininc(m);vm:=key;sm:=1;hrm:=random(maxlon

11、gint);key及随机值hrk:=m;/ 修改 k, 使父节点指向当前节点 ( 修改前从父节点指向0)exit;end;inc(sk);if key<=vk then/ 若 key<=根则插入到左子树，否则到右子树 begininsert(lk,key);/若 lk=0,到下层则新建节点并修改lk=mif hrlk>hrk then /r_rotate(k);exit;4end;if key>vk thenbegininsert(rk,key);if hrrk>hrk thenl_rotate(k);exit;end;end;旋转( 删除 : 在 k 号节点为根

12、的子树中删除key基本方法 : 由于是静态结构，为了提高效率，并没真正删除 若找到则删除，若没找到，则删除查找尽头的节点主程序中需判断返回值，若不等于key, 重新插入 key 即可 找到后的处理 :若为叶节点，直接删除，否则，将要删除的节点左子树的最右节点(思考:为什么 ,)代替它)function delete(var k:longint;key:longint):longint;inline;begindec(sk);/维护节点总数/ 如果找到，或已到尽头if (key=vk)or(lk=0)and(key<=vk)or(rk=0)and(key>vk) then begin

13、delete:=vk;/返回要删除的节点 ( 不一定 =key)if (lk=0)or(rk=0) then / begin若左右子树只有一个，则让儿子代替根即可k:=lk+rk;/用儿子替换当前要删除的节点exit;end;vk:=delete(lk,key+1);/k左右子树都有，则用左子树的最右节点替换kexit;end;if key<=vk then/若 k<=vk,exit(delete(lk,key);if key>vk thenexit(delete(rk,key); end;则在左子树中删，否则，在右子树中删function find(var k,key:lo

14、ngint):boolean;inline;/查找beginif k=0 then/递归边界exit(false);5if key>vk thenfind:=find(rk,key)elsefind:=(vk=key)or find(lk,key); end;/key的排名 (key 排在第几，按从小到大的顺序)function rank(var t,key:longint):longint;inline;beginif t=0 thenexit(1);if key<=vt thenrank:=rank(lt,key)elserank:=slt+1+rank(rt,key); en

15、d;function select(var t:longint;k:longint):longint;inline;/选择排在第k 位的数beginif k=slt+1 then/若找到第k 位的节点，则返回节点key值exit(vt);if k<=slt then/ select:=select(lt,k) else递归select:=select(rt,k-1-slt); end;function pred(var t,key:longint):longint;inline;/找 key 的前趋beginif t=0 thenexit(key);if key<=vt then/

16、key<=根，原问题等价于在左子树中找keypred:=pred(lt,key)else begin /key>根，原问题等价于在右子树中找key，但右儿子返回时，要判断你是不是 key 的前趋pred:=pred(rt,key);/右子树的返回值if pred=key then /如果右子树的返回值 =key 说明在右子树中没找到key 的前趋pred:=vt; /右子树没有key的前趋，那你就是了。end;end;function succ(var t,key:longint):longint;inline;/找key的后继6beginif t=0 thenexit(key);

17、if vt<=key thensucc:=succ(rt,key)else beginsucc:=succ(lt,key);if succ=key thensucc:=vt;end;end;procedure order;inline;/vara,b:longint;beginreadln(a,b);case a of1:insert(root,b);2:delete(root,b);3:writeln(find(root,b);4:writeln(rank(root,b);5:writeln(select(root,b);6:writeln(pred(root,b);7:writeln

18、(succ(root,b);end;end;操作解释和执行procedure main;inline;/vari:longint;begininit;主模块for i:=1 to n doorder;end;begin/主程序assign(input,'treap.in');reset(input);assign(output,'treap.out');rewrite(output);main;close(input);7close(output);end.匈牙利算法匈牙利算法是用来解决二分图最大匹配问题的经典算法。每次选一个未盖点u 进行 DFS找增广路 .如

19、果找不到增广路则换一个未盖点,且以后再也不从u 出发找增广路 .基于 DFS的具体实现方法 :对于一个点 x 和一个点 i ，如果 x 和 i 匹配，那么就匹配 ; 如果 i 已和 j 匹配，那么就看 j 能否和别的点匹配，如果能就可以 x 和 i 匹配，匹配数 +1。PASCAL代码实现 :varg:array1.maxn,1.maxmof boolean; /图， gi,j:节点 i 到节点 j 是否有边y:array1.maxmof boolean; /访问标记， yi:节点 i 是否已被访问过link:array1.maxmof longint; /与节点i匹配的点，linki=0表示

20、i没有被匹配function find(v:longint):boolean; /vari:longint;begin从 v 出发找匹配for i:=1 to m do /枚举与v 相连的点iif gv,i and (not yi) then /如果i与 v 相连且还未被访问过beginyi:=true; /标记i已被访问过if (linki=0)or find(linki) then /如果i无匹配或原来的匹配点linki可以另找一个匹配beginlinki:=v; /让 v-i与i匹配find:=true; /exit;end;end;匹配成功并返回find:=false; /end;be

21、gin匹配不成功/read the graph into array g8for i:=1 to n dobeginfillchar(y,sizeof(y),0);if find(i) then inc(ans);end;/now then ans stores the max match end.Km算法program tju1148;constmaxn=20;varw:array1.maxn,1.maxnof byte;m,lx,ly:array1.maxnof byte;vx,vy:array1.maxnof boolean;n,i,j,k,d,ans:word;function fin

22、d(x:byte):boolean;vary:byte;beginfind:=false;vxx:=true;for y:=1 to n doif not vyy and (lxx+lyy=wx,y) then beginvyy:=true;if (my=0) or find(my) then beginmy:=x;find:=true;exit;end;end;end;beginrepeatread(n);if n=0 then halt;fillchar(m,sizeof(m),0);fillchar(lx,sizeof(lx),0);fillchar(ly,sizeof(ly),0);f

23、or i:=1 to n dofor j:=1 to n do beginread(wi,j);9if wi,j>lxi then lxi:=wi,j;end;for k:=1 to n dorepeatfillchar(vx,sizeof(vx),0);fillchar(vy,sizeof(vy),0);if find(k) then break;d:=255;for i:=1 to n doif vxi thenfor j:=1 to n doif not vyj thenif lxi+lyj-wi,j<d thend:=lxi+lyj-wi,j;for i:=1 to n d

24、o beginif vxi then dec(lxi,d);if vyi then inc(lyi,d);end;until false;ans:=0;for i:=1 to n doinc(ans,wmi,i);writeln(ans);until seekeof;end.Sap 算法varg:array0.1001,0.1001 of longint;d,dv:array0.1001 of longint;flow,ans,m,n:longint;procedure init;beginassign(input,'ditch.in');assign(output,'

25、ditch.out');reset(input);rewrite(output);end;10procedure terminate;beginclose(input);close(output);halt;end;function min(a,b:longint):longint;beginif a<b then exit(a)else exit(b); end;procedure readdata;vari,j,x,y,w:longint;beginreadln(m,n);for i:=1 to m dobeginreadln(x,y,w);inc(gx,y,w);end;e

26、nd;function dfs(x,flow:longint):longint;vari,k:longint;beginif x=n then exit(flow);dfs:=0;for i:=1 to n doif (gx,i>0) and (dx=di+1) thenbegink:=dfs(i,min(flow-dfs,gx,i);dec(gx,i,k);inc(gi,x,k);inc(dfs,k);if dfs=flow then exit;end;if d1=n then exit;dec(dvdx);if dvdx=0 then d1:=n;inc(dx);11inc(dvdx

27、);end;procedure main;beginans:=0;dv1:=n;while d1<n dobeginflow:=dfs(1,maxlongint);inc(ans,flow);end;writeln(ans);end;begininit;readdata;main;terminate;end.Rmq问题的 St 算法varf:array0.100001,0.30 of longint;n,m:longint;function min(a,b:longint):longint;beginif a<b then exit(a)else exit(b); end;proc

28、edure readdata; vari,j:longint;beginreadln(n,m);for i:=1 to n doread(fi,0);for j:=1 to 30 dofor i:=1 to (n-(1 shl j)+1) do12fi,j:=min(fi,j-1,fi+(1 shl (j-1),j-1);end;procedure main;vari,k,a,b:longint;beginfor i:=1 to m dobeginreadln(a,b);k:=trunc(ln(b-a+1)/ln(2);write(min(fa,k,fb-(1 shl k)+1,k),'

29、; ');end;end;beginreaddata;main;end.树状数组program t1;varc:array0.300000of longint; n,m:longint;procedure init;beginassign(input,'easy.in'); assign(output,'easy.out'); reset(input);rewrite(output);end;procedure terminate;beginclose(input);close(output);halt;end;function lowbit(i:lon

30、gint):longint;13beginexit(i and -i); end;procedure chaozuo(x:longint);vara:longint;begina:=x;while a>0 dobegininc(ca);a:=a-lowbit(a); end;end;function sum(x:longint):longint;vara,total:longint;begintotal:=0;a:=x;while a<=n dobegintotal:=total+ca;a:=a+lowbit(a); end;sum:=total;end;procedure rea

31、ddata; varb,i,l,r,t:longint;beginreadln(n,m);for i:=1 to m do beginread(t);if t=1 thenbeginreadln(l,r);14chaozuo(r);chaozuo(l-1);endelsebeginreadln(l);b:=sum(l) mod 2;writeln(b);end;end;end;begininit;readdata;terminate;end.最小费用最大流varg,cost:array0.1000000,0.1000000 of longint;best,last:array0.1000000

32、 of longint;m,n:longint;procedure readdata; vari,x,y,w,t:longint; beginfillchar(cost,sizeof(cost),$0f);readln(n,m);for i:=1 to m dobeginreadln(x,y,t,w);costx,y:=w;costy,x:=w;gx,y:=t;end;end;procedure main;vari,j,d,ans:longint;15change:boolean;beginans:=0;repeatfillchar(last,sizeof(last),0);fillchar(

33、best,sizeof(best),$0f);last1:=maxlongint;best1:=0;repeatchange:=false;for i:=1 to n doif besti<1000000 thenfor j:=1 to n doif (gi,j>0) and (besti+costi,j<bestj) thenbeginbestj:=besti+costi,j;lastj:=i;change:=true;end;until not change;if bestn>1000000 then break;i:=n;d:=maxlongint;repeati

34、f glasti,i<d then d:=glasti,i;i:=lasti;until i=1;inc(ans,d*bestn);i:=n;repeatdec(glasti,i,d);inc(gi,lasti,d);i:=lasti;until i=1;until false;writeln(ans);end;beginreaddata;main;readln;readln;end.16Tarjan 算法$m 10000000typenode=point;point=recorddata:longint;next:node;end;vara,b:array0.500001 of nod

35、e;instack,bar,bar2:array0.500001 of boolean;s,n,m,k,stacki,now,colori:longint;dd,color,back,stack,time,best,money,money2:array0.500001 oflongint;procedure init;beginassign(input,'atm.in');assign(output,'atm.out');reset(input);rewrite(output);end;procedure terminate;beginclose(input);close(output);halt;end;procedure insert(x,y:longint);