MCHAOS - Chaos Strings
Tác giả: RR
Ngôn ngữ: Pascal
//Written by RR
{$R-,Q-}
{$Mode objFPC}
{$inline on}
uses math;
const
FINP = '';
FOUT = '';
MAXN = 100111;
type
st = string[11];
var
f1,f2 : text;
n : longint;
x,y : array[1..MAXN] of st;
bit,b,ind : array[1..MAXN] of longint;
procedure openF;
begin
assign(f1,FINP); reset(f1);
assign(f2,FOUT); rewrite(f2);
end;
procedure closeF;
begin
close(f1);
close(f2);
end;
procedure swap(var a,b:longint); inline;
var
temp:longint;
begin
temp:=a; a:=b; b:=temp;
end;
procedure swaps(var a,b:st); inline;
var
temp:st;
begin
temp:=a; a:=b; b:=temp;
end;
procedure inp;
var
i:longint;
begin
readln(f1,n);
for i:=1 to n do
readln(f1,x[i]);
end;
procedure sort1(l,r:longint); inline;
var
i,j:longint;
mid:st;
begin
i:=l; j:=r; mid:=x[l+random(r-l+1)];
repeat
while x[i]<mid do inc(i);
while x[j]>mid do dec(j);
if i<=j then
begin
if i<j then swaps(x[i],x[j]);
inc(i); dec(j);
end;
until i>j;
if i<r then sort1(i,r);
if l<j then sort1(l,j);
end;
procedure sort2(l,r:longint); inline;
var
i,j:longint;
mid:st;
begin
i:=l; j:=r; mid:=y[ind[l+random(r-l+1)]];
repeat
while (y[ind[i]]<mid) do inc(i);
while (y[ind[j]]>mid) do dec(j);
if i<=j then
begin
if i<j then swap(ind[i],ind[j]);
inc(i); dec(j);
end;
until i>j;
if i<r then sort2(i,r);
if l<j then sort2(l,j);
end;
procedure reverse(var a,kq:st);
var
i:longint;
begin
for i:=length(a) downto 1 do
kq:=kq+a[i];
end;
function get(u:longint):longint; inline;
var
v:longint;
begin
if u<=0 then exit(0);
v:=u-u and (-u);
exit(bit[u]+get(v));
end;
procedure update(u:longint); inline;
var
v:longint;
begin
inc(bit[u]);
v:=u+u and (-u);
if v<=n then update(v);
end;
procedure solve;
var
i:longint;
res:int64;
begin
for i:=1 to n do
reverse(x[i],y[i]);
for i:=1 to n do ind[i]:=i;
sort2(1,n);
for i:=1 to n do
b[ind[i]]:=i;
res:=0;
for i:=1 to n do
begin
res:=res+i-1-get(b[i]);
update(b[i]);
end;
writeln(f2,res);
end;
begin
openF;
inp;
sort1(1,n);
solve;
closeF;
end.