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]
-------------------------------------------------------------------------
花有重开日，人无再少年