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.

Download