program LCS_FreePascal;
{$mode objfpc}{$H+}{$J-}
{
This program computes BOTH:
1. The length of the Longest Common Subsequence (LCS)
2. The actual LCS subsequence
It uses an efficient dynamic‑programming algorithm:
Time: O(n * m)
Space: O(n * m)
dp[i][j] stores the LCS length between:
s1[1..i] and s2[1..j]
Recurrence:
If characters match:
dp[i][j] := dp[i-1][j-1] + 1
Else:
dp[i][j] := Max(dp[i-1][j], dp[i][j-1])
After filling the DP table, we reconstruct the LCS by
walking backwards from dp[n][m].
}
type
TIntArray2D = array of array of Integer;
{ Custom Max function to avoid Math unit issues }
function MyMax(a, b: Integer): Integer;
begin
if a > b then
Result := a
else
Result := b;
end;
function LCS(const s1, s2: string; out subseq: string): Integer;
var
n, m: Integer;
dp: TIntArray2D;
i, j, idx: Integer;
begin
n := Length(s1);
m := Length(s2);
SetLength(dp, n + 1, m + 1);
{ Fill DP table }
for i := 1 to n do
for j := 1 to m do
begin
if s1[i] = s2[j] then
dp[i][j] := dp[i - 1][j - 1] + 1
else
dp[i][j] := MyMax(dp[i - 1][j], dp[i][j - 1]);
end;
Result := dp[n][m];
{ Prepare the output string directly }
SetLength(subseq, Result);
idx := Result;
i := n;
j := m;
{ Reconstruct LCS }
while (i > 0) and (j > 0) do
begin
if s1[i] = s2[j] then
begin
{ AnsiStrings are 1-indexed, so idx matches perfectly }
subseq[idx] := s1[i];
Dec(idx);
Dec(i);
Dec(j);
end
else if dp[i - 1][j] > dp[i][j - 1] then
Dec(i)
else
Dec(j);
end;
end;
var
s1, s2: string;
lengthLCS: Integer;
sequence: string;
begin
s1 := 'AGGTAB';
s2 := 'GXTXAYB';
lengthLCS := LCS(s1, s2, sequence);
WriteLn('String 1: ', s1);
WriteLn('String 2: ', s2);
WriteLn('Length of LCS: ', lengthLCS);
WriteLn('LCS sequence: ', sequence);
end.
{
run:
String 1: AGGTAB
String 2: GXTXAYB
Length of LCS: 4
LCS sequence: GTAB
}