Longest common suffix: Difference between revisions
(Added AppleScript.) |
m (→{{header|AppleScript}}: Added a declarative (functional) draft, using library functions whenever possible.) |
||
Line 5: | Line 5: | ||
=={{header|AppleScript}}== |
=={{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. |
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: | Line 55: | ||
longestCommonSuffix({"remark", "spark", "aardvark"}) --> "ark" |
longestCommonSuffix({"remark", "spark", "aardvark"}) --> "ark" |
||
longestCommonSuffix({"ectoplasm", "banana"}) --> ""</lang> |
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}}== |
=={{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" [] -> ""