#!/usr/bin/perl ## LONGEST COMMON SUBSTRINGs (LCS): use warnings; use strict; sub lc_substr { my ($str1, $str2) = @_; my $l_length = 0; # length of longest common substring my $len1 = length $str1; my $len2 = length $str2; my @char1 = (undef, split(//, $str1)); # $str1 as array of chars, indexed from 1 my @char2 = (undef, split(//, $str2)); # $str2 as array of chars, indexed from 1 my @lc_suffix; # "longest common suffix" table my @substrings; # list of common substrings of length $l_length for my $n1 ( 1 .. $len1 ) { for my $n2 ( 1 .. $len2 ) { if ($char1[$n1] eq $char2[$n2]) { # We have found a matching character. Is this the first matching character, or a # continuation of previous matching characters? If the former, then the length of # the previous matching portion is undefined; set to zero. $lc_suffix[$n1-1][$n2-1] ||= 0; # In either case, declare the match to be one character longer than the match of # characters preceding this character. $lc_suffix[$n1][$n2] = $lc_suffix[$n1-1][$n2-1] + 1; # If the resulting substring is longer than our previously recorded max length ... if ($lc_suffix[$n1][$n2] > $l_length) { # ... we record its length as our new max length ... $l_length = $lc_suffix[$n1][$n2]; # ... and clear our result list of shorter substrings. @substrings = (); } # If this substring is equal to our longest ... if ($lc_suffix[$n1][$n2] == $l_length) { # ... add it to our list of solutions. push @substrings, substr($str1, ($n1-$l_length), $l_length); } } } } return @substrings; } my @result1=lc_substr qw(ABABC BABCA ABCBA); my $result1=join('',@result1); my $leng1=length($result1); print"\n The longest common substring :\n"; print "\n@result1: Length=$leng1 letters\n"; print"\n Other common substrings in order of decreasing lengths are:\n"; my @result2="?"; #### The longest common substring : BABC: Length=4 letters Other common substrings in order of decreasing lengths are:?? #### The longest common substring : ABC; Length=3 Other common substrings in order of decreasing lengths are: AB: Length=2 BC: Length=2 BA: Length=2 #### #!/usr/bin/perl ## LONGEST COMMON SUBSTRINGS (sorted) from a set of given sequences: use strict; use warnings; sub LCS { # Line 5 my ($ctx, $a, $b) = @_; my ($amin, $amax, $bmin, $bmax) = (0, $#$a, 0, $#$b); while ($amin <= $amax and $bmin <= $bmax and $a->[$amin] eq $b->[$bmin]) { $amin++; $bmin++; } while ($amin <= $amax and $bmin <= $bmax and $a->[$amax] eq $b->[$bmax]) { $amax--; $bmax--; } # Line 15 my $h = $ctx->line_map(@$b[$bmin..$bmax]); # line numbers are off by $bmin return $amin + _core_loop($ctx, $a, $amin, $amax, $h) + ($#$a - $amax) unless wantarray; my @lcs = _core_loop($ctx,$a,$amin,$amax,$h); if ($bmin > 0) { # Line 20 $_->[1] += $bmin for @lcs; # correct line numbers } map([$_ => $_], 0 .. ($amin-1)), @lcs, map([$_ => ++$bmax], ($amax+1) .. $#$a); } sub a { my $match = CSS(@_); # line 28 if ( ref $_[0] eq 'ARRAY' ) { @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,scalar(@$_)]}@$match } else { # Line 32 @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,length($_)]}@$match } return $match; } ## Data Input & Results: # Line 37 print"\nThe longest common substrings in decreasing order of lengths:\n"; my $result1=a qw(ABABC BABCA ABCBA); my $leng1=$result1; # Line 40 print"\n$result1; Length=$leng1\n\n"; exit; #### Microsoft Windows [Version 6.1.7600] Copyright (c) 2009 Microsoft Corporation. All rights reserved. C:\Users\x>cd desktop C:\Users\x\Desktop>try1.pl The longest common substrings in decreasing order of lengths: Undefined subroutine &main::CSS called at C:\Users\DR-SUPRIYO\Desktop\try1.pl line 28. C:\Users\x\Desktop>