Hướng dẫn giải của Tập hợp động (Pascal Version)
Chỉ dùng lời giải này khi không có ý tưởng, và đừng copy-paste code từ lời giải này. Hãy tôn trọng người ra đề và người viết lời giải.
Nộp một lời giải chính thức trước khi tự giải là một hành động có thể bị ban.
Nộp một lời giải chính thức trước khi tự giải là một hành động có thể bị ban.
Lưu ý: Các code mẫu dưới đây chỉ mang tính tham khảo và có thể không AC được bài tập này
Code mẫu của happyboy99x
program PASSET; type Node = ^TNode; TNode = Record value: Longint; left, right, parent: Node; end; var root, null: Node; procedure Init; begin new(null); null^.left := null; null^.right := null; null^.parent := null; root := null; end; function Empty: boolean; begin Exit(root = null); end; function LeftMost: Node; var res: Node; begin res := root; while res^.left <> null do res := res^.left; Exit(res); end; function RightMost: Node; var res: Node; begin res := root; while res^.right <> null do res := res^.right; Exit(res); end; procedure Link(x, y: Node; dir: Integer); begin if x = null then begin root := y; if root <> null then root^.parent := null; end else if dir <> -1 then begin if dir = 0 then x^.left := y else x^.right := y; if y <> null then y^.parent := x; end; end; procedure LeftRotate(x: Node); var y, p: Node; dir: Integer; begin y := x^.right; p := x^.parent; if p^.left = x then dir := 0 else if p^.right = x then dir := 1 else dir := -1; Link(p, y, dir); Link(x, y^.left, 1); Link(y, x, 0); end; procedure RightRotate(x: Node); var y, p: Node; dir: Integer; begin y := x^.left; p := x^.parent; if p^.left = x then dir := 0 else if p^.right = x then dir := 1 else dir := -1; Link(p, y, dir); Link(x, y^.right, 0); Link(y, x, 1); end; procedure Splay(x: Node); var p, g: Node; begin while (x <> null) and (x <> root) do begin p := x^.parent; g := p^.parent; if p = root then begin if p^.left = x then RightRotate(p) else LeftRotate(p); end else if (p^.left = x) xor (g^.left = p) then begin if p^.left = x then begin RightRotate(p); LeftRotate(g); end else begin LeftRotate(p); RightRotate(g); end; end else begin if p^.left = x then begin RightRotate(g); RightRotate(p); end else begin LeftRotate(g); LeftRotate(p); end; end; end; end; function Find(x: Longint): Node; var res: Node; begin res := root; while (res <> null) and (res^.value <> x) do if x < res^.value then res := res^.left else res := res^.right; Splay(res); Exit(res); end; procedure Insert(x: Longint); var curr, prev: Node; dir: Integer; begin curr := root; prev := null; while (curr <> null) and (curr^.value <> x) do begin prev := curr; if x < curr^.value then begin curr := curr^.left; dir := 0; end else begin curr := curr^.right; dir := 1; end; end; if curr <> null then Exit; new(curr); curr^.parent := null; curr^.left := null; curr^.right := null; curr^.value := x; Link(prev, curr, dir); Splay(curr); end; procedure Delete(x: Longint); var left, right: Node; begin Find(x); if Empty or (root^.value <> x) then Exit; left := root^.left; right := root^.right; dispose(root); Link(null, left, -1); Splay(RightMost); Link(root, right, 1); end; function Greater(x: Longint): Node; var curr, res: Node; begin curr := root; res := null; while curr <> null do if x >= curr^.value then curr := curr^.right else begin if (res = null) or (res^.value > curr^.value) then res := curr; curr := curr^.left; end; //Splay(res); Exit(res); end; function Smaller(x: Longint): Node; var curr, res: Node; begin curr := root; res := null; while curr <> null do if x <= curr^.value then curr := curr^.left else begin if (res = null) or (res^.value < curr^.value) then res := curr; curr := curr^.right; end; //Splay(res); Exit(res); end; Procedure Print(x: Node); begin if x = null then Exit; Print(x^.left); Write(x^.value, ' '); Print(x^.right); if x = root then Writeln; end; procedure Solve; var cmd, x: Longint; res: Node; begin Read(cmd); while cmd <> 0 do begin if (cmd <> 3) and (cmd <> 4) then Read(x); if cmd = 1 then Insert(x) else if cmd = 2 then Delete(x) else if Empty then Writeln('empty') else if cmd = 3 then Writeln(LeftMost^.value) else if cmd = 4 then Writeln(RightMost^.value) else if ((cmd = 6) or (cmd = 8)) and (Find(x) <> null) then Writeln(x) else begin if (cmd = 5) or (cmd = 6) then res := Greater(x) else res := Smaller(x); if res = null then Writeln('no') else Writeln(res^.value); end; Read(cmd); end; end; begin Init; Solve; end.
Code mẫu của RR
//Wishing myself a happy lunar new year with a lot of accept solutions //Written by Nguyen Thanh Trung (algorithm by conankudo) {$R-,Q-} uses math; const FINP=''; FOUT=''; MAXN=300011; oo=1000000001; snode=524288; var sl,mink,maxk:array[1..snode] of longint; n,m:longint; dd,yc,x,key:array[1..MAXN] of longint; procedure swap(var a,b:longint); inline; var temp:longint; begin temp:=a; a:=b; b:=temp; end; procedure inp; inline; var f:text; i,u:longint; begin assign(f,FINP); reset(f); n:=0; m:=0; repeat inc(n); read(f,u); yc[n]:=u; if u in [1,2,5,6,7,8] then read(f,x[n]); if u in [1,2] then begin inc(m); key[m]:=x[n]; end; until yc[n]=0; dec(n); close(f); end; procedure sort(l,r:longint); inline; var mid,i,j:longint; begin i:=l; j:=r; mid:=key[l+random(r-l+1)]; repeat while key[i]<mid do inc(i); while key[j]>mid do dec(j); if i<=j then begin swap(key[i],key[j]); inc(i); dec(j); end; until i>j; if i<r then sort(i,r); if l<j then sort(l,j); end; procedure init; inline; var i,j:longint; begin sort(1,m); j:=1; for i:=2 to m do if key[i]>key[j] then begin inc(j); key[j]:=key[i]; end; m:=j; for i:=1 to snode do begin mink[i]:=oo; maxk[i]:=-oo; end; end; function find(u:longint):longint; inline; var l,r,mid:longint; begin l:=1; r:=m; repeat mid:=(l+r) shr 1; if key[mid]=u then exit(mid) else if u<key[mid] then r:=mid else l:=mid; until r-l<=1; if key[l]=u then exit(l) else exit(r); end; procedure add(u:longint); inline; procedure visit(i,l,r:longint); inline; var mid:longint; begin if l>r then exit; if (u<l) or (r<u) then exit; if (u=l) and (u=r) then begin mink[i]:=key[u]; maxk[i]:=key[u]; sl[i]:=1; exit; end; mid:=(l+r) shr 1; visit(i shl 1,l,mid); visit(i shl 1+1,mid+1,r); mink[i]:=min(mink[i shl 1],mink[i shl 1+1]); maxk[i]:=max(maxk[i shl 1],maxk[i shl 1+1]); sl[i]:=sl[i shl 1]+sl[i shl 1+1]; end; begin dd[u]:=1; visit(1,1,m); end; procedure del(u:longint); inline; procedure visit(i,l,r:longint); inline; var mid:longint; begin if l>r then exit; if (u<l) or (r<u) then exit; if (u=l) and (u=r) then begin mink[i]:=oo; maxk[i]:=-oo; sl[i]:=0; exit; end; mid:=(l+r) shr 1; visit(i shl 1,l,mid); visit(i shl 1+1,mid+1,r); mink[i]:=min(mink[i shl 1],mink[i shl 1+1]); maxk[i]:=max(maxk[i shl 1],maxk[i shl 1+1]); sl[i]:=sl[i shl 1]+sl[i shl 1+1]; end; begin dd[u]:=0; visit(1,1,m); end; function succ(u:longint):longint; inline; var kq:longint; procedure visit(i,l,r:longint); inline; var mid:longint; begin if l>r then exit; if sl[i]=0 then exit; if maxk[i]<=u then exit; if mink[i]>u then begin kq:=min(kq,mink[i]); exit; end; mid:=(l+r) shr 1; visit(i shl 1,l,mid); visit(i shl 1+1,mid+1,r); end; begin kq:=oo; visit(1,1,m); succ:=kq; end; function succ2(u:longint):longint; inline; var kq:longint; procedure visit(i,l,r:longint); inline; var mid:longint; begin if l>r then exit; if sl[i]=0 then exit; if maxk[i]<u then exit; if mink[i]>=u then begin kq:=min(kq,mink[i]); exit; end; mid:=(l+r) shr 1; visit(i shl 1,l,mid); visit(i shl 1+1,mid+1,r); end; begin kq:=oo; visit(1,1,m); succ2:=kq; end; function pred(u:longint):longint; inline; var kq:longint; procedure visit(i,l,r:longint); inline; var mid:longint; begin if l>r then exit; if sl[i]=0 then exit; if mink[i]>=u then exit; if maxk[i]<u then begin kq:=max(kq,maxk[i]); exit; end; mid:=(l+r) shr 1; visit(i shl 1,l,mid); visit(i shl 1+1,mid+1,r); end; begin kq:=-oo; visit(1,1,m); pred:=kq; end; function pred2(u:longint):longint; inline; var kq:longint; procedure visit(i,l,r:longint); inline; var mid:longint; begin if l>r then exit; if sl[i]=0 then exit; if mink[i]>u then exit; if maxk[i]<=u then begin kq:=max(kq,maxk[i]); exit; end; mid:=(l+r) shr 1; visit(i shl 1,l,mid); visit(i shl 1+1,mid+1,r); end; begin kq:=-oo; visit(1,1,n); pred2:=kq; end; procedure solve; var i,k:longint; f:text; begin assign(f,FOUT); rewrite(f); for i:=1 to n do case yc[i] of 1: begin k:=find(x[i]); if dd[k]=0 then add(k); end; 2: begin k:=find(x[i]); if dd[k]=1 then del(k); end; 3: if sl[1]=0 then writeln(f,'empty') else writeln(f,mink[1]); 4: if sl[1]=0 then writeln(f,'empty') else writeln(f,maxk[1]); 5: if sl[1]=0 then writeln(f,'empty') else begin k:=succ(x[i]); if k=oo then writeln(f,'no') else writeln(f,k); end; 6: if sl[1]=0 then writeln(f,'empty') else begin k:=succ2(x[i]); if k=oo then writeln(f,'no') else writeln(f,k); end; 7: if sl[1]=0 then writeln(f,'empty') else begin k:=pred(x[i]); if k=-oo then writeln(f,'no') else writeln(f,k); end; 8: if sl[1]=0 then writeln(f,'empty') else begin k:=pred2(x[i]); if k=-oo then writeln(f,'no') else writeln(f,k); end; end; close(f); end; begin inp; init; solve; end.
Code mẫu của skyvn97
program pascal_avl; const not_available=1000000007; empty=-1000000007; type pnode=^tnode; tnode=record value,high,balance:longint; parent,left,right:pnode; end; var root:pnode; function max(x,y:longint):longint; begin if x>y then exit(x) else exit(y); end; function min(x,y:longint):longint; begin if x<y then exit(x) else exit(y); end; procedure tree_view(a:pnode); begin if a=nil then begin write('()'); exit; end; write('('); write(a^.value,'|',a^.high,'|',a^.balance); tree_view(a^.left); write(','); tree_view(a^.right); write(')'); end; procedure tree_init; begin root:=nil; end; procedure create(var p:pnode;x:longint); begin if p<>nil then exit; new(p); p^.value:=x; p^.high:=1; p^.balance:=0; p^.parent:=nil; p^.left:=nil; p^.right:=nil; end; procedure calculate(a:pnode); var lh,rh:longint; begin //writeln('Calculating ',a^.value); if a^.left=nil then lh:=0 else lh:=a^.left^.high; if a^.right=nil then rh:=0 else rh:=a^.right^.high; //writeln(lh,' ',rh); a^.high:=max(lh,rh)+1; a^.balance:=lh-rh; end; procedure link(a,b:pnode;dir:byte); begin if a=nil then begin root:=b; if root<>nil then root^.parent:=nil; exit; end; if dir=1 then a^.left:=b else a^.right:=b; if b<>nil then b^.parent:=a; end; procedure left_rotation(a:pnode); var b,c:pnode; dir:byte; begin //writeln('Left rotating ',a^.value); //writeln('Before:'); //tree_view(root); //writeln; c:=a^.parent; dir:=0; if c<>nil then begin if c^.left=a then dir:=1 else dir:=2; end; b:=a^.right; link(a,b^.left,2); link(b,a,1); link(c,b,dir); calculate(a); calculate(b); //writeln('After:'); //tree_view(root); //writeln; end; procedure right_rotation(a:pnode); var b,c:pnode; dir:byte; begin //writeln('Right rotating ',a^.value); //writeln('Before:'); //tree_view(root); //writeln; c:=a^.parent; dir:=0; if c<>nil then begin if c^.left=a then dir:=1 else dir:=2; end; b:=a^.left; link(a,b^.right,1); link(b,a,2); link(c,b,dir); calculate(a); calculate(b); //writeln('After:'); //tree_view(root); //writeln; end; procedure rebalance(a:pnode); var b,c:pnode; begin while a<>nil do begin //writeln('rebalancing ',a^.value); calculate(a); //writeln('rebalancing ',a^.value); c:=a^.parent; if a^.balance=2 then begin if a^.left^.balance=-1 then left_rotation(a^.left); right_rotation(a); end else if a^.balance=-2 then begin if a^.right^.balance=1 then right_rotation(a^.right); left_rotation(a); end; a:=c; //writeln('Tree detail'); //tree_view(root); //writeln; end; end; procedure insert(x:longint); var p,q:pnode; dir:byte; begin q:=nil; p:=root; while p<>nil do begin q:=p; if x=p^.value then break else begin if x<p^.value then p:=p^.left else p:=p^.right; end; end; //if p<>nil then writeln(x,' is already exists'); if p=nil then begin create(p,x); if root=nil then root:=p else begin if x<q^.value then dir:=1 else dir:=2; link(q,p,dir); //calculate(q); rebalance(p); end; end; //writeln('Inserted ',x); end; procedure delete(x:longint); var p,q,child,node:pnode; dir:byte; begin //writeln('Deleting ',x); q:=nil; p:=root; while p<>nil do begin if p^.value=x then break; q:=p; if x<p^.value then p:=p^.left else p:=p^.right; end; if p=nil then exit; if (p^.left<>nil) and (p^.right<>nil) then begin //writeln('Deleting nod has 2 children'); node:=p; q:=p; p:=p^.left; while p^.right<>nil do begin q:=p; p:=p^.right; end; node^.value:=p^.value; end; //if q=nil then writeln('Prev is nil') else writeln('Prev is ',q^.value); //writeln('Delete nod ',p^.value); if p^.left<>nil then child:=p^.left else child:=p^.right; //if child=nil then writeln('Deleting nod has no child'); if q<>nil then begin if q^.left=p then dir:=1 else dir:=2; end; link(q,child,dir); //calculate(q); //writeln('Tree detail:'); //tree_view(root); //writeln; if child<>nil then rebalance(child) else rebalance(q); dispose(p); //writeln('Deleted ',x); end; function minvalue:longint; var p:pnode; begin p:=root; if p=nil then exit(empty); while p^.left<>nil do p:=p^.left; exit(p^.value); end; function maxvalue:longint; var p:pnode; begin p:=root; if p=nil then exit(empty); while p^.right<>nil do p:=p^.right; exit(p^.value); end; function greater(x:longint):longint; var res:longint; p:pnode; begin if root=nil then exit(empty); p:=root; res:=not_available; while true do begin if p^.value>x then begin res:=min(res,p^.value); if p^.left=nil then break; p:=p^.left; end else begin if p^.right=nil then break; p:=p^.right; end; end; exit(res); end; function notlesser(x:longint):longint; var res:longint; p:pnode; begin if root=nil then exit(empty); p:=root; res:=not_available; while true do begin if p^.value>=x then begin res:=min(res,p^.value); if p^.left=nil then break; p:=p^.left; end else begin if p^.right=nil then break; p:=p^.right; end; end; exit(res); end; function lesser(x:longint):longint; var res:longint; p:pnode; begin if root=nil then exit(empty); p:=root; res:=empty; while true do begin if p^.value<x then begin res:=max(res,p^.value); if p^.right=nil then break; p:=p^.right; end else begin if p^.left=nil then break; p:=p^.left; end; end; if res=empty then exit(not_available); exit(res); end; function notgreater(x:longint):longint; var res:longint; p:pnode; begin if root=nil then exit(empty); p:=root; res:=empty; while true do begin if p^.value<=x then begin res:=max(res,p^.value); if p^.right=nil then break; p:=p^.right; end else begin if p^.left=nil then break; p:=p^.left; end; end; if res=empty then exit(not_available); exit(res); end; procedure process; var t:byte; x,p:longint; begin tree_init; while true do begin read(t); //writeln(t); if t=0 then exit; if (t<>3) and (t<>4) then read(x); if t=1 then insert(x); if t=2 then delete(x); if t=3 then begin p:=minvalue; if p=empty then writeln('empty') else writeln(p); end; if t=4 then begin p:=maxvalue; if p=empty then writeln('empty') else writeln(p); end; if t=5 then begin p:=greater(x); if p=empty then writeln('empty') else if p=not_available then writeln('no') else writeln(p); end; if t=6 then begin p:=notlesser(x); if p=empty then writeln('empty') else if p=not_available then writeln('no') else writeln(p); end; if t=7 then begin p:=lesser(x); if p=empty then writeln('empty') else if p=not_available then writeln('no') else writeln(p); end; if t=8 then begin p:=notgreater(x); if p=empty then writeln('empty') else if p=not_available then writeln('no') else writeln(p); end; //writeln('Tree details'); //tree_view(root); //writeln; end; end; begin // assign(input,'tmp.txt'); // assign(output,'tmp.ans'); reset(input); rewrite(output); process; close(input); close(output); end.
Code mẫu của khuc_tuan
{$mode delphi} //{$APPTYPE CONSOLE} {$R+,Q+,S+} uses SysUtils; var info, sl, rr, nd, x, i, nc : integer; code : array[1..300000,1..2] of integer; total, val, ds : array[1..300000] of integer; procedure sort(l,r : integer); var i, j, m, t : integer; begin if l>=r then exit; m := ds[(l+r) div 2]; i := l; j := r; repeat while ds[i]<m do inc(i); while m<ds[j] do dec(j); if i<=j then begin t := ds[i]; ds[i] := ds[j]; ds[j] := t; inc(i); dec(j); end; until i>j; if i<r then sort(i,r); if l<j then sort(l,j); end; procedure loaitrung; var i, nn : integer; begin nn := 1; for i:=2 to nd do if ds[i]<>ds[i-1] then begin inc(nn); ds[nn] := ds[i]; end; nd := nn; end; procedure mark(l,r,x : integer); var m : integer; begin if l>r then exit; m := (l+r) div 2; if ds[m]=x then begin if val[m]=0 then begin inc(sl); inc(total[m]); info := 1; val[m] := 1; end; end else begin if x<ds[m] then mark(l,m-1,x) else mark(m+1,r,x); if info=1 then inc(total[m]); end; end; procedure unmark(l,r,x : integer); var m : integer; begin if l>r then exit; m := (l+r) div 2; if ds[m]=x then begin if val[m]=1 then begin dec(sl); dec(total[m]); val[m] := 0; info := 1; end; end else begin if x<ds[m] then unmark(l,m-1,x) else unmark(m+1,r,x); if info=1 then dec(total[m]); end; end; procedure findmin(l,r : integer); var m : integer; begin if l>r then exit; if rr<>-1 then exit; m := (l+r) div 2; if total[m]=0 then exit; findmin(l,m-1); if rr=-1 then begin if val[m]=1 then rr := m; end; findmin(m+1,r); end; procedure findmax(l,r : integer); var m : integer; begin if l>r then exit; if rr<>-1 then exit; m := (l+r) div 2; if total[m]=0 then exit; findmax(m+1,r); if rr=-1 then begin if val[m]=1 then rr := m; end; findmax(l,m-1); end; procedure succ(l,r,x : integer); var m : integer; begin if l>r then exit; if rr<>-1 then exit; m := (l+r) div 2; if total[m]=0 then exit; if ds[m]<=x then begin succ(m+1,r,x); end else begin succ(l,m-1,x); if (rr=-1) and (val[m]=1) then rr := m; succ(m+1,r,x); end; end; procedure succ2(l,r,x : integer); var m : integer; begin if l>r then exit; if rr<>-1 then exit; m := (l+r) div 2; if total[m]=0 then exit; if ds[m]<x then begin succ2(m+1,r,x); end else begin succ2(l,m-1,x); if (rr=-1) and (val[m]=1) then rr := m; succ2(m+1,r,x); end; end; procedure pred(l,r,x : integer); var m : integer; begin if l>r then exit; if rr<>-1 then exit; m := (l+r) div 2; if total[m]=0 then exit; if ds[m]>=x then begin pred(l,m-1,x); end else begin pred(m+1,r,x); if (rr=-1) and (val[m]=1) then rr := m; pred(l,m-1,x); end; end; procedure pred2(l,r,x : integer); var m : integer; begin if l>r then exit; if rr<>-1 then exit; m := (l+r) div 2; if total[m]=0 then exit; if ds[m]>x then begin pred2(l,m-1,x); end else begin pred2(m+1,r,x); if (rr=-1) and (val[m]=1) then rr := m; pred2(l,m-1,x); end; end; begin nc := 0; nd := 0; sl := 0; while true do begin read(x); if x=0 then break; inc(nc); code[nc][1] := x; if (x<>3) and (x<>4) then begin read(code[nc][2]); if x=1 then begin inc(nd); ds[nd] := code[nc][2]; end; end; end; sort( 1, nd); loaitrung; for i:=1 to nc do begin rr := -1; info := 0; case code[i][1] of 1: begin mark( 1, nd, code[i][2]); end; 2: begin unmark( 1, nd, code[i][2]); end; 3: begin if sl=0 then writeln('empty') else begin findmin( 1, nd); writeln(ds[rr]); end; end; 4: begin if sl=0 then writeln('empty') else begin findmax( 1, nd); writeln(ds[rr]); end; end; 5: begin if sl=0 then writeln('empty') else begin succ(1, nd, code[i][2]); if rr=-1 then writeln('no') else writeln(ds[rr]); end; end; 6: begin if sl=0 then writeln('empty') else begin succ2(1,nd,code[i][2]); if rr=-1 then writeln('no') else writeln(ds[rr]); end; end; 7: begin if sl=0 then writeln('empty') else begin pred(1,nd,code[i][2]); if rr=-1 then writeln('no') else writeln(ds[rr]); end; end; 8: begin if sl=0 then writeln('empty') else begin pred2(1,nd,code[i][2]); if rr=-1 then writeln('no') else writeln(ds[rr]); end; end; end; end; //readln; readln; readln; end.
Bình luận