Shortest common supersequence: Difference between revisions
Content added Content deleted
(mention of non-uniqueness of the solution) |
No edit summary |
||
Line 67: | Line 67: | ||
SCS(abcbdab, bdcaba) -> abdcabdab |
SCS(abcbdab, bdcaba) -> abdcabdab |
||
</pre> |
</pre> |
||
=={{header|Perl}}== |
|||
<lang perl>sub lcs { # longest common subsequence |
|||
my( $u, $v ) = @_; |
|||
return '' unless length($u) and length($v); |
|||
my $longest = ''; |
|||
for my $first ( 0..length($u)-2 ) { |
|||
my $char = substr $u, $first, 1; |
|||
my $i = index( $v, $char ); |
|||
next if -1==$i; |
|||
my $next = $char; |
|||
$next .= lcs( substr( $u, $first+1), substr( $v, $i+1 ) ) unless $i==length($v)-1; |
|||
$longest = $next if length($next) > length($longest); |
|||
} |
|||
return $longest; |
|||
} |
|||
sub scs { # shortest common supersequence |
|||
my( $u, $v ) = @_; |
|||
my @lcs = split //, lcs $u, $v; |
|||
my $pat = "(.*)".join("(.*)",@lcs)."(.*)"; |
|||
my @u = $u =~ /$pat/; |
|||
my @v = $v =~ /$pat/; |
|||
my $scs = shift(@u).shift(@v); |
|||
$scs .= $_.shift(@u).shift(@v) for @lcs; |
|||
return $scs; |
|||
} |
|||
my $u = "abcbdab"; |
|||
my $v = "bdcaba"; |
|||
printf "Strings %s %s\n", $u, $v; |
|||
printf "Longest common subsequence: %s\n", lcs $u, $v; |
|||
printf "Shortest common supersquence: %s\n", scs $u, $v; |
|||
</lang> |
|||
{{out}} |
|||
<pre>Strings abcbdab bdcaba |
|||
Longest common subsequence: bcba |
|||
Shortest common supersquence: abdcabdab |
|||
</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
This example uses either of the <code>lcs</code> implementations from [[longest common subsequence#Tcl|here]], assumed renamed to <tt>lcs</tt>… |
This example uses either of the <code>lcs</code> implementations from [[longest common subsequence#Tcl|here]], assumed renamed to <tt>lcs</tt>… |