MCHAOS - Chaos Strings

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      maxn=100000;
type ansistring=string;
     ar=array[1..maxn] of ansistring;
var n:longint; re:int64;
    a:ar;
    s,p,d,q:array[1..maxn] of longint;

procedure rf;
var i,l,j:longint;
begin
     assign(input,fi); reset(input);
     readln(n);
     for i:=1 to n do
     begin
          readln(a[i]);
          p[i]:=i; q[i]:=i;
     end;
     close(input);
end;

function comp(var y,x:ansistring):longint;
var i,min:longint;
begin
     if length(y)<length(x) then min:=length(y) else min:=length(x);
     for i:=1 to min do
         if y[i]<x[i] then
         begin
              comp:=-1; exit;
         end
         else
         begin
              if y[i]>x[i] then
              begin
                   comp:=1; exit;
              end;
         end;
     if length(y)<length(x) then comp:=-1
     else
     begin
          if length(y)>length(x) then comp:=1
          else comp:=0;
     end;
end;

function com(var y,x:ansistring):longint;
var i,min,lx,ly:longint;
begin
     lx:=length(x); ly:=length(y);
     min:=(lx+ly-abs(lx-ly)) shr 1;
     for i:=0 to min-1 do
         if y[ly-i]<x[lx-i] then
         begin
              com:=-1; exit;
         end
         else
         begin
              if y[ly-i]>x[lx-i] then
              begin
                   com:=1; exit;
              end;
         end;
     if ly<lx then com:=-1
     else
     begin
          if ly>lx then com:=1
          else com:=0;
     end;
end;

procedure sort(l,r:longint);
var i,j,y:longint; x,t:ansistring;
begin
     i:=l; j:=r; x:=a[q[(i+j) shr 1]];
     repeat
           while comp(a[q[i]],x)=-1 do i:=i+1;
           while comp(a[q[j]],x)=1 do j:=j-1;
           if i<=j then
           begin
                y:=q[i]; q[i]:=q[j]; q[j]:=y;
                i:=i+1; j:=j-1;
           end;
     until i>j;
     if i<r then sort(i,r);
     if l<j then sort(l,j);
end;

procedure sort1(l,r:longint);
var i,j,y:longint; x,t:ansistring;
begin
     i:=l; j:=r; x:=a[p[(i+j) shr 1]];
     repeat
           while com(a[p[i]],x)=-1 do i:=i+1;
           while com(a[p[j]],x)=1 do j:=j-1;
           if i<=j then
           begin
                y:=p[i]; p[i]:=p[j]; p[j]:=y;
                i:=i+1; j:=j-1;
           end;
     until i>j;
     if i<r then sort1(i,r);
     if l<j then sort1(l,j);
end;

procedure add(i:longint);
begin
     while i<=n do
     begin
          s[i]:=s[i]+1;
          i:=i+i and (-i);
     end;
end;

function calc(i:longint):longint;
var r:longint;
begin
     r:=0;
     while i>0 do
     begin
          r:=r+s[i];
          i:=i-i and (-i);
     end;
     calc:=r;
end;

procedure pr;
var i,j,l:longint; t:char;
begin
     sort(1,n);
     sort1(1,n);
     for i:=1 to n do d[p[i]]:=i;
     re:=0;
     for i:=1 to n do
     begin
          add(d[q[i]]);
          re:=re+i-calc(d[q[i]]);
     end;
end;

procedure wf;
begin
     assign(output,fo); rewrite(output);
     writeln(re);
     close(output);
end;

begin
     rf;
     pr;
     wf;
end.

Download