Cod sursa(job #136773)
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.