Cod sursa(job #136773)

Utilizator philandrewChindea Filip philandrew Data 15 februarie 2008 22:02:58
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.24 kb
var f : text;
    len1, len2, i, j : integer;
    v1, v2 : Array[1..500] of char;
    dyn  : Array[0..500, 0..500] of integer;
    dyns : Array[0..500, 0..500] of boolean;

function lcs(l1, l2 : integer) : integer;
var rv, t1, t2 : integer;
begin
  if (l1 = 0) or (l2 = 0) then
    rv := 0
  else
    if (v1[l1] = v2[l2]) then
      if dyns[l1 - 1, l2 - 1] then
        rv := dyn[l1 - 1, l2 - 1] + 1
      else
        rv := lcs(l1 - 1, l2 - 1) + 1
    else
    begin
      if dyns[l1 - 1, l2] then
        t1 := dyn[l1 - 1, l2]
      else
        t1 := lcs(l1 - 1, l2);
      if dyns[l1, l2 - 1] then
        t2 := dyn[l1, l2 - 1]
      else
        t2 := lcs(l1, l2 - 1);
      rv := (t1 + t2 + abs(t1 - t2)) div 2;
    end;
  dyns[l1, l2] := true;
  dyn[l1, l2] := rv;
  lcs := rv;
end;

begin
  for i := 0 to 50 do
    for j := 0 to 50 do
      dyns[i, j] := false;
  assign(f, 'subsir.in');
  reset(f);
  len1 := 0;
  while not eoln(f) do
  begin
    len1 := len1 + 1;
    read(f, v1[len1]);
  end;
  readln(f);
  len2 := 0;
  while not eoln(f) do
  begin
    len2 := len2 + 1;
    read(f, v2[len2]);
  end;
  close(f);
  assign(f, 'subsir.out');
  rewrite(f);
  writeln(f, lcs(len1, len2));
  close(f);
end.