Code:Treap/Pascal

来自NOCOW

插入非格式文本

(*
	Problem: Treap
	Author: LiuQin
	Method: DS
	Data Strucktrue: Treap
	Date: 2006-12-11
	Status: Done
	Remarks: 标准Treap
*)
const
	Infinity = MaxLongint div 2;
type
	TIndex = Longint;
	TData = Int64;
	PTreapNode = ^TTreapNode;
	TTreapNode = record
		Key: TData;
		Priority: TIndex;
		Count: TIndex;
		Total: TIndex;
		LeftNode, RightNode: PTreapNode;
	end;
	TTreap = object
		NullNode, RootNode: PTreapNode;
		procedure Initialize;
		procedure UpdateSum(var CurNode: PTreapNode);
		procedure LeftRotate(var CurNode: PTreapNode);
		procedure RightRotate(var CurNode: PTreapNode);
		procedure InsertNode(var CurNode: PTreapNode; const Key: TData);
		procedure DeleteNode(var CurNode: PTreapNode; const Key: TData);
		function GetMinimum: TData;
		function GetMaximum: TData;
		procedure Insert(const Key: TData);
		procedure Delete(const Key: TData);
		function FindRank(Rank: TIndex): TData;
		function GetRank(const Key: TData): TIndex;
	end;
 
procedure TTreap.Initialize;
begin
	New(NullNode);
	NullNode^.Priority := Infinity;
	NullNode^.Count := 0;
	NullNode^.Total := 0;
	NullNode^.LeftNode := NullNode;
	NullNode^.RightNode := NullNode;
	RootNode := NullNode;
end;
procedure TTreap.UpdateSum(var CurNode: PTreapNode);
begin
	CurNode^.Total := CurNode^.LeftNode^.Total + CurNode^.RightNode^.Total + CurNode^.Count;
end;
procedure TTreap.LeftRotate(var CurNode: PTreapNode);
var
	TmpNode: PTreapNode;
begin
	TmpNode := CurNode^.LeftNode;
	CurNode^.LeftNode := TmpNode^.RightNode;
	TmpNode^.RightNode := CurNode;
	UpdateSum(CurNode);
	UpdateSum(TmpNode);
	CurNode := TmpNode;
end;
procedure TTreap.RightRotate(var CurNode: PTreapNode);
var
	TmpNode: PTreapNode;
begin
	TmpNode := CurNode^.RightNode;
	CurNode^.RightNode := TmpNode^.LeftNode;
	TmpNode^.LeftNode := CurNode;
	UpdateSum(CurNode);
	UpdateSum(TmpNode);
	CurNode := TmpNode;
end;
procedure TTreap.InsertNode(var CurNode: PTreapNode; const Key: TData);
begin
	if CurNode = NullNode then
	begin
		New(CurNode);
		CurNode^.Key := Key;
		CurNode^.Priority := Random(Infinity);
		CurNode^.Count := 1;
		CurNode^.Total := 1;
		CurNode^.LeftNode := NullNode;
		CurNode^.RightNode := NullNode;
	end
	else if Key < CurNode^.Key then
	begin
		InsertNode(CurNode^.LeftNode, Key);
		if CurNode^.LeftNode^.Priority < CurNode^.Priority then
			LeftRotate(CurNode);
	end
	else if Key > CurNode^.Key then
	begin
		InsertNode(CurNode^.RightNode, Key);
		if CurNode^.RightNode^.Priority < CurNode^.Priority then
			RightRotate(CurNode);
	end
	else //if CurNode^.Key = Key then
		Inc(CurNode^.Count);
	UpdateSum(CurNode);
end;
procedure TTreap.DeleteNode(var CurNode: PTreapNode; const Key: TData);
begin
	if CurNode <> NullNode then
		if Key < CurNode^.Key then
			DeleteNode(CurNode^.LeftNode, Key)
		else if Key > CurNode^.Key then
			DeleteNode(CurNode^.RightNode, Key)
		else if CurNode^.Count > 1 then
			Dec(CurNode^.Count)
		else if (CurNode^.LeftNode = NullNode) and (CurNode^.RightNode = NullNode) then
		begin
			Dispose(CurNode);
			CurNode := NullNode;
		end
		else
		begin
			if CurNode^.LeftNode^.Priority < CurNode^.RightNode^.Priority then
				LeftRotate(CurNode)
			else
				RightRotate(CurNode);
			DeleteNode(CurNode, Key);
		end;
	UpdateSum(CurNode);
end;
function TTreap.GetMinimum: TData;
var
	CurNode: PTreapNode;
begin
	CurNode := RootNode;
	while CurNode^.LeftNode <> NullNode do
		CurNode := CurNode^.LeftNode;
	Result := CurNode^.Key;
end;
function TTreap.GetMaximum: TData;
var
	CurNode: PTreapNode;
begin
	CurNode := RootNode;
	while CurNode^.RightNode <> NullNode do
		CurNode := CurNode^.RightNode;
	Result := CurNode^.Key;
end;
procedure TTreap.Insert(const Key: TData);
begin
	InsertNode(RootNode, Key);
end;
procedure TTreap.Delete(const Key: TData);
begin
	DeleteNode(RootNode, Key);
end;
function TTreap.FindRank(Rank: TIndex): TData;
var
	CurNode: PTreapNode;
begin
	CurNode := RootNode;
	while CurNode <> NullNode do
		if Rank <= CurNode^.LeftNode^.Total then
			CurNode := CurNode^.LeftNode
		else
		begin
			Dec(Rank, CurNode^.LeftNode^.Total);
			if Rank <= CurNode^.Count then Break;
			Dec(Rank, CurNode^.Count);
			CurNode := CurNode^.RightNode;
		end;
	Result := CurNode^.Key;
end;
function TTreap.GetRank(const Key: TData): TIndex;
var
	CurNode: PTreapNode;
begin
	CurNode := RootNode;
	Result := 0;
	while CurNode <> NullNode do
		if Key < CurNode^.Key then
			CurNode := CurNode^.LeftNode
		else
		begin
			Inc(Result, CurNode^.LeftNode^.Total + CurNode^.Count);
			if Key = CurNode^.Key then Break;
			CurNode := CurNode^.RightNode;
		end;
end;
var
	M: TIndex;
	Treap: TTreap;
procedure Main;
var
	x: TIndex;
	Ch, Tmp: Char;
begin
	Treap.Initialize;
	ReadLn(M);
	while M > 0 do
	begin
		Dec(M);
		Read(Ch, Tmp);
		while Tmp <> ' ' do
			Read(Tmp);
		Readln(x);
		if Ch = 'I' Then
			Treap.InsertNode(Treap.RootNode, x)
		else if Ch = 'D' Then
				Treap.DeleteNode(Treap.RootNode, x)
		else if Ch = 'F' Then
				Writeln(Treap.FindRank(x))
		else if Ch = 'G' Then
				Writeln(Treap.GetRank(x));
	end;
end;
begin
	Assign(Input, 'bst.in');
	Reset(Input);
	Assign(Output, 'bst.out');
	Rewrite(Output);
	Main;
	Close(Input);
	Close(Output);
end.

//不用指针，静态的Treap代码 By Jollwish
type node=record
      f,lc,rc,key:longint;
      fix:extended;
     end;
 
var a:array[1..100000]of node;
    n,m,root:longint;
 
function search(x,k:longint):longint;
 begin
  if k=0 then exit(0);
  if a[k].key=x then exit(k);
  if a[k].key>x then exit(search(x,a[k].lc));
  if a[k].key<x then exit(search(x,a[k].rc));
 end;
 
procedure rotate_left(var k:longint);
 var y:longint;
 begin
  y:=a[k].rc;
  a[k].rc:=a[y].lc;
  if a[y].lc>0 then a[a[y].lc].f:=k;
  a[y].f:=a[k].f;
  if a[k].f=0
   then root:=y
   else if k=a[a[k].f].lc
    then y:=a[a[k].f].lc
    else y:=a[a[k].f].rc;
  k:=a[y].lc;
  a[k].f:=y;
 end;
 
procedure rotate_right(var k:longint);
 var y:longint;
 begin
  y:=a[k].lc;
  a[k].lc:=a[y].rc;
  if a[y].rc>0 then a[a[y].rc].f:=k;
  a[y].f:=a[k].f;
  if a[k].f=0
   then root:=y
   else if k=a[a[k].f].lc
    then y:=a[a[k].f].lc
    else y:=a[a[k].f].rc;
  k:=a[y].rc;
  a[k].f:=y;
 end;
 
procedure insert(x,k:longint);
 var tmp:longint;
 begin
  if a[k].key>x then
   begin
    if a[k].lc=0 then
     begin
      inc(n);
      a[n].f:=k;
      a[n].key:=x;
      randomize;
      a[n].fix:=random;
      a[k].lc:=n;
	  tmp:=a[n].f;
      if a[n].fix<a[tmp].fix then rotate_right(tmp);
	  a[n].f:=tmp;
     end
    else insert(x,a[k].lc);
   end;
  if a[k].key<x then
   begin
    if a[k].rc=0 then
     begin
      inc(n);
      a[n].f:=k;
      a[n].key:=x;
      randomize;
      a[n].fix:=random;
      a[k].rc:=n;
	  tmp:=a[n].f;
      if a[n].fix<a[tmp].fix then rotate_left(tmp);
	  a[n].f:=tmp;
     end
    else insert(x,a[k].rc);
  end;
 end;
 
procedure remove(k:longint);
 begin
  while (a[k].lc>0)or(a[k].rc>0) do
   begin
    if a[k].lc=0 then
     begin 
      rotate_left(k);
      continue;
     end;
   if a[k].rc=0 then
    begin
     rotate_right(k);
     continue;
    end;
   if a[a[k].lc].fix>a[a[k].rc].fix
    then rotate_left(k)
    else rotate_right(k);
  end;
  if a[a[k].f].lc=k
   then a[a[k].f].lc:=0
   else a[a[k].f].rc:=0;
 end;
 
procedure init;
 var i,x,o:longint;
 begin
  fillchar(a,sizeof(a),0);
  readln(o,m);
  read(x);
  a[1].key:=x;
  n:=1;
  root:=1;
  for i:=2 to o do
   begin
    read(x);
    insert(x,root);
   end;
  readln;
 end;
 
procedure main;
 var i,p,q:longint;
     ch,space:char;
 begin
  for i:=1 to m do
   begin
    read(ch);
    read(space);
    readln(p);
    case ch of
     'I':insert(p,root);
     'S':begin
          q:=search(p,root);
          if q=0 then writeln('NO') else writeln('YES');
         end;
     'D':begin
          q:=search(p,root);
          remove(q);
         end; 
    end;
   end;
 end;
 
begin
 init;
 main;
end.

//By Jiguanglizipao
Program treap; //数组模拟链表，带内存回收，支持插入、查找、删除
Type
  Rec1 = Record
    f, w, p: Longint; //父节点：f 值：w 随机值：p
    a : Array[0..1] Of Longint;//左儿子：0, 右儿子：1
  End;
Const
  infile = 'treap.in';
  outfile = 'treap.out';
  maxn = 1000000;
Var
  tree : Array[0..maxn] Of Rec1; //树
  d : Array[1..maxn] Of Longint; //回收内存循环队列
  n, i, h, t, x, tn : Longint;
  ch : char;
Procedure rotate(k, p : Longint); //旋转 左0右1
Begin
  If tree[tree[k].f].a[0] = k Then tree[tree[k].f].a[0] := tree[k].a[1-p] Else tree[tree[k].f].a[1] := tree[k].a[1-p];
  tree[tree[k].a[1-p]].f := tree[k].f;
  tree[k].f := tree[k].a[1-p];
  tree[k].a[1-p] := tree[tree[k].f].a[p];
  tree[tree[k].a[1-p]].f := k;
  tree[tree[k].f].a[p] := k;
End;
Procedure up(k : Longint); //维护堆的性质
Begin
  If (tree[k].f = 0) Or (tree[k].p <= tree[tree[k].f].p) Then Exit;
  If tree[tree[k].f].a[1] = k Then rotate(tree[k].f, 0) Else rotate(tree[k].f, 1);
  up(k);
End;
Procedure Insert(x, k : Longint); //在K的儿子中插入一个值为x的点
Var
  p, o : Longint;
Begin
  If tree[k].w = x Then Exit; //如果已存在，退出
  If tree[k].w > x Then o := 0 Else o := 1;
  If tree[k].a[o] <> 0 Then Insert(x, tree[k].a[o]) Else Begin //如果K的儿子不能插入，找他的儿子
    If h = t Then Begin
      Inc(tn);
      p := tn;
    End Else Begin
      h := h mod maxn + 1;
      p := d[h];
    End;
    tree[k].a[o] := p;
    tree[p].w := x;
    tree[p].f := k;
    tree[p].p := random(maxn);
    up(p); //维护堆
  End;
End;
Function Find(x, k : Longint) : Longint; //查找X
Begin
  If ((x < tree[k].w) And (tree[k].a[0] = 0)) Or ((tree[k].w < x) And (tree[k].a[1] = 0)) Then Exit(0);
  If x = tree[k].w Then Exit(k);
  If x < tree[k].w Then find := find(x, tree[k].a[0]) Else find := find(x, tree[k].a[1]);
End;
Procedure Delete(x : Longint); //删除X
Var
  k : Longint;
Begin
  k := find(x, tree[0].a[1]); //查找X是否存在
  If k = 0 Then Exit;
  While (tree[k].a[0] <> 0) Or (tree[k].a[1] <> 0)Do Begin //将这个点旋转至最底层
    If tree[k].a[0] <> 0 Then rotate(k, 1) Else rotate(k, 0);
  End;
  t := t Mod maxn + 1; //删除
  If x < tree[tree[k].f].w Then tree[tree[k].f].a[0] := 0 Else tree[tree[k].f].a[1] := 0;
  d[t] := k;
End;
Begin
  Randomize;
  Assign(input, infile);
  Assign(output, outfile);
  Reset(input);
  Rewrite(output);
  ReadLn(n);
  tree[0].w := -maxlongint;
  For i:=1 To n Do Begin
    ReadLn(ch, x);
    If ch = 'I' Then Insert(x, tree[0].a[1]);
    If ch = 'D' Then Delete(x);
    If ch = 'F' Then If Find(x, tree[0].a[1]) = 0 Then WriteLn('NO') Else WriteLn('YES');
  End;
  Close(input);
  Close(output);
End.

</source>

//Author: 奇の犽
// Problem: HNOI 2004 day1 pet 宠物收养所
type ch=record
          l,r,key:longint;
          fix:real;
        end;
var i,x,b,c,y,root,tot,ans,n,kind:longint;
    a:array[0..80001] of ch;
 
procedure right(var x:longint);
var k:longint;
begin
  k:=a[x].l;
  a[x].l:=a[k].r;
  a[k].r:=x;
  x:=k;
end;
 
procedure left(var x:longint);
var k:longint;
begin
  k:=a[x].r;
  a[x].r:=a[k].l;
  a[k].l:=x;
  x:=k;
end;
 
procedure insert(var x:longint;y:longint);
begin
  if x=0 then
    begin
      x:=tot;
      a[x].key:=y;
      a[x].fix:=random;
      exit;
    end;
  if y<a[x].key then
    begin
      insert(a[x].l,y);
      if a[a[x].l].fix<a[x].fix then right(x);
    end
    else begin
      insert(a[x].r,y);
      if a[a[x].r].fix<a[x].fix then left(x);
    end;
end;
 
procedure find(x,y:longint);
begin
  if x=0 then exit;
  if (abs(a[x].key-y)<b)or((abs(a[x].key-y)=b)and(a[x].key<c)) then
    begin
      b:=abs(a[x].key-y);
      c:=a[x].key;
    end;
  if a[x].key<y then find(a[x].r,y)
    else find(a[x].l,y);
end;
 
procedure delete(var x:longint;y:longint);
begin
  if x=0 then exit;
  if a[x].key<y then delete(a[x].r,y);
  if a[x].key>y then delete(a[x].l,y);
  if a[x].key=y then
    if a[x].l*a[x].r=0 then x:=a[x].l+a[x].r
      else if a[a[x].l].fix<a[x].fix then
        begin
          right(x);
          delete(a[x].r,y);
        end
        else begin
          left(x);
          delete(a[x].l,y);
        end;
end;
 
begin
  assign(input,'pet.in');reset(input);
  assign(output,'pet.out');rewrite(output);
  readln(n);kind:=-1;root:=0;
  ans:=0;tot:=0;randomize;
  fillchar(a,sizeof(a),0);
  for i:=1 to n do
    begin
      readln(x,y);
      case x of
        0:begin
            if kind=-1 then
              begin
                inc(tot);
                insert(root,y);
                kind:=0;
                continue;
              end;
            if kind=0 then
              begin
                inc(tot);
                insert(root,y);
                continue;
              end;
            b:=maxlongint;
            find(root,y);
            ans:=(ans+abs(y-c)) mod 1000000;
            delete(root,c);
            dec(tot);
            if tot=0 then
              begin
                kind:=-1;
                fillchar(a,sizeof(a),0);
                root:=0;
              end;
          end;
        1:begin
            if kind=-1 then
              begin
                inc(tot);
                insert(root,y);
                kind:=1;
                continue;
              end;
            if kind=1 then
              begin
                inc(tot);
                insert(root,y);
                continue;
              end;
            b:=maxlongint;
            find(root,y);
            ans:=(ans+abs(y-c)) mod 1000000;
            delete(root,c);
            dec(tot);
            if tot=0 then
              begin
                kind:=-1;
                fillchar(a,sizeof(a),0);
                root:=0;
              end;
          end;
      end;
    end;
  writeln(ans);
  close(input);close(output);
end.

Code:Treap/Pascal

查看

个人工具

导航

搜索

工具箱