Cod sursa(job #14774)

Utilizator floringh06Florin Ghesu floringh06 Data 9 februarie 2007 18:57:36
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.51 kb

type as=ansistring;
var fi,fo:text;
    i,j,m,max,n,sub,jmax,imax:integer;
    opt:array[0..500,0..500] of integer;
    s1,s2:as;


  procedure solve;
   var i,j,k:integer;
    begin
     for i:=1 to length(s1) do
      for j:=1 to length(s2) do
       if s1[i]=s2[j] then opt[i,j]:=opt[i-1,j-1]+1
          else
           begin
             max:=opt[1,j];
             for k:=2 to i-1 do
              if opt[k,j]>max then max:=opt[k,j];
             for k:=1 to j-1 do
              if opt[i,k]>max then max:=opt[i,k];
             opt[i,j]:=max;
           end;
     end;

  procedure search;
    var i,j:integer;
     begin
      sub:=0;
      max:=opt[length(s1),length(s2)];
      for i:=1 to length(s1) do
        if opt[i,length(s2)]=max then break;
      imax:=i-1;
      for j:=1 to length(s2) do
        if opt[length(s1),j]=max then break;
      jmax:=j-1;
      for i:=length(s1) downto imax do
       for j:=length(s2) downto jmax do
         begin
          if opt[i,j]=max then
           if (opt[i-1,j-1]=max-1) and (opt[i-1,j]=max-1) and (opt[i,j-1]=max-1) then
                  inc(sub);
         end;
     end;

begin
 assign(fi,'subsir.in'); reset(fi);
 assign(fo,'subsir.out'); rewrite(fo);
 readln(fi,s1);
 readln(fi,s2);
 solve;
{ for i:=1 to length(s1) do
 begin
  for j:=1 to length(s2) do
   write(fo,opt[i,j],' ');
  writeln(fo);
 end;}
 search;
{ writeln(fo,imax);
 writeln(fo,jmax);   }
{ writeln(fo,max);}
 writeln(fo,sub);
close(fi);
close(fo);
end.