bzoj 1861 splay
就是裸地splay，然后自己写的不是特别好，tle了，最近时间比较紧迫，有时间了改下，在此记录
另附转载pascal AC代码最下面
/************************************************************** Problem: 1861 User: BLADEVIL Language: Pascal Result: Time_Limit_Exceed ****************************************************************/ //By BLADEVIL const sroot =-1; var num, adress :array[-1..100100] of longint; son :array[-1..100100,0..1] of longint; father, size, tree :array[-1..100100] of longint; root :longint; n, m :longint; procedure init; var i :longint; begin read(n,m); for i:=1 to n do begin read(num[i]); adress[num[i]]:=i; end; readln; end; procedure update(x:longint); begin size[x]:=size[son[x,0]]+size[son[x,1]]+1; end; function find(x:longint):longint; var t :longint; begin t:=root; while true do begin if size[son[t,0]]+1=x then exit(t); if size[son[t,0]]+1>x then t:=son[t,0] else begin dec(x,size[son[t,0]]+1); t:=son[t,1]; end; end; end; procedure rotate(x,y:longint); var f :longint; begin f:=father[x]; father[son[x,y xor 1]]:=f; son[f,y]:=son[x,y xor 1]; if f=root then root:=x else if f=son[father[f],0] then son[father[f],0]:=x else son[father[f],1]:=x; father[x]:=father[f]; father[f]:=x; son[x,y xor 1]:=f; update(f); update(x); end; procedure splay(x,y:longint); var u, v :longint; begin while father[x]<>y do if father[father[x]]=y then rotate(x,ord(x=son[father[x],1])) else begin if x=son[father[x],0] then u:=1 else u:=-1; if father[x]=son[father[father[x]],0] then v:=1 else v:=-1; if u*v=1 then begin rotate(father[x],ord(x=son[father[x],1])); rotate(x,ord(x=son[father[x],1])); end else begin rotate(x,ord(x=son[father[x],1])); rotate(x,ord(x=son[father[x],1])); end; end; update(x); end; function build(l,r:longint):longint; var mid :longint; begin mid:=(l+r) div 2; build:=mid; tree[mid]:=num[mid]; if l<=mid-1 then begin son[mid,0]:=build(l,mid-1); father[son[mid,0]]:=mid; end; if r>=mid+1 then begin son[mid,1]:=build(mid+1,r); father[son[mid,1]]:=mid; end; update(mid); end; procedure top; var x :longint; q, p :longint; begin readln(x); x:=adress[x]; splay(x,sroot); q:=size[son[root,0]]; p:=find(q); splay(p,sroot); p:=find(q+2); splay(p,root); p:=son[son[root,1],0]; son[son[root,1],0]:=-1; update(son[root,1]); update(root); father[p]:=-1; q:=find(2); splay(q,sroot); q:=find(1); splay(q,root); son[son[root,0],1]:=p; father[p]:=son[root,0]; update(son[root,0]); update(root); end; procedure bottom; var x :longint; q, p :longint; begin readln(x); x:=adress[x]; splay(x,sroot); q:=size[son[x,0]]; p:=find(q); splay(p,sroot); p:=find(q+2); splay(p,root); q:=son[son[root,1],0]; son[son[root,1],0]:=-1; father[q]:=-1; update(son[root,1]); update(root); p:=find(n-1); splay(p,sroot); p:=find(n); splay(p,root); son[son[root,1],0]:=q; father[q]:=son[root,1]; update(son[root,1]); update(root); end; procedure insert; var x, y :longint; q, p :longint; begin readln(x,y); x:=adress[x]; if y=-1 then begin splay(x,sroot); p:=size[son[root,0]]; q:=find(p); splay(q,sroot); q:=find(p+2); splay(q,root); x:=son[son[root,1],0]; son[son[root,1],0]:=-1; q:=find(p-1); splay(q,sroot); q:=find(p); splay(q,root); son[son[root,1],0]:=x; father[x]:=son[son[root,1],0]; end else begin splay(x,sroot); p:=size[son[root,0]]; q:=find(p); splay(q,sroot); q:=find(p+2); splay(q,root); x:=son[son[root,1],0]; son[son[root,1],0]:=-1; q:=find(p); splay(q,sroot); q:=find(p+2); splay(q,root); son[son[root,1],0]:=x; father[x]:=son[son[root,1],0]; end; end; procedure ask; var x :longint; begin readln(x); x:=adress[x]; splay(x,sroot); writeln(size[son[root,0]]-1); end; procedure query; var x :longint; p :longint; begin readln(x); p:=find(x+1); splay(p,sroot); writeln(tree[root]); end; procedure main; var i :longint; ch :char; s :ansistring; begin fillchar(son,sizeof(son),255); inc(n); root:=build(0,n); father[root]:=sroot; for i:=1 to m do begin s:=''; read(ch); while ch<>' ' do begin s:=s+ch; read(ch); end; if s='Top' then top; if s='Bottom' then bottom; if s='Insert' then insert; if s='Ask' then ask; if s='Query' then query; end; end; begin init; main; end.
/************************************************************** Problem: 1861 User: BLADEVIL Language: Pascal Result: Accepted Time:2132 ms Memory:2140 kb ****************************************************************/ {$inline on} program zjoi_2006_day2_book; var fa,pi,po,son:array[0..80000] of longint; c:array[0..80000,0..1] of longint; root,n,m:longint; //===================================================================== procedure rotate(var root:longint; x:longint); inline; var y,z,p,q:longint; begin y:=fa[x]; z:=fa[y]; if c[y,0]=x then p:=0 else p:=1; q:=p xor 1; if y=root then root:=x else if c[z,0]=y then c[z,0]:=x else c[z,1]:=x; if c[x,q]>0 then fa[c[x,q]]:=y; fa[x]:=z; fa[y]:=x; c[y,p]:=c[x,q]; c[x,q]:=y; son[y]:=son[c[y,0]]+son[c[y,1]]+1; son[x]:=son[y]+son[c[x,p]]+1; //一开始这里没加1 end; //===================================================================== procedure splay(var root:longint; x:longint); inline; var y,z:longint; begin while x<>root do begin y:=fa[x]; z:=fa[y]; if y<>root then if (c[y,0]=x) xor (c[z,0]=y) then rotate(root,x) else rotate(root,y); rotate(root,x); end; end; //经过多次实践，表示敲出splay和rotate的代码可以选择跳过调试了、、如果没有更新附加域的话。。 //===================================================================== procedure init; var i,x:longint; begin readln(n,m); for i:=1 to n do begin read(x); pi[x]:=i; po[i]:=x; son[i]:=n-i+1; end; readln; //这里没有readln的错误还是第一次碰到。。。 for i:=1 to n-1 do c[i,1]:=i+1; for i:=1 to n do fa[i]:=i-1; root:=1; splay(root,n); end; //===================================================================== function delete(x:longint):longint; inline; var left,right:longint; begin splay(root,x); left:=c[root,0]; right:=c[root,1]; while c[left,1]>0 do left:=c[left,1]; while c[right,0]>0 do right:=c[right,0]; if left>0 then splay(root,left); if right>0 then if left>0 then splay(c[root,1],right) else splay(root,right); if right=0 then begin delete:=n; c[left,1]:=0; if left>0 then dec(son[left]); end else begin if left>0 then delete:=son[left]-son[right]+1 else delete:=1; c[right,0]:=0; dec(son[right]); if left>0 then dec(son[left]); end; fa[x]:=0; son[x]:=1; end; //===================================================================== function find(x:longint):longint; inline; var i:longint; begin i:=root; while i<>0 do begin if son[c[i,0]]+1=x then exit(i); if son[c[i,0]]>=x then i:=c[i,0] else begin dec(x,son[c[i,0]]+1); i:=c[i,1]; end; end; exit(i); end; //===================================================================== procedure ins(x,y:longint); inline; var left,right:longint; begin left:=find(y-1); right:=find(y); if left>0 then splay(root,left); if right>0 then if left>0 then splay(c[root,1],right) else splay(root,right); if right=0 then begin fa[x]:=left; c[left,1]:=x; inc(son[left]); end else begin inc(son[right]); fa[x]:=right; c[right,0]:=x; if left>0 then inc(son[left]); end; end; //===================================================================== procedure main; var ch,ch1:char; i,s,t,pos:longint; begin for i:=1 to m do begin repeat ch1:=ch; read(ch); until ch=' '; ch:=ch1; //如果init里面没有readln这里就会直接跳掉。读不到指令。然后就215了。。。 if ch='p' then begin readln(s); pos:=delete(pi[s]); ins(pi[s],1); end else if ch='m' then begin readln(s); pos:=delete(pi[s]); ins(pi[s],n); end else if ch='t' then begin readln(s,t); if t=0 then continue; pos:=delete(pi[s]); ins(pi[s],pos+t); end else if ch='k' then begin readln(s); splay(root,pi[s]); writeln(son[c[root,0]]); end else begin readln(s); pos:=find(s); splay(root,pos); writeln(po[pos]); end; end; end; //===================================================================== begin //assign(input,'book.in'); reset(input); //assign(output,'book.out'); rewrite(output); init; main; // close(input); close(output); end.
