刷数据结构记录

sbt:

1503: [NOI2004]郁闷的出纳员

  [toggle Title="code "] [pascal] var l,r,a,size:Array[1..100000]of longint; le:Array[1..100000]of boolean; ans:int64; root,nn,n,m,i,k,j:longint; c,space:char; procedure lr(var x:longint); var k:longint; begin k:=r[x]; r[x]:=l[k] ; l[k]:=x; size[k]:=size[x]; size[x]:=size[l[x]]+size[r[x]]+1; x:=k; end; procedure rr(var x:longint); var k:longint; begin k:=l[x];l[x]:=r[k];r[k]:=x; size[k]:=size[x]; size[x]:=size[l[x]]+size[r[x]]+1; x:=k; end; procedure maint(var x:longint; f:boolean); begin if f then if size[r[r[x]]]>size[l[x]] then lr(x) else if size[l[r[x]]]>size[l[x]] then begin rr(r[x]); lr(x); end else exit else if size[l[l[x]]]>size[r[x]] then rr(x) else if size[r[l[x]]]>size[r[x]] then begin lr(l[x]); rr(x); end else exit; maint(l[x],false); maint(r[x],true); maint(x,true);maint(x,false); end; function new(x:longint):longint; begin inc(nn);  size[nn]:=1; a[nn]:=x;  exit(nn) ; end; procedure insert(var t,x:longint); var k:longint; begin if t=0 then begin t:=new(x); exit; end; inc(size[t]); if x<a[t] then insert(l[t],x) else insert(r[t],x); if x<>a[t] then maint(t,x>a[t]); end; function delete(var t:longint;x:longint):longint; var rr,k:longint; begin dec(size[t]); if (x=a[t])or((x<a[t])and(l[t]=0))or((x>a[t])and(r[t]=0)) then begin rr:=a[t]; if (l[t]=0)or(r[t]=0) then t:=l[t]+r[t] else a[t]:=delete(l[t],a[t]+1); exit(rr); end else if a[t]>x then  exit(delete(l[t],x)) else exit(delete(r[t],x)); end; function select(t,x:longint):longint; var i:longint; begin if x>size[t] then exit(0); i:=t; while true do begin if size[l[i]]+1=x then exit(i); if size[l[i]]+1>x then i:=l[i] else begin x:=x-size[l[i]]-1; i:=r[i]; end; end; end; begin readln(n,m); for i:=1 to n do begin readln(c,space,k); if c='I' then begin if k<m then else insert(root,k); end; if c='F' then if nn-ans<k then writeln(-1) else writeln(a[select(root,(nn-ans)-k+1)]); if c='A' then for j:=1 to nn do a[j]:=a[j]+k; if c='S' then begin for j:=1 to nn do a[j]:=a[j]-k; for j:=1 to nn do if (a[j]<m)and(le[j]=false) then begin inc(ans);delete(root,a[j]); le[j]:=true; end; end; end; writeln(ans); end. [/pascal] [/toggle]

1691: [Usaco2007 Dec]挑剔的美食家

[toggle Title="code "] [pascal] var nnn,root,xx,nn,n,m,i,j:longint;ans:int64; l,r,size,a,an,bn,am,bm:array[1..100000]of longint; function new(x:longint):longint; begin inc(nn); size[nn]:=1;a[nn]:=x; exit(nn); end; procedure insert(var t,x:longint); begin if t=0 then begin t:=new(x); exit; end; inc(size[t]); if x<a[t] then insert(l[t],x) else insert(r[t],x); end; function search(t,x:longint):longint; begin search:=0; while t<>0 do begin if (a[t]<=x)and(a[t]>search) then search:=a[t]; if x<a[t] then t:=l[t] else t:=r[t]; end; end; function delete(var t:longint; x:longint):longint; var rr,k:longint; begin dec(size[t]); if (x=a[t])or((x<a[t])and(l[t]=0))or((x>a[t])and(r[t]=0)) then begin rr:=a[t]; if (l[t]=0)or(r[t]=0) then t:=l[t]+r[t] else a[t]:=delete(l[t],a[t]+1); exit(rr); end else if a[t]>x then exit(delete(l[t],x)) else exit(delete(r[t],x)); end; procedure sort1(l,r: longint); var i,j,xx,yy: longint; begin i:=l; j:=r; xx:=an[(l+r) div 2]; repeat while an[i]<xx do inc(i); while xx<an[j] do dec(j); if not(i>j) then begin yy:=an[i]; an[i]:=an[j]; an[j]:=yy; yy:=bn[i]; bn[i]:=bn[j]; bn[j]:=yy; inc(i); j:=j-1; end; until i>j; if l<j then sort1(l,j); if i<r then sort1(i,r); end; procedure sort2(l,r: longint); var i,j,xx,yy: longint; begin i:=l; j:=r; xx:=am[(l+r) div 2]; repeat while am[i]<xx do inc(i); while xx<am[j] do dec(j); if not(i>j) then begin yy:=am[i]; am[i]:=am[j]; am[j]:=yy; yy:=bm[i]; bm[i]:=bm[j]; bm[j]:=yy; inc(i); j:=j-1; end; until i>j; if l<j then sort2(l,j); if i<r then sort2(i,r); end; begin {for i:=1 to n do begin readln(xx); insert(root,xx); end; for i:=1 to m do begin readln(xx); writeln(search(root,xx)); end;  } readln(n,m); for i:=1 to n do readln(an[i],bn[i]); for i:=1 to m do readln(am[i],bm[i]); sort1(1,n);sort2(1,m); j:=1; for i:=1 to m do begin if nnn>n then break; while (an[j]<=am[i])and(j<=n) do begin insert(root,bn[j]); inc(j); end; xx:=search(root,bm[i]); if xx<>0 then begin inc(nnn); ans:=ans+am[i]; delete(root,xx); end; end; writeln(ans); end. [/pascal] [/toggle]

1208: [HNOI2004]宠物收养所

[toggle Title="code "] [pascal] var l,r,a,size:Array[1..100000]of longint; pr,su,ans:int64; num,root,nn,n,m,i,k,j,x:longint; function abs(aa:int64):int64; begin if aa>=0 then exit(aa) else exit(-aa); end; procedure lr(var x:longint); var k:longint; begin k:=r[x]; r[x]:=l[k] ; l[k]:=x; size[k]:=size[x]; size[x]:=size[l[x]]+size[r[x]]+1; x:=k; end; procedure rr(var x:longint); var k:longint; begin k:=l[x];l[x]:=r[k];r[k]:=x; size[k]:=size[x]; size[x]:=size[l[x]]+size[r[x]]+1; x:=k; end; procedure maint(var x:longint; f:boolean); begin if f then if size[r[r[x]]]>size[l[x]] then lr(x) else if size[l[r[x]]]>size[l[x]] then begin rr(r[x]); lr(x); end else exit else if size[l[l[x]]]>size[r[x]] then rr(x) else if size[r[l[x]]]>size[r[x]] then begin lr(l[x]); rr(x); end else exit; maint(l[x],false); maint(r[x],true); maint(x,true);maint(x,false); end; function new(x:longint):longint; begin inc(nn); size[nn]:=1;a[nn]:=x; exit(nn); end; procedure insert(var t,x:longint); begin if t=0 then begin t:=new(x); exit; end; inc(size[t]); if a[t]>x then insert(l[t],x) else insert(r[t],x); if x<>a[t] then maint(t,x>a[t]); end; function succ(t,x:longint):longint; begin succ:=maxlongint; while t<>0 do begin if (a[t]<=succ)and(a[t]>=x) then succ:=a[t]; if x<a[t] then t:=l[t] else t:=r[t]; end; end; function prep(t,x:longint):longint; begin prep:=-maxlongint; while t<>0 do begin if (a[t]>=prep)and(a[t]<=x) then prep:=a[t]; if x<a[t] then t:=l[t] else t:=r[t]; end; end; function delete(var t:longint; x:longint):longint; var rr,k:longint; begin dec(size[t]); if (x=a[t])or((x<a[t])and(l[t]=0))or((x>a[t])and(r[t]=0)) then begin rr:=a[t]; if (l[t]=0)or(r[t]=0) then t:=l[t]+r[t] else a[t]:=delete(l[t],a[t]+1); exit(rr); end else if a[t]>x then exit(delete(l[t],x)) else exit(delete(r[t],x)); end; begin read(n); for i:=1 to n do begin // writeln(num); readln(k,x); if num=0 then insert(root,x); if (num>0) then if k=0 then insert(root,x) else begin su:=succ(root,x); pr:=prep(root,x); if abs(su-x)>=abs(x-pr) then begin ans:=(ans+abs(pr-x))mod 1000000; delete(root,pr); end else begin ans:=(ans+abs(su-x))mod 1000000; delete(root,su); end; end; if (num<0) then if k=1 then insert(root,x) else begin su:=succ(root,x); pr:=prep(root,x); if abs(su-x)<=abs(x-pr) then begin ans:=(ans+abs(x-su))mod 1000000; delete(root,su); end else begin ans:=(ans+abs(pr-x))mod 1000000; delete(root,pr); end; end; if k=0 then inc(num) else dec(num); end; writeln(ans mod 1000000); end. [/pascal] [/toggle]