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.