Welcome to collectivesolver - Programming & Software Q&A with code examples. A website with trusted programming answers. All programs are tested and work.

Contact: aviboots(AT)netvision.net.il

Semrush - keyword research tool

Turn ChatGPT, Claude, Gemini, And CoPilot Into Your Personal Assistant, Business Coach, Content Creator, And More

AFFILIATE MARKETING Your all-in-one performance engine Manage affiliates, creators, and customer referrals in one unified platform—turning every partnership into measurable growth
Secure & Reliable Web Hosting, Free Domain, Free SSL, 1-Click WordPress Install, Expert 24/7 Support

Boost your online presence with premium web hosting and servers

Disclosure: My content contains affiliate links.

42,656 questions

55,396 answers

573 users

How to find the length of the longest common subsequence (LCS) in two strings with Pascal

1 Answer

0 votes
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

}

 



answered Jul 9 by avibootz

Related questions

...