Cod sursa(job #1023512)

Utilizator TheTigerHadade Andrey TheTiger Data 7 noiembrie 2013 08:49:58
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.86 kb
const p=666013;
var a,b,aux,x:string;k,max,i,j,l,h:integer;f,g:text;c:array[1..100]of string;
begin
assign(f,'subsir.in');reset(f);
assign(g,'subsir.out');rewrite(g);
readln(f,a);
readln(f,b);max:=0;h:=0;l:=0;
if length(a)>length(b) then begin aux:=a;a:=b;b:=aux;end;
for i:=1 to length(a) do begin    k:=0;x:='';
for j:=i to length(a) do begin
x:=x+a[j];
if pos(x,b)>0 then begin k:=k+1;if k>max then max:=k;end
              else begin k:=0;break;end;
end;end;
for i:=1 to length(a) do begin    k:=0;x:='';
for j:=i to length(a) do begin
x:=x+a[j];
if pos(x,b)>0 then begin k:=k+1;if k=max then begin h:=h+1;c[h]:=x;k:=0;end;end
              else begin k:=0;break;end;
end;end;
for i:=1 to h-1 do
for j:=i+1 to h do
if c[i]>c[j] then begin aux:=c[i];c[i]:=c[j];c[j]:=aux;end;
for i:=1 to h do
if c[i]<>c[i+1] then l:=l+1;
write(g,l mod p); close(g);
end.