bzoj 1861 splay

就是裸地splay，然后自己写的不是特别好，tle了，最近时间比较紧迫，有时间了改下，在此记录

另附转载pascal AC代码最下面

/**************************************************************
    Problem:
    User: BLADEVIL
    Language: Pascal
    Result: Time_Limit_Exceed
****************************************************************/

//By BLADEVIL
const
    sroot                       =-;

var
    num, adress                 :array[-..] of longint;
    son                         :array[-..,..] of longint;
    father, size, tree          :array[-..] of longint;
    root                        :longint;
    n, m                        :longint;

procedure init;
var
    i                           :longint;
begin
    read(n,m);
    for i:= to n do
    begin
        read(num[i]);
        adress[num[i]]:=i;
    end;
    readln;
end;

procedure update(x:longint);
begin
    size[x]:=size[son[x,]]+size[son[x,]]+;
end;

function find(x:longint):longint;
var
    t                           :longint;
begin
    t:=root;
    while true do
    begin
        if size[son[t,]]+=x then exit(t);
        if size[son[t,]]+>x then t:=son[t,] else
        begin
            dec(x,size[son[t,]]+);
            t:=son[t,];
        end;
    end;
end;

procedure rotate(x,y:longint);
var
    f                           :longint;
begin
    f:=father[x];
    father[son[x,y xor ]]:=f;
    son[f,y]:=son[x,y xor ];
    if f=root then root:=x
    else
        if f=son[father[f],] then
            son[father[f],]:=x else
            son[father[f],]:=x;
    father[x]:=father[f];
    father[f]:=x;
    son[x,y xor ]:=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],])) else
        begin
            if x=son[father[x],] then u:= else u:=-;
            if father[x]=son[father[father[x]],] then v:= else v:=-;
            if u*v= then
            begin
                rotate(father[x],ord(x=son[father[x],]));
                rotate(x,ord(x=son[father[x],]));
            end else
            begin
                rotate(x,ord(x=son[father[x],]));
                rotate(x,ord(x=son[father[x],]));
            end;
        end;
    update(x);
end;

function build(l,r:longint):longint;
var
    mid                         :longint;
begin
    mid:=(l+r) div ;
    build:=mid;
    tree[mid]:=num[mid];
    if l<=mid- then
    begin
        son[mid,]:=build(l,mid-);
        father[son[mid,]]:=mid;
    end;
    if r>=mid+ then
    begin
        son[mid,]:=build(mid+,r);
        father[son[mid,]]:=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,]];
    p:=find(q); splay(p,sroot);
    p:=find(q+); splay(p,root);
    p:=son[son[root,],];
    son[son[root,],]:=-;
    update(son[root,]);
    update(root);
    father[p]:=-;
    q:=find(); splay(q,sroot);
    q:=find(); splay(q,root);
    son[son[root,],]:=p;
    father[p]:=son[root,];
    update(son[root,]);
    update(root);
end;    

procedure bottom;
var
    x                           :longint;
    q, p                        :longint;
begin
    readln(x);
    x:=adress[x];
    splay(x,sroot);
    q:=size[son[x,]];
    p:=find(q); splay(p,sroot);
    p:=find(q+); splay(p,root);
    q:=son[son[root,],];
    son[son[root,],]:=-;
    father[q]:=-;
    update(son[root,]);
    update(root);
    p:=find(n-); splay(p,sroot);
    p:=find(n); splay(p,root);
    son[son[root,],]:=q;
    father[q]:=son[root,];
    update(son[root,]);
    update(root);
end;

procedure insert;
var
    x, y                        :longint;
    q, p                        :longint;

begin
    readln(x,y);
    x:=adress[x];
    if y=- then
    begin
        splay(x,sroot);
        p:=size[son[root,]];
        q:=find(p); splay(q,sroot);
        q:=find(p+); splay(q,root);
        x:=son[son[root,],];
        son[son[root,],]:=-;
        q:=find(p-); splay(q,sroot);
        q:=find(p); splay(q,root);
        son[son[root,],]:=x;
        father[x]:=son[son[root,],];
    end else
    begin

        splay(x,sroot);
        p:=size[son[root,]];
        q:=find(p); splay(q,sroot);
        q:=find(p+); splay(q,root);
        x:=son[son[root,],];
        son[son[root,],]:=-;
        q:=find(p); splay(q,sroot);
        q:=find(p+); splay(q,root);
        son[son[root,],]:=x;
        father[x]:=son[son[root,],];
    end;
end;

procedure ask;
var
    x                           :longint;
begin
    readln(x);
    x:=adress[x];
    splay(x,sroot);
    writeln(size[son[root,]]-);
end;

procedure query;
var
    x                           :longint;
    p                           :longint;
begin
    readln(x);
    p:=find(x+);
    splay(p,sroot);
    writeln(tree[root]);
end;    

procedure main;
var
    i                           :longint;
    ch                          :char;
    s                           :ansistring;

begin
    fillchar(son,sizeof(son),);
    inc(n);
    root:=build(,n);
    father[root]:=sroot;
    for i:= 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:
    User: BLADEVIL
    Language: Pascal
    Result: Accepted
    Time: ms
    Memory: kb
****************************************************************/

{$inline on}
program zjoi__day2_book;
var fa,pi,po,son:array[..] of longint;
    c:array[..,..] 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,]=x then p:= else p:=;
  q:=p xor ;
  if y=root then root:=x else
    if c[z,]=y then c[z,]:=x else c[z,]:=x;
  if c[x,q]> 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,]]+son[c[y,]]+;
  son[x]:=son[y]+son[c[x,p]]+;    //一开始这里没加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,]=x) xor (c[z,]=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:= to n do
  begin
    read(x); pi[x]:=i;
    po[i]:=x; son[i]:=n-i+;
  end; readln;    //这里没有readln的错误还是第一次碰到。。。
  for i:= to n- do c[i,]:=i+;
  for i:= to n do fa[i]:=i-;
  root:=; splay(root,n);
end;
//=====================================================================
function delete(x:longint):longint; inline;
var left,right:longint;
begin
  splay(root,x);
  left:=c[root,]; right:=c[root,];
  while c[left,]> do left:=c[left,];
  while c[right,]> do right:=c[right,];
  if left> then splay(root,left);
  if right> then
    if left> then splay(c[root,],right) else
      splay(root,right);
  if right= then
  begin delete:=n;
    c[left,]:=;
    if left> then dec(son[left]);
  end else
  begin
    if left> then
      delete:=son[left]-son[right]+ else
        delete:=;
    c[right,]:=; dec(son[right]);
    if left> then dec(son[left]);
  end; fa[x]:=; son[x]:=;
end;
//=====================================================================
function find(x:longint):longint; inline;
var i:longint;
begin
  i:=root;
  while i<> do
  begin
    if son[c[i,]]+=x then exit(i);
    if son[c[i,]]>=x then i:=c[i,] else
    begin
      dec(x,son[c[i,]]+); i:=c[i,];
    end;
  end; exit(i);
end;
//=====================================================================
procedure ins(x,y:longint); inline;
var left,right:longint;
begin
  left:=find(y-); right:=find(y);
  if left> then splay(root,left);
  if right> then
    if left> then splay(c[root,],right) else
      splay(root,right);
  if right= then
  begin
    fa[x]:=left; c[left,]:=x; inc(son[left]);
  end else
  begin
    inc(son[right]); fa[x]:=right; c[right,]:=x;
    if left> then inc(son[left]);
  end;
end;
//=====================================================================
procedure main;
var ch,ch1:char;
    i,s,t,pos:longint;
begin
  for i:= 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],);
    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= 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,]]);
    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.