Cod sursa(job #930494)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 27 martie 2013 17:58:54
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.88 kb
var a,b,x:array[0..1024] of byte;
    i,j,n,nx,m:integer;
    f,g:text;
    lung:array[0..1024,0..1024] of integer;
begin
 assign(f,'subsir.in');reset(f);
 assign(g,'subsir.out');rewrite(g);
 n:=0;
 while not eoln(f) do begin inc(n);read(f,a[n]);end;
 readln(f);
 m:=0;
 while not eoln(f) do begin inc(m);read(f,b[m]);end;
 if a[1]=b[1] then lung[1,1]:=1
              else lung[1,1]:=0;
 for i:=2 to n do
  if a[i]=b[1] then lung[i,1]:=1
               else lung[i,1]:=lung[i-1,1];
 for j:=2 to m do
  if a[1]=b[j] then lung[1,j]:=1
               else lung[1,j]:=lung[1,j-1];
 for i:=2 to n do
  for j:=2 to m do
   if a[i]=b[j] then lung[i,j]:=lung[i-1,j-1] +1
                else if lung[i-1,j]>lung[i,j-1] then lung[i,j]:=lung[i-1,j]
                                                else lung[i,j]:=lung[i,j-1];
 writeln(g,lung[n,m]);
 close(f);
 close(g);
end.