基础代码汇总整理forNOIP2009.doc

基础代码汇总整理 for NOIP 2009WQ YCOI基础代码汇总整理 for NOIP 2009十进制转换K进制function dectok(x,k:longint):string;const alph=0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ;var st:string;begin st:=; while x0 do begin st:=alphx mod k+1+st; x:=x div k;end; exit(st);end;K进制转换十进制function ktodec(st:string; k:longint):longint;const alph=012456789ABCDEFGHIJKLMNOPQRSTUVWXYZ;var i,j,ans:longint;begin ans:=0; j:=1; for i:=length(st) downto 1 do begin inc(ans,j*(pos(sti,alph)-1); j:=j*k;end; exit(ans);end;欧几里得算法function gcd(a,b:longint):longint;begin if b=0 then exit(a) else exit(gcd(b,a mod b);end;求最小公倍数function lcm(a,b:longint):longint;begin exit(a div gcd(a,b) *b);end;判断质数function judgeprime(x:longint);var i:longint;begin if x=1 then exit(false); for i:=2 to trunc(sqrt(x) do if x mod i=0 then exit(false); exit(true);end;生成质数表procedure makeprime;var i,j:longint;begin fillchar(f,sizeof(f),0); f1:=true; for i:=2 to n do if (not fi) and (i10000) then begin j:=i*i;while j=4 do begin inc(x0); val(copy(st,length(st)-3,4),xx0); delete(st,length(st)-3,4); end; inc(x0); val(st,xx0);end;function compare(a,b:array of longint):boolean;var i:longint;begin if a0b0 then exit(true); if a0bi then exit(true) else if aib0 then c0:=a0 else c0:=b0; for i:=1 to c0 do inc(ci,ai+bi); for i:=1 to c0 do if ci=10000 then begin dec(ci,10000); inc(ci+1); end; while cc0+10 do inc(c0);end;procedure highminus(a,b:array of longint; var c:array of longint);var i:longint;begin fillchar(c,sizeof(c),0); c0:=a0; for i:=1 to c0 do inc(ci,ai-bi); for i:=1 to c0 do if ci0 then begin inc(ci,10000); dec(ci+1); end; while (c01)and(cc0=0) do dec(c0);end;procedure highmulti(a,b:array of longint; var c:array of longint);var i,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 if ci10000 then begin inc(ci+1,ci div 10000); ci:=ci mod 10000; end; while cc0+10 do inc(c0);end;procedure highout(x:array of longint);var i:longint;begin write(xx0); for i:=x0-1 downto 1 do begin if xi1000 then write(0); if xi100 then write(0); if xi10 then write(0); write(xi); end; writeln;end;表达式求值const num=0123456789; sym=+-*/(); com:array1.7,1.7 of longint=(1,1,-1,-1,-1,1,1), (1,1,-1,-1,-1,1,1), (1,1,1,1,-1,1,1), (1,1,1,1,-1,1,1), (-1,-1,-1,-1,-1,0,2), (1,1,1,1,2,1,1), (-1,-1,-1,-1,-1,2,0);function calc(suf:string):double;var stack:array1.100 of double; i,top:longint; x:double; ch:char;begin i:=1; ch:=suf1; top:=0; while ch do begin case ch of +: begin x:=stacktop-1+stacktop; dec(top,2); end; -: begin x:=stacktop-1-stacktop; dec(top,2); end; *: begin x:=stacktop-1*stacktop; dec(top,2); end; /: begin x:=stacktop-1/stacktop; dec(top,2); end; 0.9: begin x:=0; while ch do begin x:=x*10+pos(ch,num)-1; inc(i); ch:=sufi; end; end end; inc(top); stacktop:=x; inc(i); ch:=sufi; end; exit(stacktop);end;procedure turn(var mid,suf:string);var stack:array1.100 of longint; i,top,w:longint; ch:char;begin mid:=mid+ ; suf:=; stack1:=7; i:=1; top:=1; ch:=mid1; while ch do begin if pos(ch,num)0 then begin while pos(ch,num)0 do begin suf:=suf+ch; inc(i); ch:=midi; end; suf:=suf+ ; end; if pos(ch,sym)0then begin w:=stacktop; while comw,pos(ch,sym)=1 do begin suf:=suf+symw; dec(top); w:=stacktop; end; if comw,pos(ch,sym)=-1 then begin inc(top); stacktop:=pos(ch,sym); end else dec(top); end; inc(i); ch:=midi; end; w:=stacktop; while w7 do begin suf:=suf+symw; dec(top); w:=stacktop; end; suf:=suf+;end;格拉汉扫除法function direction(a,b,c:situ):real;begin exit(a.x-c.x)*(b.y-c.y)-(a.y-c.y)*(b.y-c.y);end;function dist(a,b:situ):real;begin exit(sqrt(sqr(a.x-b.x)+sqr(a.y-b.y);end;procedure polarangle(s,t:longint);var l,r:longint; key,tmp:situ;begin l:=s; r:=t; key:=prandom(t-s+1)+s; while l0)or (direction(pl,key,p1)=0)and(dist(pl,p1)dist(key,p1) do inc(l); while (direction(pr,key,p1)dist(key,p1) do dec(r); if l=r then begin tmp:=pl; pl:=pr; pr:=tmp; inc(l); dec(r); end;end; if sr then qsort(s,r); if lt then qsort(l,t);end;procedure getvex;var i:longint; tmp:situ;begin for i:=2 to n do if (pi.yp1.y)or(pi.y=p1.y)and(pi.x1)and(direction(pi,pstackstack0,pstackstack0-1)=0) dodec(stack0); inc(stack0); stackstack0:=i;end; ans:=dist(pstackstack0,pstack1); for i:=1 to stack0-1 do ans:=ans+dist(pstacki,pstacki+1);end;判断线段相交function segment(a,b,c:situ):boolean;begin if (min(a.x,b.x)=c.x)and (min(a.y,b.y)=c.y) then exit(true); exit(false);end;function intersect(a,b,c,d:situ):boolean;var da,db,dc,dd:real;begin da:=direction(c,d,a); db:=direction(c,d,b); db:=direction(a,b,c); dd:=direction(a,b,d); if (da*db-(1e-16) and (dc*dd-(1e-16) then exit(true); if (abs(da)1e-16) and segment(c,d,a) then exit(true); if (abs(db)1e-16) and segment(c,d,b) then exit(true); if (abs(dc)1e-16) and segment(a,b,c) then exit(true); if (abs(dd)1e-16) and segment(a,b,d) then exit(true); exit(false);end;弗洛伊德算法procedure floyd;var i,j,k:longint;begin for i:=1 to n do for j:=1 to n do if gi,j0 then disti,j:=gi,j else disti,j:=maxlongint; for k:=1 to n do for i:=1 to n do for j:=1 to n do if (disti,kmaxlongint)and(distk,jmaxlongint)and (disti,k+distk,jdisti,j) then disti,j:=disti,k+distk,j;end;SPFA算法procedure spfa(s:longint);var vis:array1.100 of boolean; que:array0.99 of longint;i,u,open,clo:longint;begin fillchar(vis,sizeof(vis),0); for i:=1 to n do disti:=maxlongint; open:=0; clo:=1; dists:=0; viss:=true; que1:=s; while openclo do begin open:=(open+1) mod n; u:=queopen; visu:=false; for i:=1 to n do if (gu,i0) and (distu+gu,idisti) then begin if not visi then begin clo:=(clo+1) mod n; queclo:=u; visclo:=true; end;disti:=distu+gu,i; end;end;end;克鲁斯卡尔算法procedure kruskal;var father:array1.100 of longint;i,get:longint;function find(i:longint):longint;begin if fatheri=i then exit(i) else fatheri:=find(fatheri); exit(fatheri);end;procedure union(i,j:longint);var u,v:longint;begin v:=find(i); u:=find(j); fatherv:=u;end;begin qsort(1,e); get:=0; for i:=1 to n do fatheri:=i; for i:=1 to e do if find(edgei.u)find(edgei.v) then begin union(edgei.u,edgei.v);inc(ans,edgei.data);inc(get);if get=n-1 then exit; end;end;Kosaraju算法procedure kosaraju;var vis:array1.100 of boolean; order:array1.100 of longint;i,time:longint;procedure forthdfs(u:longint);var i:longint;begin visu:=true; for i:=1 to n do if gu,i and (not visi) then forthdfs(i); inc(time); ordertime:=u;end;procedure backdfs(u:longint);var i:longint;begin visu:=true; for i:=1 to n do if gi,u and (not visi) then backdfs(i); fillu:=color;end;begin fillchar(vis,sizeof(vis),0); time:=0; for i:=1 to n do if not visi then forthdfs(i); fillchar(vis,sizeof(vis),0); color:=0; for i:=time downto 1 do if not visorderi then begin inc(color); backdfs(orderi); end;end;最短增广路算法procedure sap(s,t:longint);var dist,dsum,nowvex,pre,data:array0.100 of longint; i,j,delta,mintmp,minvex:longint;flag:boolean;begin fillchar(dist,sizeof(dist),0); for i:=1 to n do nowvexi:=1; dsum0:=n; delta:=maxlongint; i:=s; while dists0) and (distj+1=disti) then begin flag:=true; nowvexi:=j;prej:=i;if deltaci,j then delta:=ci,j;i:=j; if i=t then begin inc(maxflow,delta); while is do begin dec(cprei,i,delta);inc(ci,prei,delta);i:=prei; end;i:=s; delta:=maxlongint; end; break; end;if flag then continue;dec(dsumdisti);if dsumdisti=0 then exit;mintmp:=n-1; for j:=1 to n do if (ci,j0) and (distjmintmp) then begin mintmp:=distj; minvex:=j;end; disti:=mintmp+1;nowvexi:=minvex;inc(dsumdisti);if is then i:=prei;delta:=datai;end;end;匈牙利算法function hungary(s:longint):boolean;var i:longint;begin for i:=1 to m do if gs,i and (not visi) then begin visi:=true; if linki=0 then begin linki:=s;exit(true); endelse if hungary(linki) then begin linki:=s;exit(true); end; end; exit(false);end;KM算法function find(k:longint):longint;var i:longint;begin xk:=true; for i:=1 to n do if (not yi) and (lxk+lyi=gk,i) then begin yi:=true;if linki=0 then begin linki:=k; exit(true); endelse if find(linki) then begin linki:=k;exit(true); end; end; exit(false); end;procedure km;var i,j,k,d:longint;begin fillchar(lx,sizeof(lx),0); fillchar(ly,sizeof(ly),0); for i:=1 to n do for j:=1 to n do if gi,jlxi then lxi:=gi,j; for k:=1 to n do repeat fillchar(x,sizeof(x),0); fillchar(y,sizeof(y),0); if find(k) then break; d:=maxlongint; for i:=1 to n do if xi then for j:=1 to n do if not yj then if lxi+lyj-gi,jd then d:=lxi+lyj-gi,j; for i:=1 to n do begin if xi then dec(lxi,d); if yi then inc(lyi,d);end;until false;end;树状数组procedure plus(x,delta:longint);var k:longint;begin k:=x; while k0 do begin inc(ans,ck); dec(k,k and (-k); end; exit(ans);end;堆的操作procedure sink(i,n:longint);var i,key:longint;begin key:=ai; while i*2=n do begin j:=i*2; if (j+1=n)and(aj+1aj) then inc(j); if ajkey then begin ai:=aj; i:=j; end else break;end; ai:=key;end;procedure float(i:longint);var key:longint;begin key:=ai; while (i1) and (aiai shr 1) do beginai:=ai shr 1;i:=i shr 1; end; ai:=key;end;procedure insert(key:longint; var n:longint);begin inc(n); an:=key; float(n);end;procedure delete(i:longint; var n:longint);begin ai:=an; dec(n); sink(i,n);end;procedure heapsort(n:longint);var i,tmp:longint;begin for i:=n shr 1 downto 1 do sink(i,n); for i:=n downto 2 do begin tmp:=a1; a1:=ai; ai:=tmp; sink(1,i-1);end;end;RMQ线段树procedure build(i,left,right:longint);var mid:longint;begin ai.l:=left; ai.r:=right; ai.mark:=0; if left=right then ai.key:=dataleft else begin mid:=(left+right) shr 1; build(i shl 1,left,mid); build(i shl 1+1,mid+1,right); ai.key:=max(ai shl 1.key,ai shl 1+1.key); end;end;procedure pass(i:longint);begin if ai.lai.r then begin inc(ai shl 1.key,ai.mark); inc(ai shl 1.mark,ai.mark); inc(ai shl 1+1.key,ai.mark); inc(ai shl 1+1.mark,ai.mark); end; ai.mark:=0;end;procedure add(i,st,en,va:longint);var mid:longint;begin if (st=ai.l) and (en=ai.r) then begin inc(ai.key,va); inc(ai.mark,va); end else begin pass(i); mid:=(ai.l+ai.r) shr 1; if mid=en then add(i shl 1,st,en,va) else if mid+1=en then exit(query(i shl 1,st,en) else if mid+1k then exit(rank(ahead.l,k,sum) else if sum+aahead.l.size+1=k then exit(ahead.key) else exit(rank(ahead.r,k,sum+aahead.l.size+1);end;procedure insert(var head,aim:longint);begin if head=0 then begin inc(tot); head:=tot; atot.l:=0; atot.r:=0; atot.key:=aim; atot.num:=random(maxlongint); atot.size:=1; end else begin inc(ahead.size); if aimahead.num then rightrotate(head); end else begin insert(ahead.r,aim); if aahead.r.numahead.num then leftrotate(head); end; end;end;function delete(head,aim:longint):longint;begin dec(ahead.size); if aimahead.key then ahead.r:=delete(ahead.r,aim) else begin if ahead.size=0 then exit(0); if aahead.l.numaahead.r.num then begin rightrotate(head); ahead.r:=delete(ahead.r,aim); end else begin leftrotate(head); ahead.l:=delete(ahead.l,aim); end; end; exit(head);end;随机化快速排序procedure qsort(s,t:longint);var l,r,key:longint;beginl:=s; r:=t; key:=arandom(t-s+1)+s;while l=r do beginwhile alk