Shortest common supersequence

From Rosetta Code
Revision as of 19:42, 27 February 2024 by Jjuanhdez (talk | contribs) (→‎{{header|FreeBASIC}}: oops! I uploaded the code from another task. Corrected.)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Task
Shortest common supersequence
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

Translation of: C++
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

Translation of: C++
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

Translation of: C++
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#

Translation of: Java

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++

Translation of: Java
#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

Translation of: Racket
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

Translation of: C++
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

Translation of: Ruby
Works with: Elixir version 1.3

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

Translation of: Julia
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

Function LCS(a As String, b As String) As String
    Dim As String x, y
    If Len(a) = 0 Or Len(b) = 0 Then 
        Return ""
    Elseif Right(a, 1) = Right(b, 1) Then
        LCS = LCS(Left(a, Len(a) - 1), Left(b, Len(b) - 1)) + Right(a, 1)
    Else
        x = LCS(a, Left(b, Len(b) - 1))
        y = LCS(Left(a, Len(a) - 1), b)
        If Len(x) > Len(y) Then Return x Else Return y
    End If
End Function

Function SCS(u As String, v As String) As String
    Dim lcsStr As String = LCS(u, v)
    Dim As Integer i, ui = 0, vi = 0
    Dim As String sb = ""
    For i = 1 To Len(lcsStr)
        While ui < Len(u) Andalso Mid(u, ui + 1, 1) <> Mid(lcsStr, i, 1)
            sb += Mid(u, ui + 1, 1)
            ui += 1
        Wend
        While vi < Len(v) Andalso Mid(v, vi + 1, 1) <> Mid(lcsStr, i, 1)
            sb += Mid(v, vi + 1, 1)
            vi += 1
        Wend
        sb += Mid(lcsStr, i, 1)
        ui += 1
        vi += 1
    Next
    If ui < Len(u) Then sb += Right(u, Len(u) - ui)
    If vi < Len(v) Then sb += Right(v, Len(v) - vi)
    Return sb
End Function

Print SCS("abcbdab", "bdcaba")
Print SCS("WEASELS", "WARDANCE")

Sleep
Output:
abdcabdab
WEASRDANCELS

Go

Translation of: Kotlin
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

Translation of: C++
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

Translation of: D
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

Translation of: Wren
Works with: 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

Translation of: D
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

Translation of: Kotlin
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

Translation of: Python
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

Translation of: C

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

Translation of: RING
/*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

Translation of: Tcl

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

Translation of: Perl

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

Translation of: Kotlin
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

Translation of: C
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
Retrieved from "https://rosettacode.org/wiki/Shortest_common_supersequence?oldid=360949"