Longest common suffix: Difference between revisions
(Added AppleScript.) |
m (→{{header|AppleScript}}: Added a declarative (functional) draft, using library functions whenever possible.) |
||
Line 5:
=={{header|AppleScript}}==
===Procedural===
The simplest solution in AppleScript seems to be to reverse the strings, apply the [https://www.rosettacode.org/wiki/Longest_common_prefix#AppleScriptObjC AppleScriptObjC] solution for the [https://www.rosettacode.org/wiki/Longest_common_prefix Longest common prefix] task, and reverse the result.
Line 53 ⟶ 55:
longestCommonSuffix({"remark", "spark", "aardvark"}) --> "ark"
longestCommonSuffix({"ectoplasm", "banana"}) --> ""</lang>
===Functional===
and for more productivity, and higher re-use of library functions, we can write a functional definition (rather than a procedure):
<lang applescript>------------------- LONGEST COMMON SUFFIX ------------------
-- longestCommonSuffix :: [String] -> String
on longestCommonSuffix(xs)
if 1 < length of xs then
reverse of map(my fst, ¬
takeWhile(my allSame, ¬
transpose(map(my |reverse|, xs)))) as text
else
xs as text
end if
end longestCommonSuffix
---------------------------- TESTS --------------------------
on run
script test
on |λ|(xs)
showList(xs) & " -> '" & longestCommonSuffix(xs) & "'"
end |λ|
end script
unlines(map(test, {¬
{"throne", "sousaphone", "tone"}, ¬
{"prefix", "suffix", "infix"}, ¬
{"remark", "spark", "aardvark", "lark"}, ¬
{"ectoplasm", "banana", "brick"}}))
end run
--------------------- GENERIC FUNCTIONS --------------------
-- all :: (a -> Bool) -> [a] -> Bool
on all(p, xs)
-- True if p holds for every value in xs
tell mReturn(p)
set lng to length of xs
repeat with i from 1 to lng
if not |λ|(item i of xs, i, xs) then return false
end repeat
true
end tell
end all
-- allSame :: [a] -> Bool
on allSame(xs)
if 2 > length of xs then
true
else
script p
property h : item 1 of xs
on |λ|(x)
h = x
end |λ|
end script
all(p, rest of xs)
end if
end allSame
-- comparing :: (a -> b) -> (a -> a -> Ordering)
on comparing(f)
script
on |λ|(a, b)
tell mReturn(f)
set fa to |λ|(a)
set fb to |λ|(b)
if fa < fb then
-1
else if fa > fb then
1
else
0
end if
end tell
end |λ|
end script
end comparing
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & (|λ|(item i of xs, i, xs))
end repeat
end tell
return acc
end concatMap
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- fst :: (a, b) -> a
on fst(tpl)
if class of tpl is record then
|1| of tpl
else
item 1 of tpl
end if
end fst
-- intercalate :: String -> [String] -> String
on intercalate(delim, xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, delim}
set str to xs as text
set my text item delimiters to dlm
str
end intercalate
-- justifyLeft :: Int -> Char -> String -> String
on justifyLeft(n, cFiller)
script
on |λ|(strText)
if n > length of strText then
text 1 thru n of (strText & replicate(n, cFiller))
else
strText
end if
end |λ|
end script
end justifyLeft
-- length :: [a] -> Int
on |length|(xs)
set c to class of xs
if list is c or string is c then
length of xs
else
(2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
end if
end |length|
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of xs.
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
on maximumBy(f, xs)
set cmp to mReturn(f)
script max
on |λ|(a, b)
if a is missing value or cmp's |λ|(a, b) < 0 then
b
else
a
end if
end |λ|
end script
foldl(max, missing value, xs)
end maximumBy
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then
y
else
x
end if
end min
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {}
if 1 > n then return out
set dbl to {a}
repeat while (1 < n)
if 0 < (n mod 2) then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
-- reverse :: [a] -> [a]
on |reverse|(xs)
if class of xs is text then
(reverse of characters of xs) as text
else
reverse of xs
end if
end |reverse|
-- showList :: [a] -> String
on showList(xs)
script show
on |λ|(x)
if text is class of x then
"'" & x & "'"
else
x as text
end if
end |λ|
end script
if {} ≠ xs then
"[" & intercalate(", ", map(show, xs)) & "]"
else
"[]"
end if
end showList
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
set c to class of xs
if list is c then
if 0 < n then
items 1 thru min(n, length of xs) of xs
else
{}
end if
else if string is c then
if 0 < n then
text 1 thru min(n, length of xs) of xs
else
""
end if
else if script is c then
set ys to {}
repeat with i from 1 to n
set v to |λ|() of xs
if missing value is v then
return ys
else
set end of ys to v
end if
end repeat
return ys
else
missing value
end if
end take
-- takeWhile :: (a -> Bool) -> [a] -> [a]
-- takeWhile :: (Char -> Bool) -> String -> String
on takeWhile(p, xs)
if script is class of xs then
takeWhileGen(p, xs)
else
tell mReturn(p)
repeat with i from 1 to length of xs
if not |λ|(item i of xs) then ¬
return take(i - 1, xs)
end repeat
end tell
return xs
end if
end takeWhile
-- transpose :: [[a]] -> [[a]]
on transpose(rows)
set w to length of maximumBy(comparing(|length|), rows)
set paddedRows to map(justifyLeft(w, "x"), rows)
script cols
on |λ|(_, iCol)
script cell
on |λ|(row)
item iCol of row
end |λ|
end script
concatMap(cell, paddedRows)
end |λ|
end script
map(cols, item 1 of rows)
end transpose
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation
-- of a list of strings with the newline character.
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set str to xs as text
set my text item delimiters to dlm
str
end unlines</lang>
{{Out}}
<pre>['throne', 'sousaphone', 'tone'] -> 'one'
['prefix', 'suffix', 'infix'] -> 'fix'
['remark', 'spark', 'aardvark', 'lark'] -> 'ark'
['ectoplasm', 'banana', 'brick'] -> ''</pre>
=={{header|Delphi}}==
|
Revision as of 09:29, 8 August 2020
- Task
The goal is to write a function to find the longest common suffix string amongst an array of strings.
AppleScript
Procedural
The simplest solution in AppleScript seems to be to reverse the strings, apply the AppleScriptObjC solution for the Longest common prefix task, and reverse the result.
<lang applescript>use AppleScript version "2.4" -- OS X 10.10 (Yosemite) or later use framework "Foundation"
on longestCommonSuffix(textList)
-- Eliminate any non-texts from the input. if (textList's class is record) then return "" set textList to (textList as list)'s text if (textList is {}) then return "" set astid to AppleScript's text item delimiters set AppleScript's text item delimiters to "" repeat with i from 1 to (count textList) set item i of textList to (reverse of characters of item i of textList) as text end repeat set lcs to (reverse of characters of longestCommonPrefix(textList)) as text set AppleScript's text item delimiters to astid return lcs
end longestCommonSuffix
on longestCommonPrefix(textList)
-- Eliminate any non-texts from the input. if (textList's class is record) then return "" set textList to (textList as list)'s text if (textList is {}) then return "" -- Convert the AppleScript list to an NSArray of NSStrings. set stringArray to current application's class "NSArray"'s arrayWithArray:(textList) -- Compare the strings case-insensitively using a built-in NSString method. set lcp to stringArray's firstObject() repeat with i from 2 to (count stringArray) set lcp to (lcp's commonPrefixWithString:(item i of stringArray) options:(current application's NSCaseInsensitiveSearch)) if (lcp's |length|() is 0) then exit repeat end repeat -- Return the NSString result as AppleScript text. return lcp as text
end longestCommonPrefix
-- Tests and results: longestCommonSuffix({"throne", "sousaphone"}) --> "one" longestCommonSuffix({"prefix", "suffix"}) --> "fix" longestCommonSuffix({"remark", "spark", "aardvark"}) --> "ark" longestCommonSuffix({"ectoplasm", "banana"}) --> ""</lang>
Functional
and for more productivity, and higher re-use of library functions, we can write a functional definition (rather than a procedure):
<lang applescript>------------------- LONGEST COMMON SUFFIX ------------------
-- longestCommonSuffix :: [String] -> String
on longestCommonSuffix(xs)
if 1 < length of xs then reverse of map(my fst, ¬ takeWhile(my allSame, ¬ transpose(map(my |reverse|, xs)))) as text else xs as text end if
end longestCommonSuffix
TESTS --------------------------
on run
script test on |λ|(xs) showList(xs) & " -> '" & longestCommonSuffix(xs) & "'" end |λ| end script unlines(map(test, {¬ {"throne", "sousaphone", "tone"}, ¬ {"prefix", "suffix", "infix"}, ¬ {"remark", "spark", "aardvark", "lark"}, ¬ {"ectoplasm", "banana", "brick"}}))
end run
GENERIC FUNCTIONS --------------------
-- all :: (a -> Bool) -> [a] -> Bool on all(p, xs)
-- True if p holds for every value in xs tell mReturn(p) set lng to length of xs repeat with i from 1 to lng if not |λ|(item i of xs, i, xs) then return false end repeat true end tell
end all
-- allSame :: [a] -> Bool
on allSame(xs)
if 2 > length of xs then true else script p property h : item 1 of xs on |λ|(x) h = x end |λ| end script all(p, rest of xs) end if
end allSame
-- comparing :: (a -> b) -> (a -> a -> Ordering)
on comparing(f)
script on |λ|(a, b) tell mReturn(f) set fa to |λ|(a) set fb to |λ|(b) if fa < fb then -1 else if fa > fb then 1 else 0 end if end tell end |λ| end script
end comparing
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs set acc to {} tell mReturn(f) repeat with i from 1 to lng set acc to acc & (|λ|(item i of xs, i, xs)) end repeat end tell return acc
end concatMap
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f) set v to startValue set lng to length of xs repeat with i from 1 to lng set v to |λ|(v, item i of xs, i, xs) end repeat return v end tell
end foldl
-- fst :: (a, b) -> a
on fst(tpl)
if class of tpl is record then |1| of tpl else item 1 of tpl end if
end fst
-- intercalate :: String -> [String] -> String
on intercalate(delim, xs)
set {dlm, my text item delimiters} to ¬ {my text item delimiters, delim} set str to xs as text set my text item delimiters to dlm str
end intercalate
-- justifyLeft :: Int -> Char -> String -> String
on justifyLeft(n, cFiller)
script on |λ|(strText) if n > length of strText then text 1 thru n of (strText & replicate(n, cFiller)) else strText end if end |λ| end script
end justifyLeft
-- length :: [a] -> Int
on |length|(xs)
set c to class of xs if list is c or string is c then length of xs else (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite) end if
end |length|
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f -- to each element of xs. tell mReturn(f) set lng to length of xs set lst to {} repeat with i from 1 to lng set end of lst to |λ|(item i of xs, i, xs) end repeat return lst end tell
end map
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
on maximumBy(f, xs)
set cmp to mReturn(f) script max on |λ|(a, b) if a is missing value or cmp's |λ|(a, b) < 0 then b else a end if end |λ| end script foldl(max, missing value, xs)
end maximumBy
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then y else x end if
end min
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper. if script is class of f then f else script property |λ| : f end script end if
end mReturn
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {} if 1 > n then return out set dbl to {a} repeat while (1 < n) if 0 < (n mod 2) then set out to out & dbl set n to (n div 2) set dbl to (dbl & dbl) end repeat return out & dbl
end replicate
-- reverse :: [a] -> [a]
on |reverse|(xs)
if class of xs is text then (reverse of characters of xs) as text else reverse of xs end if
end |reverse|
-- showList :: [a] -> String
on showList(xs)
script show on |λ|(x) if text is class of x then "'" & x & "'" else x as text end if end |λ| end script if {} ≠ xs then "[" & intercalate(", ", map(show, xs)) & "]" else "[]" end if
end showList
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
set c to class of xs if list is c then if 0 < n then items 1 thru min(n, length of xs) of xs else {} end if else if string is c then if 0 < n then text 1 thru min(n, length of xs) of xs else "" end if else if script is c then set ys to {} repeat with i from 1 to n set v to |λ|() of xs if missing value is v then return ys else set end of ys to v end if end repeat return ys else missing value end if
end take
-- takeWhile :: (a -> Bool) -> [a] -> [a]
-- takeWhile :: (Char -> Bool) -> String -> String
on takeWhile(p, xs)
if script is class of xs then takeWhileGen(p, xs) else tell mReturn(p) repeat with i from 1 to length of xs if not |λ|(item i of xs) then ¬ return take(i - 1, xs) end repeat end tell return xs end if
end takeWhile
-- transpose :: a -> a
on transpose(rows)
set w to length of maximumBy(comparing(|length|), rows) set paddedRows to map(justifyLeft(w, "x"), rows) script cols on |λ|(_, iCol) script cell on |λ|(row) item iCol of row end |λ| end script concatMap(cell, paddedRows) end |λ| end script map(cols, item 1 of rows)
end transpose
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation -- of a list of strings with the newline character. set {dlm, my text item delimiters} to ¬ {my text item delimiters, linefeed} set str to xs as text set my text item delimiters to dlm str
end unlines</lang>
- Output:
['throne', 'sousaphone', 'tone'] -> 'one' ['prefix', 'suffix', 'infix'] -> 'fix' ['remark', 'spark', 'aardvark', 'lark'] -> 'ark' ['ectoplasm', 'banana', 'brick'] -> ''
Delphi
<lang Delphi> program Longest_common_suffix;
{$APPTYPE CONSOLE}
uses
System.SysUtils, Types;
type
TStringDynArrayHelper = record helper for TStringDynArray private class function Compare(const s: string; a: TStringDynArray; subSize: integer): Boolean; public function Reverse(value: string): string; function LongestSuffix: string; function Join(const sep: char): string; end;
{ TStringDynArrayHelper }
class function TStringDynArrayHelper.Compare(const s: string; a: TStringDynArray;
subSize: integer): Boolean;
var
i: Integer;
begin
for i := 0 to High(a) do if s <> a[i].Substring(0, subSize) then exit(False); Result := True;
end;
function TStringDynArrayHelper.Join(const sep: char): string; begin
Result := string.Join(sep, self);
end;
function TStringDynArrayHelper.LongestSuffix: string; var
ALength: Integer; i, lenMin, longest: Integer; ref: string;
begin
ALength := Length(self);
// Empty list if ALength = 0 then exit();
lenMin := MaxInt; for i := 0 to ALength - 1 do begin // One string is empty if self[i].IsEmpty then exit();
self[i] := Reverse(self[i]);
// Get the minimum length of string if lenMin > self[i].Length then lenMin := self[i].Length; end;
longest := -1; repeat inc(longest); ref := self[0].Substring(0, longest + 1); until not compare(ref, Self, longest + 1) or (longest >= lenMin);
Result := self[0].Substring(0, longest); Result := reverse(Result);
end;
function TStringDynArrayHelper.Reverse(value: string): string; var
ALength: Integer; i: Integer; c: Char;
begin
ALength := value.Length; Result := value;
if ALength < 2 then exit;
for i := 1 to ALength div 2 do begin c := Result[i]; Result[i] := Result[ALength - i + 1]; Result[ALength - i + 1] := c; end;
end;
var
List: TStringDynArray;
begin
List := ['baabababc', 'baabc', 'bbbabc'];
Writeln('Input:'); Writeln(List.Join(#10), #10); Writeln('Longest common suffix = ', List.LongestSuffix);
Readln;
end.
</lang>
- Output:
Input: baabababc baabc bbbabc Longest common suffix = abc
Factor
<lang factor>USING: accessors grouping kernel prettyprint sequences sequences.extras ;
! Like take-while, but for matrices and works from the rear.
- take-col-while-last ( ... matrix quot: ( ... col -- ... ? ) -- ... new-matrix )
[ [ <reversed> ] map flip ] dip take-while ; inline
- lcs ( seq -- lcs )
dup first swap [ all-equal? ] take-col-while-last to>> tail* ;
{ "baabababc" "baabc" "bbbabc" } lcs . { "baabababc" "baabc" "bbbazc" } lcs . { "" } lcs .</lang>
- Output:
"abc" "c" ""
Go
<lang go>package main
import (
"fmt" "strings"
)
func lcs(a []string) string {
le := len(a) if le == 0 { return "" } if le == 1 { return a[0] } le0 := len(a[0]) minLen := le0 for i := 1; i < le; i++ { if len(a[i]) < minLen { minLen = len(a[i]) } } if minLen == 0 { return "" } res := "" a1 := a[1:] for i := 1; i <= minLen; i++ { suffix := a[0][le0-i:] for _, e := range a1 { if !strings.HasSuffix(e, suffix) { return res } } res = suffix } return res
}
func main() {
tests := [][]string{ {"baabababc", "baabc", "bbbabc"}, {"baabababc", "baabc", "bbbazc"}, {"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"}, {"longest", "common", "suffix"}, {"suffix"}, {""}, } for _, test := range tests { fmt.Printf("%v -> \"%s\"\n", test, lcs(test)) }
}</lang>
- Output:
[baabababc baabc bbbabc] -> "abc" [baabababc baabc bbbazc] -> "c" [Sunday Monday Tuesday Wednesday Thursday Friday Saturday] -> "day" [longest common suffix] -> "" [suffix] -> "suffix" [] -> ""
Haskell
This task clearly needs a little more work to bring it up to the usual standard – it's rather underspecified, and bereft of test samples – but one response, for the moment, might be something like: <lang haskell>import Data.List (transpose)
longestCommonSuffix :: [String] -> String longestCommonSuffix =
foldr (flip (<>) . return . head) [] . takeWhile (all =<< (==) . head) . transpose . fmap reverse
main :: IO () main =
mapM_ (putStrLn . longestCommonSuffix) [ [ "Sunday" , "Monday" , "Tuesday" , "Wednesday" , "Thursday" , "Friday" , "Saturday" ] , [ "Sondag" , "Maandag" , "Dinsdag" , "Woensdag" , "Donderdag" , "Vrydag" , "Saterdag" , "dag" ] ]</lang>
- Output:
day dag
Julia
<lang julia>function longestcommonsuffix(strings)
n, nmax = 0, minimum(length, strings) nmax == 0 && return "" while n <= nmax && all(s -> s[end-n] == strings[end][end-n], strings) n += 1 end return strings[1][end-n+1:end]
end
println(longestcommonsuffix(["baabababc","baabc","bbbabc"])) println(longestcommonsuffix(["baabababc","baabc","bbbazc"]))
println(longestcommonsuffix([""]))</lang>
- Output:
abc c
Perl
Based on Longest_common_prefix Perl entry. <lang perl>use strict; use warnings; use feature 'say';
sub lcs {
for (0..$#_) { $_[$_] = join , reverse split , $_[$_] } join , reverse split , (join("\0", @_) =~ /^ ([^\0]*) [^\0]* (?:\0 \1 [^\0]*)* $/sx)[0];
}
for my $words (
[ <Sunday Monday Tuesday Wednesday Thursday Friday Saturday> ], [ <Sondag Maandag Dinsdag Woensdag Donderdag Vrydag Saterdag dag> ], [ 2347, 9312347, 'acx5g2347', 12.02347 ], [ <longest common suffix> ], [ ('one, Hey!', 'three, Hey!', 'ale, Hey!', 'me, Hey!') ], [ 'suffix' ], [ ]) { say qq{'@$words' ==> '@{[lcs(@$words)]}';
}</lang>
- Output:
'Sunday Monday Tuesday Wednesday Thursday Friday Saturday' ==> 'day' 'Sondag Maandag Dinsdag Woensdag Donderdag Vrydag Saterdag dag' ==> 'dag' '2347 9312347 acx5g2347 12.02347' ==> '2347' 'longest common suffix' ==> '' 'one, Hey! three, Hey! ale, Hey! me, Hey!' ==> 'e, Hey!' 'suffix' ==> 'suffix' '' ==> ''
Phix
Phix allows negative indexes, with -1 as the last element [same as $], and -length(s) the first element of s, so we can just do this: <lang Phix>function longestcommonsuffix(sequence strings)
string res = "" if length(strings) then res = strings[1] for i=2 to length(strings) do string si = strings[i] if length(si)<length(res) then res = res[-length(si)..$] end if for j=-1 to -length(res) by -1 do if res[j]!=si[j] then res = res[j+1..$] exit end if end for if length(res)=0 then exit end if end for end if return res
end function
sequence tests = {{"baabababc","baabc","bbbabc"},
{"baabababc","baabc","bbbazc"}, {"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"}, {"longest", "common", "suffix"}, {"suffix"}, {""}}
for i=1 to length(tests) do
printf(1,"%v ==> \"%s\"\n",{tests[i],longestcommonsuffix(tests[i])})
end for</lang>
- Output:
{"baabababc","baabc","bbbabc"} ==> "abc" {"baabababc","baabc","bbbazc"} ==> "c" {"Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"} ==> "day" {"longest","common","suffix"} ==> "" {"suffix"} ==> "suffix" {""} ==> ""
Python
Pending a fuller task statement and some test samples:
<lang python>Longest common suffix
from itertools import takewhile from functools import reduce
- longestCommonSuffix :: [String] -> String
def longestCommonSuffix(xs):
Longest suffix shared by all strings in xs. def allSame(cs): h = cs[0] return all(h == c for c in cs[1:])
def firstCharPrepended(s, cs): return cs[0] + s return reduce( firstCharPrepended, takewhile( allSame, zip(*(reversed(x) for x in xs)) ), )
- -------------------------- TEST --------------------------
- main :: IO ()
def main():
Test
samples = [ [ "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" ], [ "Sondag", "Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrydag", "Saterdag" ] ] for xs in samples: print( longestCommonSuffix(xs) )
- MAIN ---
if __name__ == '__main__':
main()</lang>
- Output:
day dag
Raku
<lang perl6>sub longest-common-suffix ( *@words ) {
return unless +@words; my $min = @words».chars.min; for 1 .. * { return @words[0].substr(* - $min) if $_ > $min; next if @words».substr(* - $_).Set == 1; return @words[0].substr(* - $_ + 1); }
}
say "{$_.raku} - LCS: >{longest-common-suffix $_}<" for
<Sunday Monday Tuesday Wednesday Thursday Friday Saturday>, <Sondag Maandag Dinsdag Woensdag Donderdag Vrydag Saterdag dag>, ( 2347, 9312347, 'acx5g2347', 12.02347 ), <longest common suffix>, ('one, Hey!', 'three, Hey!', 'ale, Hey!', 'me, Hey!'), 'suffix', </lang>
- Output:
("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday") - LCS: >day< ("Sondag", "Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrydag", "Saterdag", "dag") - LCS: >dag< (2347, 9312347, "acx5g2347", 12.02347) - LCS: >2347< ("longest", "common", "suffix") - LCS: >< ("one, Hey!", "three, Hey!", "ale, Hey!", "me, Hey!") - LCS: >e, Hey!< "suffix" - LCS: >suffix< "" - LCS: ><
REXX
Essentially, this REXX version simply reversed the strings, and then finds the longest common prefix. <lang rexx>/*REXX program finds the longest common suffix contained in an array of strings. */ parse arg z; z= space(z) /*obtain optional arguments from the CL*/ if z==|z=="," then z='baabababc baabc bbbabc' /*Not specified? Then use the default.*/ z= space(z); #= words(z) /*#: the number of words in the list. */ say 'There are ' # " words in the list: " z zr= reverse(z) /*reverse Z, find longest common prefix*/ @= word(zr, 1); m= length(@) /*get 1st word in reversed string; len.*/
do j=2 to #; x= word(zr, j) /*obtain a word (string) from the list.*/ t= compare(@, x) /*compare to the "base" word/string. */ if t==1 then do; @=; leave /*A mismatch of strings? Then leave, */ end /*no sense in comparing anymore strings*/ if t==0 & @==x then t= length(@) + 1 /*Both strings equal? Compute length. */ if t>=m then iterate /*T ≥ M? Then it's not longest string.*/ m= t - 1; @= left(@, max(0, m) ) /*redefine max length & the base string*/ end /*j*/
say /*stick a fork in it, we're all done. */ if m==0 then say 'There is no common suffix.'
else say 'The longest common suffix is: ' right( word(z, 1), m)</lang>
- output when using the default input:
There are 3 words in the list: baabababc baabc bbbabc The longest common suffix is: abc
Ring
<lang ring> load "stdlib.ring"
pre = ["baabababc","baabc","bbbabc"] len = len(pre) lenList = list(len) sub = list(len)
see "Input:" + nl see pre
for n = 1 to len
temp = pre[n] pre[n] = rever(temp)
next
for n = 1 to len
lenList[n] = len(pre[n])
next
lenList = sort(lenList) lenMax = lenList[1]
for m = 1 to lenMax
check = 0 sub1 = substr(pre[1],1,m) sub2 = substr(pre[2],1,m) sub3 = substr(pre[3],1,m) if sub1 = sub2 and sub2 = sub3 check = 1 ok if check = 1 longest = m ok
next
longPrefix = substr(pre[1],1,longest) longPrefix = rever(longPrefix)
see "Longest common suffix = " + longPrefix + nl
func rever(cstr)
cStr2 = "" for x = len(cStr) to 1 step -1 cStr2 = cStr2 + cStr[x] next return cStr2
</lang>
- Output:
Input: baabababc baabc bbbabc Longest common suffix = abc
Wren
<lang ecmascript>var lcs = Fn.new { |a|
if (a.count == 0) return "" if (a.count == 1) return a[0] var minLen = a.reduce(a[0].count) { |min, s| (s.count < min) ? s.count : min } if (minLen == 0) return "" var res = "" for (i in 1..minLen) { var suffix = a[0][-i..-1] for (e in a.skip(1)) { if (!e.endsWith(suffix)) return res } res = suffix } return res
}
var tests = [
["baabababc","baabc","bbbabc"], ["baabababc","baabc","bbbazc"], ["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"], ["longest", "common", "suffix"], ["suffix"], [""]
] for (test in tests) System.print("%(test) -> \"%(lcs.call(test))\"")</lang>
- Output:
[baabababc, baabc, bbbabc] -> "abc" [baabababc, baabc, bbbazc] -> "c" [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday] -> "day" [longest, common, suffix] -> "" [suffix] -> "suffix" [] -> ""