Treap平衡树（Pascal版）

Posted 2020-07-27

（Based on NOI2002营业额统计 Codevs1296）

 1 const maxn=100050;
 2 var
 3         i,j,k,l,m,n,tot,head,t:longint;ac:int64;
 4         a,lef,rig,fix:array[0..maxn] of longint;
 5 function max(x,y:longint):longint;
 6         begin
 7                 if x>y then max:=x else max:=y;
 8         end;
 9 function min(x,y:longint):longint;
10         begin
11                 if x<y then min:=x else min:=y;
12         end;
13 function newp(x:longint):longint;
14         begin
15                 inc(tot);a[tot]:=x;
16                 lef[tot]:=0;rig[tot]:=0;
17                 fix[tot]:=random(maxlongint);
18                 exit(tot);
19         end;
20 procedure lt(var x:longint);
21         var f,r:longint;
22         begin
23                 f:=x;r:=rig[x];
24                 rig[f]:=lef[r];
25                 lef[r]:=f;
26                 x:=r;
27         end;
28 procedure rt(var x:longint);
29         var f,l:longint;
30         begin
31                 f:=x;l:=lef[x];
32                 lef[f]:=rig[l];
33                 rig[l]:=f;
34                 x:=l;
35         end;
36 procedure ins(var x:longint;y:longint);
37         begin
38                 if x=0 then
39                         begin
40                                 x:=newp(y);
41                                 exit;
42                         end;
43                 if Y<a[x] then
44                         begin
45                                 ins(lef[x],y);
46                                 if fix[lef[x]]<fix[x] then rt(x);
47                         end
48                 else
49                         begin
50                                 ins(rig[x],y);
51                                 if fix[rig[x]]<fix[x] then lt(x);
52                         end;
53         end;
54 function getpre(x,y:longint):longint;
55         var z:longint;
56         begin
57                 if x=0 then exit(0);
58                 if a[x]<=y then
59                         begin
60                                 z:=getpre(rig[x],y);
61                                 if z=0 then exit(x) else
62                                         if a[z]>a[x] then exit(z) else exit(x);
63                         end
64                 else exit(getpre(lef[x],y));
65         end;
66 function getsuc(x,y:longint):longint;
67         var z:longint;
68         begin
69                 if x=0 then exit(0);
70                 if a[x]>=y then
71                         begin
72                                 z:=getsuc(lef[x],y);
73                                 if z=0 then exit(x) else
74                                         if a[z]<a[x] then exit(z) else exit(x);
75                         end
76                 else exit(getsuc(rig[x],y));
77         end;
78 begin
79         readln(n);TOT:=0;head:=0;a[0]:=0;ac:=0;
80         for i:=1 to n do
81                 begin
82                         readln(j);
83                         k:=getpre(head,j);
84                         l:=getsuc(head,j);
85                         if ((k=0) and (l=0)) or ((k<>0) and (l<>0)) then
86                                 t:=min(abs(a[k]-j),abs(a[l]-j))
87                         else if k<>0 then t:=abs(a[k]-j) else t:=abs(a[l]-j);
88                         ac:=ac+t;
89                         ins(head,j);
90                 end;
91         writeln(ac);
92 end.