Cod sursa(job #121656)

Utilizator mlazariLazari Mihai mlazari Data 9 ianuarie 2008 12:44:54
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.84 kb
Program Subsir;
var a,b : array[1..501] of char;
    la,lb,nmax,ns,rez : integer;
    max : array[1..500] of integer;
    s : array[1..500] of integer;

procedure Citeste;
var Intrare : text;
begin
  assign(Intrare,'subsir.in');
  reset(Intrare);
  la:=0;
  lb:=0;
  while not eoln(Intrare) do
   begin
     la:=la+1;
     read(Intrare,a[la]);
   end;
  readln(Intrare);
  while not eoln(Intrare) do
   begin
     lb:=lb+1;
     read(Intrare,b[lb]);
   end;
  close(Intrare);
end;

function Comun(ia,ib : integer) : integer;
var c : integer;
begin
  c:=0;
  while (ia<=la) and (ib<=lb) and (a[ia]=b[ib]) do
   begin
     c:=c+1;
     ia:=ia+1;
     ib:=ib+1;
   end;
  Comun:=c;
end;

procedure DetMax(id : integer);
var c,i : integer;
begin
  max[id]:=0;
  for i:=1 to lb do
   begin
     c:=Comun(id,i);
     if c>max[id] then max[id]:=c;
   end;
end;

function diferit(i1,i2 : integer) : boolean;
var dif : boolean;
    i : integer;
begin
  dif:=false;
  for i:=0 to nmax-1 do
   begin
     dif:=a[i1+i]<>a[i2+i];
     if dif then break;
   end;
  diferit:=dif;
end;

function absent(id : integer) : boolean;
var i : integer;
    ab : boolean;
begin
  ab:=true;
  for i:=1 to ns do
   begin
     ab:=diferit(id,s[i]);
     if not ab then break;
   end;
  absent:=ab;
end;

procedure Calculeaza;
var i : integer;
begin
  nmax:=0;
  for i:=1 to la do
   begin
     DetMax(i);
     if max[i]>nmax then nmax:=max[i];
   end;
  rez:=0;
  ns:=0;
  for i:=1 to la-nmax+1 do
   if max[i]=nmax then
    if absent(i) then
     begin
       ns:=ns+1;
       s[ns]:=i;
       rez:=rez+1;
     end;
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'subsir.out');
  rewrite(Iesire);
  write(Iesire,rez);
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.