fork download
copy 
  1. program casino; (*con Algoritmo di Booth*)
  2. Uses sysutils;
  3. {$H+}
  4. const lung=1000000;
  5. type elenco=array[0..lung-1] of int64;
  6. var  N,M,C,w,v,t,coppie,index:Int64;
  7.      S,S_ruotate:array[0..lung] of AnsiString;
  8.      funz_errore: array[0..2000000] 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; (*concatenare la stringa con se stessa*)
  17.    len:=length(x); 
  18.    for i:=0 to len do funz_errore[i]:=-1; (*inizializzare il vettore, di dimensione doppia della lunghezza della stringa,chiamato funzione_errore a -1*)
  19.    K:=1; (*indice che corrisponde al candidato corrente alla rotazione più piccola. Ricordare che le Ansistring iniziano da 1*)
  20.    for j:=2 to len do   (*confronta il carattere in j con il carattere in K+funz_errore[k]*)
  21.            begin
  22.              i:= funz_errore[j-k-1];
  23.              while (i <> -1 ) and (x[j] <> x[(k + i+1 )]) do   (*Se c'è una discrepanza aggiorna il valore di k*)
  24.                             begin
  25.                               if x[j] < x[(k + i+1 )] then k:= j - i - 1;
  26.                               i:=funz_errore[i];               (*modificare la funzione errore in base al confronto effettuato *)
  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; (*dopo aver completato il processo k indica indice della rotazione minima*)
  37.  
  38. end;
  39.  
  40. function Rabin (var x: Ansistring) :int64;
  41. var len, i,j, R,h,d, q:int64;
  42. begin
  43.    h:=1; R:=0; len:=length(x); q:=MaxInt; d:=256;
  44.    for i := 1  to len do  h := (h * d) mod q;
  45.    for i := 1 to len do  R:= (d * 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;  
  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.   for w:=0 to N-1 do  
  95.                   begin
  96.                     t:=0;
  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 6712KB
comments (?)
stdin
copy 
4 4
abcd
xbcd
cdab
dabc
stdout
copy 
3
https://ideone.com/vxuoCr
language:
Pascal (fpc 3.0.4)
created:
10 hours 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!