Shortest common supersequence: Difference between revisions
Added FreeBASIC |
|||
Line 339: | Line 339: | ||
<pre> |
<pre> |
||
abdcabdab |
abdcabdab |
||
</pre> |
|||
=={{header|FreeBASIC}}== |
|||
Uses 'LCS' function from [[Longest common subsequence#FreeBASIC]]: |
|||
<syntaxhighlight lang="vbnet">Dim Shared As Double dists(0 To 9999) |
|||
' index into lookup table of Nums |
|||
Function dist(ci As Integer, cj As Integer) As Double |
|||
Return dists(cj*100 + ci) |
|||
End Function |
|||
' energy at s, to be minimized |
|||
Function Ens(path() As Integer) As Double |
|||
Dim As Double d = 0 |
|||
For i As Integer = 0 To Ubound(path) - 1 |
|||
d += dist(path(i), path(i+1)) |
|||
Next |
|||
Return d |
|||
End Function |
|||
' temperature function, decreases to 0 |
|||
Function T(k As Double, kmax As Double, kT As Double) As Double |
|||
Return (1 - k / kmax) * kT |
|||
End Function |
|||
' variation of E, from state s to state s_next |
|||
Function dE(s() As Integer, u As Integer, v As Integer) As Double |
|||
Dim As Integer su = s(u) |
|||
Dim As Integer sv = s(v) |
|||
' old |
|||
Dim As Double a = dist(s(u-1), su) |
|||
Dim As Double b = dist(s(u+1), su) |
|||
Dim As Double c = dist(s(v-1), sv) |
|||
Dim As Double d = dist(s(v+1), sv) |
|||
' new |
|||
Dim As Double na = dist(s(u-1), sv) |
|||
Dim As Double nb = dist(s(u+1), sv) |
|||
Dim As Double nc = dist(s(v-1), su) |
|||
Dim As Double nd = dist(s(v+1), su) |
|||
If v = u+1 Then Return (na + nd) - (a + d) |
|||
If u = v+1 Then Return (nc + nb) - (c + b) |
|||
Return (na + nb + nc + nd) - (a + b + c + d) |
|||
End Function |
|||
' probability to move from s to s_next |
|||
Function P(deltaE As Double, k As Double, kmax As Double, kT As Double) As Double |
|||
Return Exp(-deltaE / T(k, kmax, kT)) |
|||
End Function |
|||
' Simulated annealing |
|||
Sub sa(kmax As Double, kT As Double) |
|||
Dim As Integer s(0 To 100) |
|||
Dim As Integer temp(0 To 98) |
|||
Dim As Integer dirs(0 To 7) = {1, -1, 10, -10, 9, 11, -11, -9} |
|||
Dim As Integer i, k, u, v, cv |
|||
Dim As Double Emin |
|||
For i = 0 To 98 |
|||
temp(i) = i + 1 |
|||
Next |
|||
Randomize Timer |
|||
For i = 0 To 98 |
|||
Swap temp(i), temp(Int(Rnd * 99)) |
|||
Next |
|||
For i = 0 To 98 |
|||
s(i+1) = temp(i) |
|||
Next |
|||
Print "kT = "; kT |
|||
Print "E(s0) "; Ens(s()) |
|||
Print |
|||
Emin = Ens(s()) |
|||
For k = 0 To kmax |
|||
If k Mod (kmax/10) = 0 Then |
|||
Print Using "k: ####### T: #.#### Es: ###.####"; k; T(k, kmax, kT); Ens(s()) |
|||
End If |
|||
u = Int(Rnd * 99) + 1 |
|||
cv = s(u) + dirs(Int(Rnd * 8)) |
|||
If cv <= 0 Or cv >= 100 Then Continue For |
|||
If Abs(dist(s(u), cv)) > 5 Then Continue For |
|||
v = s(cv) |
|||
Dim As Double deltae = dE(s(), u, v) |
|||
If deltae < 0 Or P(deltae, k, kmax, kT) >= Rnd Then |
|||
Swap s(u), s(v) |
|||
Emin = Emin + deltae |
|||
End If |
|||
Next k |
|||
Print |
|||
Print "E(s_final) "; Emin |
|||
Print "Path:" |
|||
For i = 0 To Ubound(s) |
|||
If i > 0 And i Mod 10 = 0 Then Print |
|||
Print Using "####"; s(i); |
|||
Next |
|||
Print |
|||
End Sub |
|||
' distances |
|||
For i As Integer = 0 To 9999 |
|||
Dim As Integer ab = (i \ 100) |
|||
Dim As Integer cd = i Mod 100 |
|||
Dim As Integer a = (ab \ 10) |
|||
Dim As Integer b = ab Mod 10 |
|||
Dim As Integer c = (cd \ 10) |
|||
Dim As Integer d = cd Mod 10 |
|||
dists(i) = Sqr((a-c)^2 + (b-d)^2) |
|||
Next i |
|||
Dim As Double kT = 1, kmax = 1e6 |
|||
sa(kmax, kT) |
|||
Sleep</syntaxhighlight> |
|||
{{out}} |
|||
<pre>kT = 1 |
|||
E(s0) 510.1804163299929 |
|||
k: 0 T: 1.0000 Es: 510.1804 |
|||
k: 100000 T: 0.9000 Es: 195.1253 |
|||
k: 200000 T: 0.8000 Es: 182.4579 |
|||
k: 300000 T: 0.7000 Es: 153.4156 |
|||
k: 400000 T: 0.6000 Es: 150.7938 |
|||
k: 500000 T: 0.5000 Es: 141.6804 |
|||
k: 600000 T: 0.4000 Es: 128.4290 |
|||
k: 700000 T: 0.3000 Es: 123.2713 |
|||
k: 800000 T: 0.2000 Es: 117.4202 |
|||
k: 900000 T: 0.1000 Es: 116.0060 |
|||
k: 1000000 T: 0.0000 Es: 116.0060 |
|||
E(s_final) 116.0060090954848 |
|||
Path: |
|||
0 11 10 20 21 32 22 12 2 3 |
|||
13 14 34 33 23 24 35 25 16 15 |
|||
4 5 6 7 9 8 18 19 29 39 |
|||
49 48 38 28 27 17 26 36 47 37 |
|||
45 46 57 56 55 54 44 43 42 52 |
|||
51 41 31 30 40 50 60 61 83 73 |
|||
63 62 72 71 70 80 90 91 81 82 |
|||
92 93 94 96 97 98 99 89 79 69 |
|||
59 58 68 67 77 87 88 78 76 66 |
|||
65 75 86 95 85 84 74 64 53 1 |
|||
0 |
|||
</pre> |
</pre> |
||
Revision as of 19:36, 27 February 2024
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
The shortest common supersequence is a problem closely related to the longest common subsequence, which you can use as an external function for this task.
- Task
Given two strings and , find the shortest possible sequence , which is the shortest common super-sequence of and where both and are a subsequence of . Defined as such, is not necessarily unique.
Demonstrate this by printing where “abcbdab” and “bdcaba”.
- Also see
11l
F scs(String x, y)
I x.empty
R y
I y.empty
R x
I x[0] == y[0]
R x[0]‘’scs(x[1..], y[1..])
I scs(x, y[1..]).len <= scs(x[1..], y).len
R y[0]‘’scs(x, y[1..])
E
R x[0]‘’scs(x[1..], y)
print(scs(‘abcbdab’, ‘bdcaba’))
- Output:
abdcabdab
Ada
with Ada.Text_IO;
procedure Shortest is
function Scs (Left, Right : in String) return String is
Left_Tail : String renames Left (Left'First + 1 .. Left'Last);
Right_Tail : String renames Right (Right'First + 1 .. Right'Last);
begin
if Left = "" then return Right; end if;
if Right = "" then return Left; end if;
if Left (Left'First) = Right (Right'First) then
return Left (Left'First) & Scs (Left_Tail, Right_Tail);
end if;
declare
S1 : constant String := Scs (Left, Right_Tail);
S2 : constant String := Scs (Left_Tail, Right);
begin
return (if S1'Length <= S2'Length
then Right (Right'First) & S1
else Left (Left'First) & S2);
end;
end Scs;
procedure Exercise (Left, Right : String) is
use Ada.Text_Io;
begin
Put ("scs ( "); Put (Left); Put (" , "); Put (Right); Put ( " ) -> ");
Put (Scs (Left, Right));
New_Line;
end Exercise;
begin
Exercise ("abcbdab", "bdcaba");
Exercise ("WEASELS", "WARDANCE");
end Shortest;
- Output:
scs ( abcbdab , bdcaba ) -> abdcabdab scs ( WEASELS , WARDANCE ) -> WARDEANCSELS
ALGOL 68
BEGIN
PRIO SCS = 1;
# returns the shortest common supersequence of x and y #
OP SCS = ( STRING x, y )STRING:
IF x = "" THEN y
ELIF y = "" THEN x
ELIF x[ LWB x ] = y[ LWB y ]
THEN x[ LWB x ] + ( x[ LWB x + 1 : ] SCS y[ LWB y + 1 : ] )
ELIF STRING x y sub = x SCS y[ LWB y + 1 : ];
STRING x sub y = x[ LWB x + 1 : ] SCS y;
INT x y sub size = ( UPB x y sub - LWB x y sub ) + 1;
INT x sub y size = ( UPB x sub y - LWB x sub y ) + 1;
x y sub size <= x sub y size
THEN y[ LWB y ] + x y sub
ELSE x[ LWB x ] + x sub y
FI # SCS # ;
print( ( "abcbdab" SCS "bdcaba", newline ) )
END
- Output:
abdcabdab
C
The C99 code here isn't all that different from Levenstein distance calculation.
#include <stdio.h>
#include <string.h>
typedef struct link link_t;
struct link {
int len;
char letter;
link_t *next;
};
// Stores a copy of a SCS of x and y in out. Caller needs to make sure out is long enough.
int scs(char *x, char *y, char *out)
{
int lx = strlen(x), ly = strlen(y);
link_t lnk[ly + 1][lx + 1];
for (int i = 0; i < ly; i++)
lnk[i][lx] = (link_t) {ly - i, y[i], &lnk[i + 1][lx]};
for (int j = 0; j < lx; j++)
lnk[ly][j] = (link_t) {lx - j, x[j], &lnk[ly][j + 1]};
lnk[ly][lx] = (link_t) {0};
for (int i = ly; i--; ) {
for (int j = lx; j--; ) {
link_t *lp = &lnk[i][j];
if (y[i] == x[j]) {
lp->next = &lnk[i+1][j+1];
lp->letter = x[j];
} else if (lnk[i][j+1].len < lnk[i+1][j].len) {
lp->next = &lnk[i][j+1];
lp->letter = x[j];
} else {
lp->next = &lnk[i+1][j];
lp->letter = y[i];
}
lp->len = lp->next->len + 1;
}
}
for (link_t *lp = &lnk[0][0]; lp; lp = lp->next)
*out++ = lp->letter;
return 0;
}
int main(void)
{
char x[] = "abcbdab", y[] = "bdcaba", res[128];
scs(x, y, res);
printf("SCS(%s, %s) -> %s\n", x, y, res);
return 0;
}
- Output:
SCS(abcbdab, bdcaba) -> abdcabdab
C#
This is based on the Java version, but with added caching.
public class ShortestCommonSupersequence
{
Dictionary<(string, string), string> cache = new();
public string scs(string x, string y)
{
if (x.Length == 0) return y;
if (y.Length == 0) return x;
if (cache.TryGetValue((x, y), out var result)) return result;
if (x[0] == y[0])
{
return cache[(x, y)] = x[0] + scs(x.Substring(1), y.Substring(1));
}
var xr = scs(x.Substring(1), y);
var yr = scs(x, y.Substring(1));
if (yr.Length <= xr.Length)
{
return cache[(x, y)] = y[0] + yr;
}
else
{
return cache[(x, y)] = x[0] + xr;
}
}
public static void Main(string[] args)
{
var scs = new ShortestCommonSupersequence();
Console.WriteLine(scs.scs("abcbdab", "bdcaba"));
}
}
- Output:
abdcabdab
C++
#include <iostream>
std::string scs(std::string x, std::string y) {
if (x.empty()) {
return y;
}
if (y.empty()) {
return x;
}
if (x[0] == y[0]) {
return x[0] + scs(x.substr(1), y.substr(1));
}
if (scs(x, y.substr(1)).size() <= scs(x.substr(1), y).size()) {
return y[0] + scs(x, y.substr(1));
} else {
return x[0] + scs(x.substr(1), y);
}
}
int main() {
auto res = scs("abcbdab", "bdcaba");
std::cout << res << '\n';
return 0;
}
- Output:
abdcabdab
D
import std.stdio, std.functional, std.array, std.range;
dstring scs(in dstring x, in dstring y) nothrow @safe {
alias mScs = memoize!scs;
if (x.empty) return y;
if (y.empty) return x;
if (x.front == y.front)
return x.front ~ mScs(x.dropOne, y.dropOne);
if (mScs(x, y.dropOne).length <= mScs(x.dropOne, y).length)
return y.front ~ mScs(x, y.dropOne);
else
return x.front ~ mScs(x.dropOne, y);
}
void main() @safe {
scs("abcbdab", "bdcaba").writeln;
}
- Output:
abdcabdab
EasyLang
func$ car x$ .
return substr x$ 1 1
.
func$ cdr x$ .
return substr x$ 2 9999
.
func$ scs x$ y$ .
if x$ = ""
return y$
.
if y$ = ""
return x$
.
if car x$ = car y$
return car x$ & scs cdr x$ cdr y$
.
r1$ = scs x$ cdr y$
r2$ = scs cdr x$ y$
if len r1$ <= len r2$
return car y$ & r1$
else
return car x$ & r2$
.
.
print scs "abcbdab" "bdcaba"
- Output:
abdcabdab
Elixir
uses 'LCS' from here
defmodule SCS do
def scs(u, v) do
lcs = LCS.lcs(u, v) |> to_charlist
scs(to_charlist(u), to_charlist(v), lcs, []) |> to_string
end
defp scs(u, v, [], res), do: Enum.reverse(res) ++ u ++ v
defp scs([h|ut], [h|vt], [h|lt], res), do: scs(ut, vt, lt, [h|res])
defp scs([h|_]=u, [vh|vt], [h|_]=lcs, res), do: scs(u, vt, lcs, [vh|res])
defp scs([uh|ut], v, lcs, res), do: scs(ut, v, lcs, [uh|res])
end
u = "abcbdab"
v = "bdcaba"
IO.puts "SCS(#{u}, #{v}) = #{SCS.scs(u, v)}"
- Output:
SCS(abcbdab, bdcaba) = abdcabdab
Factor
USING: combinators io kernel locals math memoize sequences ;
MEMO:: scs ( x y -- seq )
{
{ [ x empty? ] [ y ] }
{ [ y empty? ] [ x ] }
{ [ x first y first = ]
[ x rest y rest scs x first prefix ] }
{ [ x y rest scs length x rest y scs length <= ]
[ x y rest scs y first prefix ] }
[ x rest y scs x first prefix ]
} cond ;
"abcbdab" "bdcaba" scs print
- Output:
abdcabdab
FreeBASIC
Uses 'LCS' function from Longest common subsequence#FreeBASIC:
Dim Shared As Double dists(0 To 9999)
' index into lookup table of Nums
Function dist(ci As Integer, cj As Integer) As Double
Return dists(cj*100 + ci)
End Function
' energy at s, to be minimized
Function Ens(path() As Integer) As Double
Dim As Double d = 0
For i As Integer = 0 To Ubound(path) - 1
d += dist(path(i), path(i+1))
Next
Return d
End Function
' temperature function, decreases to 0
Function T(k As Double, kmax As Double, kT As Double) As Double
Return (1 - k / kmax) * kT
End Function
' variation of E, from state s to state s_next
Function dE(s() As Integer, u As Integer, v As Integer) As Double
Dim As Integer su = s(u)
Dim As Integer sv = s(v)
' old
Dim As Double a = dist(s(u-1), su)
Dim As Double b = dist(s(u+1), su)
Dim As Double c = dist(s(v-1), sv)
Dim As Double d = dist(s(v+1), sv)
' new
Dim As Double na = dist(s(u-1), sv)
Dim As Double nb = dist(s(u+1), sv)
Dim As Double nc = dist(s(v-1), su)
Dim As Double nd = dist(s(v+1), su)
If v = u+1 Then Return (na + nd) - (a + d)
If u = v+1 Then Return (nc + nb) - (c + b)
Return (na + nb + nc + nd) - (a + b + c + d)
End Function
' probability to move from s to s_next
Function P(deltaE As Double, k As Double, kmax As Double, kT As Double) As Double
Return Exp(-deltaE / T(k, kmax, kT))
End Function
' Simulated annealing
Sub sa(kmax As Double, kT As Double)
Dim As Integer s(0 To 100)
Dim As Integer temp(0 To 98)
Dim As Integer dirs(0 To 7) = {1, -1, 10, -10, 9, 11, -11, -9}
Dim As Integer i, k, u, v, cv
Dim As Double Emin
For i = 0 To 98
temp(i) = i + 1
Next
Randomize Timer
For i = 0 To 98
Swap temp(i), temp(Int(Rnd * 99))
Next
For i = 0 To 98
s(i+1) = temp(i)
Next
Print "kT = "; kT
Print "E(s0) "; Ens(s())
Print
Emin = Ens(s())
For k = 0 To kmax
If k Mod (kmax/10) = 0 Then
Print Using "k: ####### T: #.#### Es: ###.####"; k; T(k, kmax, kT); Ens(s())
End If
u = Int(Rnd * 99) + 1
cv = s(u) + dirs(Int(Rnd * 8))
If cv <= 0 Or cv >= 100 Then Continue For
If Abs(dist(s(u), cv)) > 5 Then Continue For
v = s(cv)
Dim As Double deltae = dE(s(), u, v)
If deltae < 0 Or P(deltae, k, kmax, kT) >= Rnd Then
Swap s(u), s(v)
Emin = Emin + deltae
End If
Next k
Print
Print "E(s_final) "; Emin
Print "Path:"
For i = 0 To Ubound(s)
If i > 0 And i Mod 10 = 0 Then Print
Print Using "####"; s(i);
Next
Print
End Sub
' distances
For i As Integer = 0 To 9999
Dim As Integer ab = (i \ 100)
Dim As Integer cd = i Mod 100
Dim As Integer a = (ab \ 10)
Dim As Integer b = ab Mod 10
Dim As Integer c = (cd \ 10)
Dim As Integer d = cd Mod 10
dists(i) = Sqr((a-c)^2 + (b-d)^2)
Next i
Dim As Double kT = 1, kmax = 1e6
sa(kmax, kT)
Sleep
- Output:
kT = 1 E(s0) 510.1804163299929 k: 0 T: 1.0000 Es: 510.1804 k: 100000 T: 0.9000 Es: 195.1253 k: 200000 T: 0.8000 Es: 182.4579 k: 300000 T: 0.7000 Es: 153.4156 k: 400000 T: 0.6000 Es: 150.7938 k: 500000 T: 0.5000 Es: 141.6804 k: 600000 T: 0.4000 Es: 128.4290 k: 700000 T: 0.3000 Es: 123.2713 k: 800000 T: 0.2000 Es: 117.4202 k: 900000 T: 0.1000 Es: 116.0060 k: 1000000 T: 0.0000 Es: 116.0060 E(s_final) 116.0060090954848 Path: 0 11 10 20 21 32 22 12 2 3 13 14 34 33 23 24 35 25 16 15 4 5 6 7 9 8 18 19 29 39 49 48 38 28 27 17 26 36 47 37 45 46 57 56 55 54 44 43 42 52 51 41 31 30 40 50 60 61 83 73 63 62 72 71 70 80 90 91 81 82 92 93 94 96 97 98 99 89 79 69 59 58 68 67 77 87 88 78 76 66 65 75 86 95 85 84 74 64 53 1 0
Go
package main
import (
"fmt"
"strings"
)
func lcs(x, y string) string {
xl, yl := len(x), len(y)
if xl == 0 || yl == 0 {
return ""
}
x1, y1 := x[:xl-1], y[:yl-1]
if x[xl-1] == y[yl-1] {
return fmt.Sprintf("%s%c", lcs(x1, y1), x[xl-1])
}
x2, y2 := lcs(x, y1), lcs(x1, y)
if len(x2) > len(y2) {
return x2
} else {
return y2
}
}
func scs(u, v string) string {
ul, vl := len(u), len(v)
lcs := lcs(u, v)
ui, vi := 0, 0
var sb strings.Builder
for i := 0; i < len(lcs); i++ {
for ui < ul && u[ui] != lcs[i] {
sb.WriteByte(u[ui])
ui++
}
for vi < vl && v[vi] != lcs[i] {
sb.WriteByte(v[vi])
vi++
}
sb.WriteByte(lcs[i])
ui++
vi++
}
if ui < ul {
sb.WriteString(u[ui:])
}
if vi < vl {
sb.WriteString(v[vi:])
}
return sb.String()
}
func main() {
u := "abcbdab"
v := "bdcaba"
fmt.Println(scs(u, v))
}
- Output:
abdcabdab
Haskell
scs :: Eq a => [a] -> [a] -> [a]
scs [] ys = ys
scs xs [] = xs
scs xss@(x:xs) yss@(y:ys)
| x == y = x : scs xs ys
| otherwise = ws
where
us = scs xs yss
vs = scs xss ys
ws | length us < length vs = x : us
| otherwise = y : vs
main = putStrLn $ scs "abcbdab" "bdcaba"
- Output:
abdcabdab
Java
public class ShortestCommonSuperSequence {
private static boolean isEmpty(String s) {
return null == s || s.isEmpty();
}
private static String scs(String x, String y) {
if (isEmpty(x)) {
return y;
}
if (isEmpty(y)) {
return x;
}
if (x.charAt(0) == y.charAt(0)) {
return x.charAt(0) + scs(x.substring(1), y.substring(1));
}
if (scs(x, y.substring(1)).length() <= scs(x.substring(1), y).length()) {
return y.charAt(0) + scs(x, y.substring(1));
} else {
return x.charAt(0) + scs(x.substring(1), y);
}
}
public static void main(String[] args) {
System.out.println(scs("abcbdab", "bdcaba"));
}
}
- Output:
abdcabdab
jq
Works with gojq, the Go implementation of jq
# largest common substring
# Uses recursion, taking advantage of jq's TCO
def lcs:
. as [$x, $y]
| if ($x|length == 0) or ($y|length == 0) then ""
else $x[:-1] as $x1
| $y[:-1] as $y1
| if $x[-1:] == $y[-1:] then ([$x1, $y1] | lcs) + $x[-1:]
else ([$x, $y1] | lcs) as $x2
| ([$x1, $y] | lcs) as $y2
| if ($x2|length) > ($y2|length) then $x2 else $y2 end
end
end;
def scs:
def eq($s;$i; $t;$j): $s[$i:$i+1] == $t[$j:$j+1];
. as [$u, $v]
| lcs as $lcs
| reduce range(0; $lcs|length) as $i ( { ui: 0, vi: 0, sb: "" };
until( .ui == ($u|length) or eq($u;.ui; $lcs;$i);
.ui as $ui
| .sb += $u[$ui:$ui+1]
| .ui += 1 )
| until(.vi == ($v|length) or eq($v;.vi; $lcs;$i);
.vi as $vi
| .sb += $v[$vi:$vi+1]
| .vi += 1 )
| .sb += $lcs[$i:$i+1]
| .ui += 1
| .vi += 1
)
| if .ui < ($u|length) then .sb = .sb + $u[.ui:] else . end
| if .vi < ($v|length) then .sb = .sb + $v[.vi:] else . end
| .sb ;
[ "abcbdab", "bdcaba" ] | scs
- Output:
"abdcabdab"
Julia
using Memoize
@memoize function scs(x, y)
if x == ""
return y
elseif y == ""
return x
elseif x[1] == y[1]
return "$(x[1])$(scs(x[2:end], y[2:end]))"
elseif length(scs(x, y[2:end])) <= length(scs(x[2:end], y))
return "$(y[1])$(scs(x, y[2:end]))"
else
return "$(x[1])$(scs(x[2:end], y))"
end
end
println(scs("abcbdab", "bdcaba"))
- Output:
abdcabdab
Kotlin
Uses 'lcs' function from Longest common subsequence#Kotlin:
// version 1.1.2
fun lcs(x: String, y: String): String {
if (x.length == 0 || y.length == 0) return ""
val x1 = x.dropLast(1)
val y1 = y.dropLast(1)
if (x.last() == y.last()) return lcs(x1, y1) + x.last()
val x2 = lcs(x, y1)
val y2 = lcs(x1, y)
return if (x2.length > y2.length) x2 else y2
}
fun scs(u: String, v: String): String{
val lcs = lcs(u, v)
var ui = 0
var vi = 0
val sb = StringBuilder()
for (i in 0 until lcs.length) {
while (ui < u.length && u[ui] != lcs[i]) sb.append(u[ui++])
while (vi < v.length && v[vi] != lcs[i]) sb.append(v[vi++])
sb.append(lcs[i])
ui++; vi++
}
if (ui < u.length) sb.append(u.substring(ui))
if (vi < v.length) sb.append(v.substring(vi))
return sb.toString()
}
fun main(args: Array<String>) {
val u = "abcbdab"
val v = "bdcaba"
println(scs(u, v))
}
- Output:
abdcabdab
Mathematica /Wolfram Language
ClearAll[RosettaShortestCommonSuperSequence]
RosettaShortestCommonSuperSequence[aa_String, bb_String] :=
Module[{lcs, scs, a = aa, b = bb},
lcs = LongestCommonSubsequence[aa, bb];
scs = "";
While[StringLength[lcs] > 0,
If[StringTake[a, 1] == StringTake[lcs, 1] \[And] StringTake[b, 1] == StringTake[lcs, 1],
scs = StringJoin[scs, StringTake[lcs, 1]];
lcs = StringDrop[lcs, 1];
a = StringDrop[a, 1];
b = StringDrop[b, 1];
,
If[StringTake[a, 1] == StringTake[lcs, 1],
scs = StringJoin[scs, StringTake[b, 1]];
b = StringDrop[b, 1];
,
scs = StringJoin[scs, StringTake[a, 1]];
a = StringDrop[a, 1];
]
]
];
StringJoin[scs, a, b]
]
RosettaShortestCommonSuperSequence["abcbdab", "bdcaba"]
RosettaShortestCommonSuperSequence["WEASELS", "WARDANCE"]
- Output:
bdcabcbdaba WEASELSARDANCE
Nim
proc lcs(x, y: string): string =
if x.len == 0 or y.len == 0: return
let x1 = x[0..^2]
let y1 = y[0..^2]
if x[^1] == y[^1]: return lcs(x1, y1) & x[^1]
let x2 = lcs(x, y1)
let y2 = lcs(x1, y)
result = if x2.len > y2.len: x2 else: y2
proc scs(u, v: string): string =
let lcs = lcs(u, v)
var ui, vi = 0
for ch in lcs:
while ui < u.len and u[ui] != ch:
result.add u[ui]
inc ui
while vi < v.len and v[vi] != ch:
result.add v[vi]
inc vi
result.add ch
inc ui
inc vi
if ui < u.len: result.add u.substr(ui)
if vi < v.len: result.add v.substr(vi)
when isMainModule:
let u = "abcbdab"
let v = "bdcaba"
echo scs(u, v)
- Output:
abdcabdab
Perl
sub lcs { # longest common subsequence
my( $u, $v ) = @_;
return '' unless length($u) and length($v);
my $longest = '';
for my $first ( 0..length($u)-1 ) {
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;
- Output:
Strings abcbdab bdcaba Longest common subsequence: bcba Shortest common supersquence: abdcabdab
Phix
with javascript_semantics function longest_common_subsequence(sequence a, b) sequence res = "" if length(a) and length(b) then if a[$]=b[$] then res = longest_common_subsequence(a[1..-2],b[1..-2])&a[$] else sequence l = longest_common_subsequence(a,b[1..-2]), r = longest_common_subsequence(a[1..-2],b) res = iff(length(l)>length(r)?l:r) end if end if return res end function function shortest_common_supersequence(string a, b) string lcs = longest_common_subsequence(a, b), scs = "" -- Consume lcs while length(lcs) do integer c = lcs[1] if a[1]==c and b[1]==c then -- Part of the lcs, so consume from all strings scs &= c lcs = lcs[2..$] a = a[2..$] b = b[2..$] elsif a[1]==c then scs &= b[1] b = b[2..$] else scs &= a[1] a = a[2..$] end if end while -- append remaining characters return scs & a & b end function ?shortest_common_supersequence("abcbdab", "bdcaba") ?shortest_common_supersequence("WEASELS", "WARDANCE")
- Output:
"abdcabdab" "WEASRDANCELS"
Python
# Use the Longest Common Subsequence algorithm
def shortest_common_supersequence(a, b):
lcs = longest_common_subsequence(a, b)
scs = ""
# Consume lcs
while len(lcs) > 0:
if a[0]==lcs[0] and b[0]==lcs[0]:
# Part of the LCS, so consume from all strings
scs += lcs[0]
lcs = lcs[1:]
a = a[1:]
b = b[1:]
elif a[0]==lcs[0]:
scs += b[0]
b = b[1:]
else:
scs += a[0]
a = a[1:]
# append remaining characters
return scs + a + b
- Output:
Seq1: WEASELS Seq2: WARDANCE SCS: WEASRDANCELS
Racket
This program is based on the C implementation, but use memorization instead of dynamic programming. More explanations about the memorization part in http://blog.racket-lang.org/2012/08/dynamic-programming-versus-memoization.html .
#lang racket
(struct link (len letters))
(define (link-add li n letter)
(link (+ n (link-len li))
(cons letter (link-letters li))))
(define (memoize f)
(local ([define table (make-hash)])
(lambda args
(dict-ref! table args (λ () (apply f args))))))
(define scs/list
(memoize
(lambda (x y)
(cond
[(null? x)
(link (length y) y)]
[(null? y)
(link (length x) x)]
[(eq? (car x) (car y))
(link-add (scs/list (cdr x) (cdr y)) 1 (car x))]
[(<= (link-len (scs/list x (cdr y)))
(link-len (scs/list (cdr x) y)))
(link-add (scs/list x (cdr y)) 1 (car y))]
[else
(link-add (scs/list (cdr x) y) 1 (car x))]))))
(define (scs x y)
(list->string (link-letters (scs/list (string->list x) (string->list y)))))
(scs "abcbdab" "bdcaba")
- Output:
"abdcabdab"
Raku
(formerly Perl 6)
Using 'lcs' routine from Longest common subsequence task
sub lcs(Str $xstr, Str $ystr) { # longest common subsequence
return "" unless $xstr && $ystr;
my ($x, $xs, $y, $ys) = $xstr.substr(0, 1), $xstr.substr(1), $ystr.substr(0, 1), $ystr.substr(1);
return $x eq $y
?? $x ~ lcs($xs, $ys)
!! max(:by{ $^a.chars }, lcs($xstr, $ys), lcs($xs, $ystr) );
}
sub scs ($u, $v) { # shortest common supersequence
my @lcs = (lcs $u, $v).comb;
my $pat = '(.*)' ~ join('(.*)',@lcs) ~ '(.*)';
my $regex = "rx/$pat/".EVAL;
my @u = ($u ~~ $regex).list;
my @v = ($v ~~ $regex).list;
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;
- Output:
Strings: abcbdab bdcaba Longest common subsequence: bcba Shortest common supersquence: abdcabdab
REXX
/*REXX program finds the Shortest common supersequence (SCS) of two character strings.*/
parse arg u v . /*obtain optional arguments from the CL*/
if u=='' | u=="," then u= 'abcbdab' /*Not specified? Then use the default.*/
if v=='' | v=="," then v= 'bdcaba' /* " " " " " " */
say ' string u=' u /*echo the value of string U to term.*/
say ' string v=' v /* " " " " " V " " */
$= u /*define initial value for the output. */
do n=1 to length(u) /*process the whole length of string U.*/
do m=n to length(v) - 1 /* " right─ish part " " V.*/
p= pos( substr(v, m, 1), $) /*position of mTH V char in $ string.*/
_= substr(v, m+1, 1) /*obtain a single character of string V*/
if p\==0 & _\==substr($, p+1, 1) then $= insert(_, $, p)
end /*m*/ /* [↑] insert _ in $ after position P.*/
end /*n*/
say
say 'shortest common supersequence=' $ /*stick a fork in it, we're all done. */
- output when using the default inputs:
string u= abcbdab string v= bdcaba shortest common supersequence= abdcabdab
- output when using the inputs values: ab ac
string u= ab string v= ac shortest common supersequence= acb
- output when using the inputs values: ac ab
string u= ac string v= ab shortest common supersequence= abc
Ring
# Project : Shortest common supersequence
str1 = "a b c b d a b"
str2 = "bdcaba"
str3 = str2list(substr(str1, " ", nl))
for n = 1 to len(str3)
for m = n to len(str2)-1
pos = find(str3, str2[m])
if pos > 0 and str2[m+1] != str3[pos+1]
insert(str3, pos, str2[m+1])
ok
next
next
showarray(str3)
func showarray(vect)
svect = ""
for n = 1 to len(vect)
svect = svect + vect[n]
next
see svect
Output:
Shortest common supersequence: abdcabdab
Ruby
uses 'lcs' from here
require 'lcs'
def scs(u, v)
lcs = lcs(u, v)
u, v = u.dup, v.dup
scs = ""
# Iterate over the characters until LCS processed
until lcs.empty?
if u[0]==lcs[0] and v[0]==lcs[0]
# Part of the LCS, so consume from all strings
scs << lcs.slice!(0)
u.slice!(0)
v.slice!(0)
elsif u[0]==lcs[0]
# char of u = char of LCS, but char of LCS v doesn't so consume just that
scs << v.slice!(0)
else
# char of u != char of LCS, so consume just that
scs << u.slice!(0)
end
end
# append remaining characters, which are not in common
scs + u + v
end
u = "abcbdab"
v = "bdcaba"
puts "SCS(#{u}, #{v}) = #{scs(u, v)}"
- Output:
SCS(abcbdab, bdcaba) = abcbdcaba
Sidef
Uses the lcs function defined here.
func scs(u, v) {
var ls = lcs(u, v).chars
var pat = Regex('(.*)'+ls.join('(.*)')+'(.*)')
u.scan!(pat)
v.scan!(pat)
var ss = (u.shift + v.shift)
ls.each { |c| ss += (c + u.shift + v.shift) }
return ss
}
say scs("abcbdab", "bdcaba")
- Output:
abdcabdab
Tcl
This example uses either of the lcs
implementations from here, assumed renamed to lcs…
proc scs {u v} {
set lcs [lcs $u $v]
set scs ""
# Iterate over the characters until LCS processed
for {set ui [set vi [set li 0]]} {$li<[string length $lcs]} {} {
set uc [string index $u $ui]
set vc [string index $v $vi]
set lc [string index $lcs $li]
if {$uc eq $lc} {
if {$vc eq $lc} {
# Part of the LCS, so consume from all strings
append scs $lc
incr ui
incr li
} else {
# char of u = char of LCS, but char of LCS v doesn't so consume just that
append scs $vc
}
incr vi
} else {
# char of u != char of LCS, so consume just that
append scs $uc
incr ui
}
}
# append remaining characters, which are not in common
append scs [string range $u $ui end] [string range $v $vi end]
return $scs
}
Demonstrating:
set u "abcbdab"
set v "bdcaba"
puts "SCS($u,$v) = [scs $u $v]"
- Output:
SCS(abcbdab,bdcaba) = abdcabdab
Wren
var lcs // recursive
lcs = Fn.new { |x, y|
if (x.count == 0 || y.count == 0) return ""
var x1 = x[0...-1]
var y1 = y[0...-1]
if (x[-1] == y[-1]) return lcs.call(x1, y1) + x[-1]
var x2 = lcs.call(x, y1)
var y2 = lcs.call(x1, y)
return (x2.count > y2.count) ? x2 : y2
}
var scs = Fn.new { |u, v|
var lcs = lcs.call(u, v)
var ui = 0
var vi = 0
var sb = ""
for (i in 0...lcs.count) {
while (ui < u.count && u[ui] != lcs[i]) {
sb = sb + u[ui]
ui = ui + 1
}
while (vi < v.count && v[vi] != lcs[i]) {
sb = sb + v[vi]
vi = vi + 1
}
sb = sb + lcs[i]
ui = ui + 1
vi = vi + 1
}
if (ui < u.count) sb = sb + u[ui..-1]
if (vi < v.count) sb = sb + v[vi..-1]
return sb
}
var u = "abcbdab"
var v = "bdcaba"
System.print(scs.call(u, v))
- Output:
abdcabdab
zkl
class Link{ var len,letter,next;
fcn init(l=0,c="",lnk=Void){ len,letter,next=l,c,lnk; }
}
fcn scs(x,y,out){
lx,ly:=x.len(),y.len();
lnk:=(ly+1).pump(List,'wrap(_){ (lx+1).pump(List(),Link.create) });
foreach i in (ly){ lnk[i][lx]=Link(ly-i, y[i]) }
foreach j in (lx){ lnk[ly][j]=Link(lx-j, x[j]) }
foreach i,j in ([ly-1..0,-1],[lx-1..0,-1]){
lp:=lnk[i][j];
if (y[i]==x[j]){
lp.next =lnk[i+1][j+1];
lp.letter=x[j];
}else if(lnk[i][j+1].len < lnk[i+1][j].len){
lp.next =lnk[i][j+1];
lp.letter=x[j];
}else{
lp.next =lnk[i+1][j];
lp.letter=y[i];
}
lp.len=lp.next.len + 1;
}
lp:=lnk[0][0]; while(lp){ out.write(lp.letter); lp=lp.next; }
out.close()
}
scs("abcbdab","bdcaba", Sink(String)).println();
- Output:
abdcabdab