pascal省选模板.doc

算法线段树2平衡二叉树4匈牙利算法8km算法9sap算法10rmq问题的st算法12树状数组20最小费用最大流21tarjan算法22根堆20计算几何28a*算法29矩阵乘法2快速幂2线段树线段树示范程序program intervaltree; const inf=input.txt; ouf=output.txt; maxn=10000; type treenode=record /a,b:区间左右边界，left,right:左右儿子,cover:是否被覆盖 a,b,left,right,cover:longint; end; var tree:array 1.maxn of treenode; number,tot,c,d:longint; /tot:线段树节点总数procedure maketree(a,b:longint); /建树var now:longint; /now必须为局部变量!(dfs中枚举变量一样的道理)begin inc(tot); /节点总数+1 now:=tot; treenow.a:=a; treenow.b:=b; treenow.cover:=0; /把a,b数据写入到treetot; if a+1b then begin treenow.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个节点区间begin if (c=treenum.a) and (treenum.b=d) then /若当前区间被c,d覆盖，则cover+1 treenum.cover:=treenum.cover+1 else begin /否则将区间c,d插到左右子树中 if c(treenum.a+treenum.b) div 2 then insert(treenum.right); end; end; procedure delete(num:longint);/在线段树第num个节点区间中删除线段c,dbegin if (c=treenum.a) and (treenum.b=d) then /若当前区间被c,d覆盖，则cover-1 dec(treenum.cover) else begin /否则将区间c,d在左右子树中删除 if c(treenum.a+treenum.b) div 2 then delete(treenum.right); end; end; procedure count(num:longint); /计算整个线段树的测度(被覆盖区间的总长度)begin if treenum.cover0 then /若当前区间被完全覆盖，则累加到number全局变量中 number:=number+(treenum.b-treenum.a) else begin /否则，若为部分覆盖，则累加左右子树的测度 if treenum.left0 then count(treenum.left); if treenum.right0 then count(treenum.right); end; end; begin assign(input,inf);reset(input); assign(output,ouf);rewrite(output); readln(c,d); /读入总区间大小 maketree(c,d); /建树 while not eof do begin readln(c,d); /向线段树中插入线段c,d insert(1); end; count(1); /计算线段树的测度 writeln(number); close(output); close(input); end.平衡二叉树treap示范代码：标准的代码缩进风格，优美的算法实现。经典标程，完全掌握后水平会提高很多不改变bst的性质(在bst所有子树中均满足：左子树的所有节点=根=右子树的所有节点)通过旋转操作，使根的hr最小(即所有的hr构成堆的关系)$inline onvar /li,ri,vi:i号结点的左儿子、右儿子，关键值 /hri:i号节点的优先值(treap所有子树中,根的hr必须是最小的) /si:i号节点为根的子树节点总数 l,r,hr,s,v:array0.2000000of longint; n,root,m:longint; procedure init;/初始化begin readln(n); m:=0; /randomize; /考试要求程序每次运行结果必须一致,慎用。确实要用：randomize 100; fillchar(s,sizeof(s),0); fillchar(l,sizeof(l),0); fillchar(r,sizeof(r),0); root:=0;end;/旋转是平衡二叉树的精髓，它不会改变bst的性质(左子树=根=右子树)/左旋使树的左子树深度+1,右子树深度-1/右旋使树的右子树深度+1,左子树深度-1procedure l_rotate(var x:longint);inline;/左旋以x为根的子树（注意var参数及意义）var y:longint;begin y:=rx; /保存x的右儿子到y中 rx:=ly; /将y的左儿子作为x的右儿子 ly:=x; /x作为y的左儿子 sy:=sx; /维护旋转后的子树大小 sx:=slx+srx+1; x:=y; /y为根end;procedure r_rotate(var x:longint);inline;/右旋以x为根的子树var y:longint;begin y:=lx; lx:=ry; ry:=x; sy:=sx; sx:=slx+srx+1; x:=y;end;/插入（递归，if key=root,则插入到左子树，否则到右子树，直到尽头再新建节点）procedure insert(var k,key:longint);inline;begin if k=0 then/已到尽头，新建节点并写入key及随机值hr begin inc(m); vm:=key; sm:=1; hrm:=random(maxlongint); k:=m;/修改k,使父节点指向当前节点(修改前从父节点指向0) exit; end; inc(sk); if key=vk then/若keyhrk then /旋转 r_rotate(k); exit; end; if keyvk then begin insert(rk,key); if hrrkhrk then l_rotate(k); exit; end;end;(删除:在k号节点为根的子树中删除key基本方法：由于是静态结构，为了提高效率，并没真正删除若找到则删除，若没找到，则删除查找尽头的节点主程序中需判断返回值，若不等于key,重新插入key即可找到后的处理： 若为叶节点，直接删除，否则，将要删除的节点左子树的最右节点（思考：为什么？）代替它)function delete(var k:longint;key:longint):longint;inline;begin dec(sk);/维护节点总数 /如果找到，或已到尽头 if (key=vk)or(lk=0)and(keyvk) then begin delete:=vk;/返回要删除的节点（不一定=key） if (lk=0)or(rk=0) then /若左右子树只有一个，则让儿子代替根即可 begin k:=lk+rk;/用儿子替换当前要删除的节点 exit; end; vk:=delete(lk,key+1);/k左右子树都有，则用左子树的最右节点替换k exit; end; if key=vk then/若kvk then exit(delete(rk,key);end;function find(var k,key:longint):boolean;inline;/查找begin if k=0 then/递归边界 exit(false); if keyvk then find:=find(rk,key) else find:=(vk=key)or find(lk,key);end;/key的排名(key排在第几，按从小到大的顺序)function rank(var t,key:longint):longint;inline;begin if t=0 then exit(1); if key=vt then rank:=rank(lt,key) else rank:=slt+1+rank(rt,key);end;function select(var t:longint;k:longint):longint;inline;/选择排在第k位的数begin if 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的前趋begin if t=0 then exit(key); if key=vt then/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的后继begin if t=0 then exit(key); if vtlxi then lxi:=wi,j; end; for k:=1 to n do repeat fillchar(vx,sizeof(vx),0); fillchar(vy,sizeof(vy),0); if find(k) then break; d:=255; for i:=1 to n do if vxi then for j:=1 to n do if not vyj then if lxi+lyj-wi,jd then d:=lxi+lyj-wi,j; for i:=1 to n do begin if vxi then dec(lxi,d); if vyi then inc(lyi,d); end; until false; ans:=0; for i:=1 to n do inc(ans,wmi,i); writeln(ans); until seekeof;end.sap算法var g:array0.1001,0.1001 of longint; d,dv:array0.1001 of longint; flow,ans,m,n:longint;procedure init;begin assign(input,ditch.in); assign(output,ditch.out); reset(input); rewrite(output);end;procedure terminate;begin close(input); close(output); halt;end;function min(a,b:longint):longint;begin if a0) and (dx=di+1) then begin k:=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); inc(dvdx);end;procedure main;begin ans:=0; dv1:=n; while d1n do begin flow:=dfs(1,maxlongint); inc(ans,flow); end; writeln(ans);end;begin init; readdata; main; terminate;end.rmq问题的st算法var f:array0.100001,0.30 of longint; n,m:longint;function min(a,b:longint):longint;begin if a0 dobegin inc(ca); a:=a-lowbit(a);end;end;function sum(x:longint):longint;var a,total:longint;begintotal:=0;a:=x;while a=n dobegin total:=total+ca; a:=a+lowbit(a);end;sum:=total;end;procedure readdata;var b,i,l,r,t:longint;beginreadln(n,m);for i:=1 to m dobegin read(t); if t=1 then begin readln(l,r); chaozuo(r); chaozuo(l-1); end else begin readln(l); b:=sum(l) mod 2; writeln(b); end;end;end;begininit;readdata;terminate;end.最小费用最大流var g,cost:array0.1000000,0.1000000 of longint; best,last:array0.1000000 of longint; m,n:longint; procedure readdata;var i,x,y,w,t:longint;begin fillchar(cost,sizeof(cost),$0f); readln(n,m); for i:=1 to m do begin readln(x,y,t,w); costx,y:=w; costy,x:=w; gx,y:=t; end;end;procedure main;var i,j,d,ans:longint; change:boolean;begin ans:=0; repeat fillchar(last,sizeof(last),0); fillchar(best,sizeof(best),$0f); last1:=maxlongint; best1:=0; repeat change:=false; for i:=1 to n do if besti0) and (besti+costi,j1000000 then break; i:=n; d:=maxlongint; repeat if glasti,id then d:=glasti,i; i:=lasti; until i=1; inc(ans,d*bestn); i:=n; repeat dec(glasti,i,d); inc(gi,lasti,d); i:=lasti; until i=1; until false; writeln(ans);end;begin readdata; main; readln; readln;end.tarjan算法$m 10000000type node=point; point=record data:longint; next:node; end;var a,b:array0.500001 of node; 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 of longint;procedure init;begin assign(input,atm.in); assign(output,atm.out); reset(input); rewrite(output);end;procedure terminate;begin close(input); close(output); halt;end;procedure insert(x,y:longint); inline;var p:node;begin new(p); p.data:=y; p.next:=ax; ax:=p;end;procedure readdata;var i,x,y:longint;begin readln(n,m); for i:=1 to m do begin readln(x,y); insert(x,y); end; for i:=1 to n do readln(moneyi); readln(s,k); for i:=1 to k do begin read(x); barx:=true; end;end;function min(a,b:longint):longint; inline;begin if ab then exit(a) else exit(b);end;procedure tarjan(x:longint); inline;var p:node;begin inc(now); timex:=now; backx:=now; inc(stacki); stackstacki:=x; instackx:=true; p:=ax; while pnil do begin if timep.data=0 then begin tarjan(p.data); backx:=min(backx,backp.data); end else if instackp.data then begin backx:=min(backx,backp.data); end; p:=p.next; end; if timex=backx then begin inc(colori); while (stackstackix) and (stacki0) do begin colorstackstacki:=colori; instackstackstacki:=false; dec(stacki); end; colorstackstacki:=colori; instackstackstacki:=false; dec(stacki); end;end;procedure spfa(x:longint); inline;var p:node; h,t:longint;begin dd1:=x; instackx:=true; bestx:=money2x; h:=0; t:=1; while ht do begin h:=(h+1) mod 100000; p:=bddh; instackddh:=false; while pnil do begin if bestp.databestddh+money2p.data then begin bestp.data:=bestddh+money2p.data; if not instackp.data then begin t:=(t+1) mod 100000; ddt:=p.data; instackddt:=true; end; end; p:=p.next; end; end;end;procedure main;var i,ans:longint; p,p2:node;begin now:=0; stacki:=0; colori:=0; for i:=1 to n do if timei=0 then tarjan(i); for i:=1 to n do begin inc(money2colori,moneyi); if bari then bar2colori:=true; p:=ai; while pnil do begin if coloricolorp.data then begin new(p2); p2.data:=colorp.data; p2.next:=bcolori; bcolori:=p2; end; p:=p.next; end; end; fillchar(instack,sizeof(instack),0); fillchar(best,sizeof(best),0); spfa(colors); ans:=0; for i:=1 to colori do if (bestians) and bar2i and (besti100000000) then ans:=besti; writeln(ans);end;begin init; readdata; main; terminate;end.根堆最大堆和最小堆是二叉堆的两种形式。 最大堆：根结点的键值是所有堆结点键值中最大者。 最小堆：根结点的键值是所有堆结点键值中最小者。 而最大-最小堆集结了最大堆和最小堆的优点，这也是其名字的由来。 最大-最小堆是最大层和最小层交替出现的二叉树，即最大层结点的儿子属于最小层，最小层结点的