head

Algorithm::LCS - Implementation of the longest common subsequence algorithm


code

=begin code :lang<raku>

use Algorithm::LCS;

# regular usage
say lcs(<A B C D E F G>, <A C F H J>); # prints T<A C F>

# custom comparator via :compare
say lcs(<A B C>, <D C F>, :compare(&infix:<eq>));

# extra special custom comparison via :compare-i
my @a        = slurp('one.txt');
my @b        = slurp('two.txt');
my @a-hashed = @a.map({ hash-algorithm($_) });
my @b-hashed = @b.map({ hash-algorithm($_) });
say lcs(@a, @b, :compare-i({ @a-hashed[$^i] eqv @b-hashed[$^j] }));

=end code


This module contains a single subroutine, C<lcs>, that calculates
the longest common subsequence between two sequences of data.  C<lcs>
takes two lists as required parameters; you may also specify the comparison
function (which defaults to C<eqv>) via the C<&compare> named parameter).


Sometimes you may want to maintain a parallel array of information to
consult during calculation (for example, if you're comparing long lines
of a file, and you'd like a speedup by comparing their hashes rather than
their contents); for that, you may use the C<&compare-i> named argumeny



my sub strip-prefix(@a, @b, &compare-i) {
    my $i = 0;
    my @prefix;

    while $i < (@a & @b) && &compare-i($i, $i) {
        @prefix.push: @a[$i++];
    }

    @prefix
}

my sub strip-suffix(@a, @b, &compare-i) {
    # XXX could be optimized, but this is easy for now
    strip-prefix(@a.reverse, @b.reverse, -> $i, $j {
        &compare-i(@a.end - $i, @b.end - $j)
    }).reverse
}

my sub build-lcs-matrix(@a, @b, &compare-i) {
    my @matrix  = 0 xx ((@a + 1) * (@b + 1));
    my $row-len = @a + 1;

    for 1 .. @b X 1 .. @a -> ($row, $offset) {
        my $index = $row * $row-len + $offset;

        if &compare-i($offset - 1, $row - 1) {
            @matrix[$index] = @matrix[$index - $row-len - 1] + 1;
        } else {
            @matrix[$index] = [max] @matrix[ $index - $row-len, $index - 1 ];
        }
    }

    @matrix
}

#| Returns the longest common subsequence of two sequences of data.
my sub lcs(
    @a,                     #= The first sequence
    @b,                     #= The second sequence
    :&compare=&infix:<eqv>, #= The comparison function (defaults to C<eqv>)
    :&compare-i is copy     #= The compare-by-index function (defaults to using &compare)
) is export {
    unless &compare-i.defined {
        &compare-i = -> $i, $j {
            &compare(@a[$i], @b[$j])
        };
    }

    my @prefix = strip-prefix(@a, @b, &compare-i);
    my @suffix = strip-suffix(@a[+@prefix .. *], @b[+@prefix .. *], -> $i, $j {
        &compare-i($i + @prefix, $j + @prefix)
    });
    my @a-middle = @a[+@prefix .. @a.end - @suffix];
    my @b-middle = @b[+@prefix .. @b.end - @suffix];

    if @a-middle && @b-middle {
        my @matrix = build-lcs-matrix(@a-middle, @b-middle, -> $i, $j {
            &compare-i($i + @prefix, $j + @prefix)
        });

        my $matrix-row-len = @a-middle + 1;
        my $i = @matrix.end;

        my @result := gather while $i > 0 && @matrix[$i] > 0 {
            my $current-length  = @matrix[$i];
            my $next-row-length = @matrix[$i - $matrix-row-len];
            my $next-col-length = @matrix[$i - 1];

            if $current-length > $next-row-length && $next-row-length == $next-col-length {
                take @b-middle[$i div $matrix-row-len - 1];
                $i -= $matrix-row-len + 1;
            }
            elsif $next-row-length < $next-col-length {
                $i--;
            }
            elsif $next-col-length <= $next-row-length {
                $i -= $matrix-row-len;
            }
            else {
                die "this should never be reached!";
            }
        }.list;

        ( @prefix, @result.reverse, @suffix ).flat
    }
    else {
        ( @prefix, @suffix ).flat
    }
}



L<Wikipedia article|http://en.wikipedia.org/wiki/Longest_common_subsequence_problem>


item

This library is free software; you can redistribute it and/or modify it under the MIT license.


root

README

React

=begin React :component<HeaderCol> :id<menu> 
=para L<Documentation|/doc/introduction>
=para L<Modules| /mods>
=para L<Examples| file:../examples/index.podlite>
=para L<Download |file:../download/index.podlite>
=para L<About|file:../about/index.podlite>
=para 🔍 K<⌘K>/K<ctrl-K>
=end React


=begin React :component<HeaderCol> :id<footer>  
=begin nested :!nested
=item1 B<Language>
    =item2 L<Get started|file:../getting-started/getting-started.podlite>
    =item2 L<Why Raku?|/doc/language/faq#Why-should-I-learn-Raku-What's-so-great-about-it>
    =item2 L<Try Raku|https://glot.io/new/raku>
    =item2 L<Raku cheat sheet|https://github.com/Raku/mu/blob/master/docs/Perl6/Cheatsheet/cheatsheet.txt>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<Raku on Exercism|https://exercism.org/tracks/raku>
    =item2 L<Wikipedia|https://en.wikipedia.org/wiki/Raku_(programming_language)>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=begin nested :!nested

=item1 B<L<Documentation|/doc>>
    =item2 L<Getting started, Migration guides from other languages, & Tutorials | file:../doc/introduction.podlite>
    =item2 L<Language References|file:../doc/reference.podlite>
    =item2 L<Type Reference| file:../doc/types.podlite>
    =item2 L<Miscellaneous| file:../doc/miscellaneous.podlite>
    =item2 L<FAQs (Frequently Asked Questions)|/doc/language/faq>
    =item2 L<Community|/doc/language/community>
    =item2 L<The list of all documents|file:../doc/index.podlite>

=item1 B<Resources>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>

=end nested
=begin nested :!nested

=item1 B<Resoures>
    =item2 L<Download | file:../download/index.podlite>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=item1 B<Learning>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Wikibook |https://en.wikibooks.org/wiki/Raku_Programming>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>
    =item2 L<Learn Raku in Y minutes|https://learnxinyminutes.com/docs/raku/>
    =item2 L<Golfing |https://github.com/AlexDaniel/raku-golf-cheatsheet>
=end nested
=begin nested :!nested

=item1 B<Explore>
    =item2 L<Raku Blog Aggregator|https://planet.raku.org/>
    =item2 L<Rakudo Weekly|https://rakudoweekly.blog/>
    =item2 L<The Weekly Challenge |https://perlweeklychallenge.org/>
    =item2 L<Raku Advent Calendar|https://raku-advent.blog/>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=end React


=begin React :component<CookieConsent> :id<CookieConsent> :buttonCaption("Got it!")
=para
This website uses cookies for analytics.
=end React


LCS

NAME

SYNOPSIS

DESCRIPTION

SUBROUTINES

SEE ALSO

AUTHORS

COPYRIGHT AND LICENSE

Algorithm::LCS v0.1.1

Authors

License

Dependencies

Test Dependencies

Provides

Documentation