Longest palindromic substrings: Difference between revisions
m →{{header|Python}}: Added a couple of test strings. |
|||
Line 450: | Line 450: | ||
'stable was I ere I saw elbatrosses', |
'stable was I ere I saw elbatrosses', |
||
'abracadabra', |
'abracadabra', |
||
'drome', |
|||
'abbatial palace' |
|||
]) |
]) |
||
) |
) |
||
Line 508: | Line 510: | ||
'never reverse' -> (['ever reve'], 9) |
'never reverse' -> (['ever reve'], 9) |
||
'stable was I ere I saw elbatrosses' -> (['table was i ere i saw elbat'], 27) |
'stable was I ere I saw elbatrosses' -> (['table was i ere i saw elbat'], 27) |
||
'abracadabra' -> (['aca', 'ada'], 3) |
'abracadabra' -> (['aca', 'ada'], 3) |
||
'drome' -> (['d', 'r', 'o', 'm', 'e'], 1) |
|||
'abbatial palace' -> (['abba'], 4)</pre> |
|||
=={{header|Raku}}== |
=={{header|Raku}}== |
Revision as of 20:14, 29 September 2020
Let given a string s. The goal is to find the longest palindromic substring in s.
Go
<lang go>package main
import (
"fmt" "sort"
)
func reverse(s string) string {
var r = []rune(s) for i, j := 0, len(r)-1; i < j; i, j = i+1, j-1 { r[i], r[j] = r[j], r[i] } return string(r)
}
func longestPalSubstring(s string) []string {
var le = len(s) if le <= 1 { return []string{s} } targetLen := le var longest []string i := 0 for { j := i + targetLen - 1 if j < le { ss := s[i : j+1] if reverse(ss) == ss { longest = append(longest, ss) } i++ } else { if len(longest) > 0 { return longest } i = 0 targetLen-- } } return longest
}
func distinct(sa []string) []string {
sort.Strings(sa) duplicated := make([]bool, len(sa)) for i := 1; i < len(sa); i++ { if sa[i] == sa[i-1] { duplicated[i] = true } } var res []string for i := 0; i < len(sa); i++ { if !duplicated[i] { res = append(res, sa[i]) } } return res
}
func main() {
strings := []string{"babaccd", "rotator", "reverse", "forever", "several", "palindrome", "abaracadaraba"} fmt.Println("The palindromic substrings having the longest length are:") for _, s := range strings { longest := distinct(longestPalSubstring(s)) fmt.Printf(" %-13s Length %d -> %v\n", s, len(longest[0]), longest) }
}</lang>
- Output:
The palindromic substrings having the longest length are: babaccd Length 3 -> [aba bab] rotator Length 7 -> [rotator] reverse Length 5 -> [rever] forever Length 5 -> [rever] several Length 3 -> [eve] palindrome Length 1 -> [a d e i l m n o p r] abaracadaraba Length 3 -> [aba aca ada ara]
Haskell
A list version, written out of curiosity. A faster approach could be made with an indexed datatype.
<lang haskell>-------------- LONGEST PALINDROMIC SUBSTRINGS ------------ longestPalindromes :: String -> ([String], Int) longestPalindromes s = go $ palindromes s
where go xs | null xs = (return <$> s, 1) | otherwise = (filter ((w ==) . length) xs, w) where w = maximum $ length <$> xs
palindromes :: String -> [String] palindromes = fmap go . palindromicNuclei
where go (pivot, (xs, ys)) = let suffix = fmap fst (takeWhile (uncurry (==)) (zip xs ys)) in reverse suffix <> pivot <> suffix
palindromicNuclei :: String -> [(String, (String, String))] palindromicNuclei =
concatMap go . init . tail . ((zip . scanl (flip ((<>) . return)) []) <*> scanr (:) []) where go (a@(x:_), b@(h:y:ys)) = if x == h then [("", (a, b))] else [ ([h], (a, y : ys)) | x == y ] go _ = []
TEST -------------------------
main :: IO () main =
putStrLn $ fTable "Longest palindromic substrings:\n" show show longestPalindromes [ "three old rotators" , "never reverse" , "stable was I ere I saw elbatrosses" , "abracadabra" , "drome" , "abba" ]
FORMATTING ----------------------
fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String fTable s xShow fxShow f xs =
unlines $ s : fmap (((++) . rjust w ' ' . xShow) <*> ((" -> " ++) . fxShow . f)) xs where rjust n c = drop . length <*> (replicate n c ++) w = maximum (length . xShow <$> xs)</lang>
- Output:
Longest palindromic substrings: "three old rotators" -> (["rotator"],7) "never reverse" -> (["ever reve"],9) "stable was I ere I saw elbatrosses" -> (["table was I ere I saw elbat"],27) "abracadabra" -> (["aca","ada"],3) "drome" -> (["d","r","o","m","e"],1) "abba" -> (["abba"],4)
Julia
<lang julia>function allpalindromics(s)
list, len = String[], length(s) for i in 1:len-1, j in i+1:len substr = s[i:j] if substr == reverse(substr) push!(list, substr) end end return list
end
for teststring in ["babaccd", "rotator", "reverse", "forever", "several", "palindrome"]
list = sort!(allpalindromics(teststring), lt = (x, y) -> length(x) < length(y)) println(isempty(list) ? "No palindromes of 2 or more letters found in \"$teststring." : "The longest palindromic substring of $teststring is: \"", join(list[findall(x -> length(x) == length(list[end]), list)], "\" or \""), "\"")
end
</lang>
- Output:
The longest palindromic substring of babaccd is: "bab" or "aba" The longest palindromic substring of rotator is: "rotator" The longest palindromic substring of reverse is: "rever" The longest palindromic substring of forever is: "rever" The longest palindromic substring of several is: "eve" No palindromes of 2 or more letters found in "palindrome."
Manacher algorithm
<lang julia> function manacher(str)
s = "^" * join(split(str, ""), "#") * "\$" len = length(s) pals = fill(0, len) center, right = 1, 1 for i in 2:len-1 pals[i] = right > i && right - i > 0 && pals[2 * center - i] > 0 while s[i + pals[i] + 1] == s[i - pals[i] - 1] pals[i] += 1 end if i + pals[i] > right center, right = i, i + pals[i] end end maxlen, centerindex = findmax(pals) start = isodd(maxlen) ? (centerindex-maxlen) ÷ 2 + 1 : (centerindex-maxlen) ÷ 2 return str[start:(centerindex+maxlen)÷2]
end
for teststring in ["babaccd", "rotator", "reverse", "forever", "several", "palindrome", "abaracadabra"]
pal = manacher(teststring) println(length(pal) < 2 ? "No palindromes of 2 or more letters found in \"$teststring.\"" : "The longest palindromic substring of $teststring is: \"$pal\"")
end
</lang>
- Output:
The longest palindromic substring of babaccd is: "aba" The longest palindromic substring of rotator is: "rotator" The longest palindromic substring of reverse is: "rever" The longest palindromic substring of forever is: "rever" The longest palindromic substring of several is: "eve" No palindromes of 2 or more letters found in "palindrome." The longest palindromic substring of abaracadabra is: "ara"
Phix
<lang Phix>function longest_palindromes(string s) -- s = lower/strip_spaces_and_punctuation/utf8_to_utf32, if rqd
integer longest = 2 -- (do not treat length 1 as palindromic)
-- integer longest = 1 -- (do not treat length 0 as palindromic) [works just fine too]
sequence res = {} for i=1 to length(s) do for e=length(s) to i+longest-1 by -1 do if s[e]=s[i] then string p = s[i..e] integer lp = length(p) if lp>=longest and p=reverse(p) then if lp>longest then longest = lp res = {p} elsif not find(p,res) then -- (or just "else") res = append(res,p) end if end if end if end for end for return res -- (or "sort(res)" or "unique(res)", as needed)
end function
constant tests = {"babaccd","rotator","reverse","forever","several","palindrome","abaracadaraba"} for i=1 to length(tests) do
printf(1,"%s: %v\n",{tests[i],longest_palindromes(tests[i])})
end for</lang>
- Output:
babaccd: {"bab","aba"} rotator: {"rotator"} reverse: {"rever"} forever: {"rever"} several: {"eve"} palindrome: {} abaracadaraba: {"aba","ara","aca","ada"}
with longest initialised to 1, you get the same except for palindrome: {"p","a","l","i","n","d","r","o","m","e"}
faster
<lang Phix>function Manacher(string text)
-- Manacher's algorithm (linear time) -- based on https://www.geeksforgeeks.org/manachers-algorithm-linear-time-longest-palindromic-substring-part-4 -- but with a few tweaks, renames, and bugfixes (in particular the < (positions-1), which I later found LIJIE already said) sequence res = {} integer positions = length(text)*2+1 if positions>1 then sequence LPS = repeat(0,positions) LPS[2] = 1 integer centerPosition = 1, centerRightPosition = 2, maxLPSLength = 0 for currentRightPosition=2 to positions-1 do integer lcp = LPS[currentRightPosition+1], diff = centerRightPosition - currentRightPosition -- If currentRightPosition is within centerRightPosition if diff >= 0 then -- get currentLeftPosition iMirror for currentRightPosition integer iMirror = 2*centerPosition-currentRightPosition + 1 lcp = min(LPS[iMirror], diff) end if -- Attempt to expand palindrome centered at currentRightPosition -- Here for odd positions, we compare characters and -- if match then increment LPS Length by ONE -- If even position, we just increment LPS by ONE without -- any character comparison while ((currentRightPosition + lcp) < (positions-1) and (currentRightPosition - lcp) > 0) and ((remainder(currentRightPosition+lcp+1, 2) == 0) or (text[floor((currentRightPosition+lcp+1)/2)+1] == text[floor((currentRightPosition-lcp-1)/2)+1] )) do lcp += 1 end while LPS[currentRightPosition+1] = lcp maxLPSLength = max(lcp,maxLPSLength) // If palindrome centered at currentRightPosition // expand beyond centerRightPosition, // adjust centerPosition based on expanded palindrome. if (currentRightPosition + lcp) > centerRightPosition then centerPosition = currentRightPosition centerRightPosition = currentRightPosition + lcp end if end for for p=1 to positions do if LPS[p] = maxLPSLength then integer start = floor((p-1 - maxLPSLength)/2) + 1, finish = start + maxLPSLength - 1 string r = text[start..finish] if not find(r,res) then res = append(res,r) end if end if end for end if return res
end function
include mpfr.e mpfr pi = mpfr_init(0,-10001) -- (set precision to 10,000 dp, plus the "3.") mpfr_const_pi(pi) string piStr = mpfr_sprintf("%.10000Rf", pi),
s = shorten(piStr)
printf(1,"%s: %v\n",{s,Manacher(piStr)})</lang>
- Output:
(Same as above if given the same inputs.)
However, while Manacher finishes 10,000 digits in 0s, longest_palindromes takes 1s for 2,000 digits, 15s for 5,000 digits, and 2 mins for 10,000 digits,
which goes to prove that longest_palindromes() above is O(n2), whereas Manacher() is O(n).
3.141592653589793238...05600101655256375679 (10,002 digits): {"398989893","020141020"}
Then again, this is also pretty fast (same output):
<lang Phix>function longest_palindromes_raku(string s) -- s = lower/strip_spaces_and_punctuation/utf8_to_utf32, if rqd
integer longest = 2 -- (do not treat length 1 as palindromic)
-- integer longest = 1 -- (do not treat length 0 as palindromic) [works just fine too]
sequence res = {} for i=1 to length(s) do integer rev = iff(i>1 and s[i-1]=s[i]?1:0), fwd = 0 while rev<i and i+fwd<=length(s) and s[i-rev]=s[i+fwd] do rev += 1 fwd += 1 end while string p = s[i-rev+1..i+fwd-1] integer lp = length(p) if lp>=longest then if lp>longest then longest = lp res = {p} elsif not find(p,res) then -- (or just "else") res = append(res,p) end if end if end for return res -- (or "sort(res)" or "unique(res)", as needed)
end function
printf(1,"%s: %v\n",{s,longest_palindromes_raku(piStr)})</lang>
Python
Defines maximal expansions of any two or three character palindromic nuclei in the string.
(This version ignores case but allows non-alphanumerics). <lang python>Longest palindromic substrings
- longestPalindrome :: String -> ([String], Int)
def longestPalindromes(s):
All palindromes of the maximal length drawn from a case-flattened copy of the given string, tupled with the maximal length. Non alphanumerics are included here. k = s.lower() palindromes = [ palExpansion(k)(ab) for ab in palindromicNuclei(k) ] maxLength = max([ len(x) for x in palindromes ]) if palindromes else 1 return ( [ x for x in palindromes if maxLength == len(x) ] if palindromes else list(s), maxLength )
- palindromicNuclei :: String -> [(Int, Int)]
def palindromicNuclei(s):
Ranges of all the 2 or 3 character palindromic nuclei in s. cs = list(s) return [ # Two-character nuclei. (i, 1 + i) for (i, (a, b)) in enumerate(zip(cs, cs[1:])) if a == b ] + [ # Three-character nuclei. (i, 2 + i) for (i, (a, b, c)) in enumerate(zip(cs, cs[1:], cs[2:])) if a == c ]
- palExpansion :: String -> (Int, Int) -> String
def palExpansion(s):
Full expansion of the palindromic nucleus with the given range in s. iEnd = len(s) - 1
def p(ij): i, j = ij return 0 == i or iEnd == j or s[i-1] != s[j+1]
def expansion(ij): i, j = ij return (i - 1, 1 + j)
def go(ij): ab = until(p)(expansion)(ij) return s[ab[0]:ab[1] + 1] return go
- ------------------------- TEST -------------------------
- main :: IO ()
def main():
Longest palindromic substrings print( fTable(main.__doc__ + ':\n')(repr)(repr)( longestPalindromes )([ 'three old rotators', 'never reverse', 'stable was I ere I saw elbatrosses', 'abracadabra', 'drome', 'abbatial palace' ]) )
- ----------------------- GENERIC ------------------------
- until :: (a -> Bool) -> (a -> a) -> a -> a
def until(p):
The result of repeatedly applying f until p holds. The initial seed value is x. def go(f): def g(x): v = x while not p(v): v = f(v) return v return g return go
- ---------------------- FORMATTING ----------------------
- fTable :: String -> (a -> String) ->
- (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
Heading -> x display function -> fx display function -> f -> xs -> tabular string. def gox(xShow): def gofx(fxShow): def gof(f): def goxs(xs): ys = [xShow(x) for x in xs] w = max(map(len, ys))
def arrowed(x, y): return y.rjust(w, ' ') + ' -> ' + ( fxShow(f(x)) ) return s + '\n' + '\n'.join( map(arrowed, xs, ys) ) return goxs return gof return gofx return gox
- MAIN ---
if __name__ == '__main__':
main()</lang>
- Output:
Longest palindromic substrings: 'three old rotators' -> (['rotator'], 7) 'never reverse' -> (['ever reve'], 9) 'stable was I ere I saw elbatrosses' -> (['table was i ere i saw elbat'], 27) 'abracadabra' -> (['aca', 'ada'], 3) 'drome' -> (['d', 'r', 'o', 'm', 'e'], 1) 'abbatial palace' -> (['abba'], 4)
Raku
This version regularizes (ignores) case and ignores non alphanumeric characters. It is only concerned with finding the longest palindromic substrings so does not exhaustively find all possible palindromes. If a palindromic substring is found to be part of a longer palindrome, it is not captured separately. Showing the longest 5 palindromic substring groups. Run it with no parameters to operate on the default; pass in a file name to run it against that instead.
<lang perl6>my @chars = ( @*ARGS[0] ?? @*ARGS[0].IO.slurp !! q:to/BOB/ ) .lc.comb: /\w/;
Lyrics to "Bob" copyright Weird Al Yankovic https://www.youtube.com/watch?v=JUQDzj6R3p4
I, man, am regal - a German am I Never odd or even If I had a hi-fi Madam, I'm Adam Too hot to hoot No lemons, no melon Too bad I hid a boot Lisa Bonet ate no basil Warsaw was raw Was it a car or a cat I saw?
Rise to vote, sir Do geese see God? "Do nine men interpret?" "Nine men," I nod Rats live on no evil star Won't lovers revolt now? Race fast, safe car Pa's a sap Ma is as selfless as I am May a moody baby doom a yam?
Ah, Satan sees Natasha No devil lived on Lonely Tylenol Not a banana baton No "x" in "Nixon" O, stone, be not so O Geronimo, no minor ego "Naomi," I moan "A Toyota's a Toyota" A dog, a panic in a pagoda
Oh no! Don Ho! Nurse, I spy gypsies - run! Senile felines Now I see bees I won UFO tofu We panic in a pew Oozy rat in a sanitary zoo God! A red nugget! A fat egg under a dog! Go hang a salami, I'm a lasagna hog! BOB
- "
my @cpfoa;
my int $i = 1;
loop {
last if $i >= @chars; my int ($rev, $fwd) = 0, 0; ++$rev if @chars[$i - 1] eq @chars[$i]; loop { quietly last if $rev > $i or $rev && (@chars[$i - $rev] ne @chars[$i + $fwd]); $rev = $rev + 1; $fwd = $fwd + 1; } @cpfoa[(my $pal = @chars[$i - $rev ^..^ $i + $fwd].join).chars].push: $pal if $rev + $fwd > 2; $i = $i + 1;
}
.unique.sort.put for @cpfoa.grep( *.so ).tail(5).reverse; </lang>
- Output:
doninemeninterpretninemeninod godarednuggetafateggunderadog gohangasalamiimalasagnahog arwontloversrevoltnowra imanamregalagermanami mayamoodybabydoomayam ootnolemonsnomelontoo oozyratinasanitaryzoo ratsliveonnoevilstar
This isn't intensively optimised but isn't too shabby either. When run against the first million digits of pi: http://www.eveandersson.com/pi/digits/1000000 (Pass in the file path/name at the command line) we get:
9475082805749 450197791054 04778787740 09577577590 28112721182 41428782414 49612121694 53850405835 84995859948 0045445400 0136776310 1112552111 3517997153 5783993875 6282662826 7046006407 7264994627 8890770988 019161910 020141020 023181320 036646630 037101730 037585730 065363560 068363860 087191780 091747190 100353001 104848401 111262111 131838131 132161231 156393651 160929061 166717661 182232281 193131391 193505391 207060702 211878112 222737222 223404322 242424242 250171052 258232852 267919762 272636272 302474203 313989313 314151413 314424413 318272813 323212323 330626033 332525233 336474633 355575553 357979753 365949563 398989893 407959704 408616804 448767844 450909054 463202364 469797964 479797974 480363084 489696984 490797094 532121235 549161945 557040755 563040365 563828365 598292895 621969126 623707326 636414636 641949146 650272056 662292266 667252766 681565186 712383217 720565027 726868627 762727267 769646967 777474777 807161708 819686918 833303338 834363438 858838858 866292668 886181688 895505598 896848698 909565909 926676629 927202729 929373929 944525449 944848449 953252359 972464279 975595579 979202979 992868299
in slightly more than 12 seconds on my system.
REXX
<lang rexx>/*REXX program finds and displays the longest palindromic string(s) in a given string. */ parse arg s /*obtain optional argument from the CL.*/ if s== | s=="," then s= 'babaccd rotator reverse forever several palindrome abaracadaraba'
/* [↑] the case of strings is respected*/ do i=1 for words(s); say /*search each of the (S) strings. */ x= word(s, i); L= length(x) /*get a string to be examined & length.*/ m= 0 do LL=2 for L-1 /*start with palindromes of length two.*/ if find(1) then m= max(m,LL) /*Found a palindrom? Set M=new length.*/ end /*LL*/ LL= max(1,m) call find . say ' longest palindromic substrings for string: ' x say '────────────────────────────────────────────'copies('─', 2 + L) do n=1 for words(@) /*show longest palindromic substrings. */ say ' (length='LL") " word(@, n) end /*n*/ say end /*i*/
exit 0 /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ find: parse arg short /*if SHORT==1, only find 1 palendrome.*/
@= /*initialize palindrome list to a null.*/ do j=1 for L-LL+1 /*obtain length of possible palindromes*/ $= substr(x, j, LL) /*obtain a possible palindromic substr.*/ if $\==reverse($) then iterate /*Not a palindrome? Then skip it.*/ @= @ $ /*add a palindromic substring to a list*/ if short==1 then return 1 /*have found one palindrome. */ end /*j*/; return 0 /* " " some palindrome(s). */</lang>
- output when using the default input:
longest palindromic substrings for string: babaccd ───────────────────────────────────────────────────── (length=3) bab (length=3) aba longest palindromic substrings for string: rotator ───────────────────────────────────────────────────── (length=7) rotator longest palindromic substrings for string: reverse ───────────────────────────────────────────────────── (length=5) rever longest palindromic substrings for string: forever ───────────────────────────────────────────────────── (length=5) rever longest palindromic substrings for string: several ───────────────────────────────────────────────────── (length=3) eve longest palindromic substrings for string: palindrome ──────────────────────────────────────────────────────── (length=1) p (length=1) a (length=1) l (length=1) i (length=1) n (length=1) d (length=1) r (length=1) o (length=1) m (length=1) e longest palindromic substrings for string: abaracadaraba ─────────────────────────────────────────────────────────── (length=3) aba (length=3) ara (length=3) aca (length=3) ada (length=3) ara (length=3) aba
Ring
<lang ring> load "stdlib.ring"
st = "babaccd" palList = []
for n = 1 to len(st)-1
for m = n+1 to len(st) sub = substr(st,n,m-n) if ispalindrome(sub) and len(sub) > 1 add(palList,[sub,len(sub)]) ok next
next
palList = sort(palList,2) palList = reverse(palList) resList = [] add(resList,palList[1][1])
for n = 2 to len(palList)
if palList[1][2] = palList[n][2] add(resList,palList[n][1]) ok
next
see "Input: " + st + nl see "Longest palindromic substrings:" + nl see resList </lang>
- Output:
Input: babaccd Longest palindromic substrings: bab aba
Wren
I've assumed that the expression 'substring' includes the string itself and that substrings of length 1 are considered to be palindromic. Also that if there is more than one palindromic substring of the longest length, then all such distinct ones should be returned.
The Phix entry examples have been used. <lang ecmascript>import "/seq" for Lst import "/fmt" for Fmt
var longestPalSubstring = Fn.new { |s|
var len = s.count if (len <= 1) return [s] var targetLen = len var longest = [] var i = 0 while (true) { var j = i + targetLen - 1 if (j < len) { var ss = s[i..j] if (ss == ss[-1..0]) longest.add(ss) i = i + 1 } else { if (longest.count > 0) return longest i = 0 targetLen = targetLen - 1 } }
}
var strings = ["babaccd", "rotator", "reverse", "forever", "several", "palindrome", "abaracadaraba"] System.print("The palindromic substrings having the longest length are:") for (s in strings) {
var longest = Lst.distinct(longestPalSubstring.call(s)) Fmt.print(" $-13s Length $d -> $n", s, longest[0].count, longest)
}</lang>
- Output:
The palindromic substrings having the longest length are: babaccd Length 3 -> [bab, aba] rotator Length 7 -> [rotator] reverse Length 5 -> [rever] forever Length 5 -> [rever] several Length 3 -> [eve] palindrome Length 1 -> [p, a, l, i, n, d, r, o, m, e] abaracadaraba Length 3 -> [aba, ara, aca, ada]