fork download
copy 
  1. program casino; 
  2. Uses sysutils;
  3. {$H+}
  4. const lung=1000000;
  5. type elenco=array[0..lung-1] of int64;
  6. var  N,M,w,t,q,coppie,index:Int64;
  7.      S,S_ruotate:array[0..lung] of AnsiString;
  8.      funz_errore: array[0..100000] of Int64;
  9.      H, accoppiata:elenco;
  10.  
  11. function LexicalMinRotation(var x: AnsiString):Int64;
  12. var 
  13. len,K,i,j:Int64;
  14.  
  15. begin
  16.    x:=x+x; 
  17.    len:=length(x); 
  18.    for i:=0 to len do funz_errore[i]:=-1; 
  19.    K:=1; 
  20.    for j:=2 to len do   
  21.            begin
  22.              i:= funz_errore[j-k-1];
  23.              while (i <> -1 ) and (x[j] <> x[(k + i+1 )]) do   
  24.                             begin
  25.                               if x[j] < x[(k + i+1 )] then k:= j - i - 1;
  26.                               i:=funz_errore[i];               
  27.                             end;                           
  28.             if (i = -1) and (x[j] <> x[(k + i+1 )]) then
  29.                                                        begin
  30.                                                           if x[j] < x[(k + i+1 )] then k:= j;
  31.                                                           funz_errore[j - k]:= -1;
  32.                                                        end           
  33.                                                     else   funz_errore[j - k]:= i + 1;
  34.  
  35.          end;   
  36.  LexicalMinRotation:=k; 
  37.  
  38. end;
  39.  
  40. function Rabin (var x: Ansistring) :int64;
  41. var len, i, R,base,d:int64;
  42. begin
  43.    d:=1; R:=0; len:=length(x); base:=29; 
  44.    for i := 1  to len-1 do  d := (d * base) mod q ;
  45.    for i := 1 to len do  R:=  (base*R+ord(x[i])) mod q;  
  46.    Rabin:= R; 
  47. end; 
  48.  
  49. Procedure scambia (var a,b: int64);
  50. var x:int64;
  51. begin
  52.    x:=a;
  53.    a:=b;
  54.    b:=x;
  55. end;  
  56. Procedure ordinamento (estremoi,estremos: int64; var v : elenco; ordinato:boolean);
  57. var inf, sup, medio:int64;
  58.     pivot :int64;
  59. begin
  60.     inf:=estremoi;
  61.     sup:=estremos;
  62.     medio:= (estremoi+estremos) div 2;
  63.     pivot:=v[medio];
  64.     repeat
  65.       if (ordinato) then
  66.          begin
  67.             while (v[inf]<pivot) do  inf:=inf+1;
  68.             while (v[sup]>pivot) do  sup:=sup-1;
  69.          end;
  70.       if inf<=sup then
  71.        begin
  72.          scambia(v[inf],v[sup]);
  73.          inf:=inf+1;
  74.          sup:=sup-1;
  75.        end;
  76.     until inf>sup;
  77.     if (estremoi<sup) then ordinamento(estremoi,sup,v,ordinato);
  78.     if (inf<estremos) then ordinamento(inf,estremos,v,ordinato);
  79. end;    
  80.  
  81. begin
  82.    (*assign(input, 'input.txt'); reset(input);
  83.    assign(output, 'output.txt'); rewrite(output);*)
  84.    readln (N,M);
  85.    for w:=0 to N-1 do begin readln(S[w]);  S[w]:=Trim(S[w]); H[w]:=0;  accoppiata[w]:=0;end;
  86.    coppie:=0;  q:=101;
  87.   for w:=0 to N-1 do
  88.           begin
  89.             index:=LexicalMinRotation(S[w]);
  90.             S_ruotate[w]:=copy(S[w],index,M);
  91.             H[w]:=Rabin(S_ruotate[w]);
  92.           end;  
  93.    ordinamento(0,N-1,H,true);  
  94.    t:=0;
  95.    for w:=0 to N-1 do  
  96.                   begin
  97.                       if H[w]=H[w+1] then  accoppiata[t]:=accoppiata[t]+1
  98.                                      else t:=t+1;
  99.  
  100.                  end;
  101.  
  102.     for w:=0 to t-1 do 
  103.                begin
  104.                   if accoppiata[w] =1 then coppie:=coppie+1
  105.                                        else if accoppiata[w]>1 then coppie:=coppie+((accoppiata[w]+1)*(accoppiata[w]) div 2);
  106.                end;
  107.     writeln (coppie);
  108. end.
Success #stdin #stdout 0.02s 6716KB
comments (?)
stdin
copy 
3 6
adaada
aaadda
aadaad
stdout
copy 
1
https://ideone.com/3KPOKL
language:
Pascal (fpc 3.0.4)
created:
1 day ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!