Longest palindromic substrings
Let given a string s. The goal is to find the longest palindromic substring in s.
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contain the most consonants
- Find words which contains more than 3 vowels
- Find words whose first and last three letters are equal
- Find words with alternating vowels and consonants
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 bottles of beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
11l
F longest_palindrome(s)
V t = Array(‘^’s‘$’).join(‘#’)
V n = t.len
V p = [0] * n
V c = 0
V r = 0
L(i) 1 .< n - 1
p[i] = (r > i) & min(r - i, p[2 * c - i]) != 0
L t[i + 1 + p[i]] == t[i - 1 - p[i]]
p[i]++
I i + p[i] > r
(c, r) = (i, i + p[i])
V (max_len, center_index) = max(enumerate(p).map((i, n) -> (n, i)))
R s[(center_index - max_len) I/ 2 .< (center_index + max_len) I/ 2]
L(s) [‘three old rotators’,
‘never reverse’,
‘stable was I ere I saw elbatrosses’,
‘abracadabra’,
‘drome’,
‘the abbatial palace’]
print(‘'’s‘' -> '’longest_palindrome(s)‘'’)
- Output:
'three old rotators' -> 'rotator' 'never reverse' -> 'ever reve' 'stable was I ere I saw elbatrosses' -> 'table was I ere I saw elbat' 'abracadabra' -> 'ada' 'drome' -> 'e' 'the abbatial palace' -> 'abba'
Action!
BYTE FUNC Palindrome(CHAR ARRAY s)
BYTE l,r
l=1 r=s(0)
WHILE l<r
DO
IF s(l)#s(r) THEN RETURN (0) FI
l==+1 r==-1
OD
RETURN (1)
PROC Find(CHAR ARRAY text,res)
BYTE first,len
len=text(0)
WHILE len>0
DO
FOR first=1 TO text(0)-len+1
DO
SCopyS(res,text,first,first+len-1)
IF Palindrome(res) THEN
RETURN
FI
OD
len==-1
OD
res(0)=0
RETURN
PROC Test(CHAR ARRAY text)
CHAR ARRAY res(100)
Find(text,res)
PrintF("""%S"" -> ""%S""%E",text,res)
RETURN
PROC Main()
Test("three old rotators")
Test("never reverse")
Test("abracadabra")
Test("the abbatial palace")
Test("qwertyuiop")
Test("")
RETURN
- Output:
Screenshot from Atari 8-bit computer
"three old rotators" -> "rotator" "never reverse" -> "ever reve" "abracadabra" -> "aca" "the abbatial palace" -> "abba" "qwertyuiop" -> "q" "" -> ""
ALGOL 68
Palindromes of length 1 or more are detected, finds the left most palindrome if there are several of the same length.
Treats upper and lower case as distinct and does not require the characters to be letters.
BEGIN # find the longest palindromic substring of a string #
# returns the length of s #
OP LENGTH = ( STRING s )INT: ( UPB s + 1 ) - LWB s;
# returns s right-padded with blanks to at least w characters or s if it is already wide enough #
PRIO PAD = 1;
OP PAD = ( STRING s, INT w )STRING:
BEGIN
STRING result := s;
WHILE LENGTH result < w DO result +:= " " OD;
result
END # PAD # ;
# returns the longest palindromic substring of s #
# if there are multiple substrings with the longest length, the leftmost is returned #
PROC longest palindromic substring = ( STRING s )STRING:
IF LENGTH s < 2
THEN s
ELSE
INT lwb s = LWB s;
INT upb s = UPB s;
STRING result := s[ lwb s ];
IF s[ lwb s + 1 ] = s[ lwb s ] THEN
# the first two characters are a palindrome #
result +:= s[ lwb s + 1 ]
FI;
FOR i FROM lwb s + 1 TO upb s - 1 DO
INT p start := i;
INT p end := i + 1;
IF IF s[ i - 1 ] = s[ i + 1 ] THEN
# odd length palindrome at i - 1 #
p start -:= 1;
TRUE
ELIF s[ i ] = s[ i + 1 ] THEN
# even length palindrome at i #
TRUE
ELSE FALSE
FI
THEN
# have a palindrome at p start : p end #
# attempt to enlarge the range #
WHILE IF p start = lwb s OR p end = upb s
THEN FALSE
ELSE s[ p start - 1 ] = s[ p end + 1 ]
FI
DO # can extend he palindrome #
p start -:= 1;
p end +:= 1
OD;
IF ( p end + 1 ) - p start > LENGTH result
THEN
# have a longer palindrome #
result := s[ p start : p end ]
FI
FI
OD;
result
FI # longest palindromic substring # ;
# finds the longest palindromic substring of s and checks it is the expacted value #
PROC test = ( STRING s, expected value )VOID:
BEGIN
STRING palindrome = longest palindromic substring( s );
print( ( ( """" + s + """" ) PAD 38, " -> ", ( """" + palindrome + """" ) PAD 36
, IF palindrome = expected value THEN "" ELSE " NOT " + expected value + " ???" FI
, newline
)
)
END # test longest palindromic substring # ;
test( "three old rotators", "rotator" );
test( "never reverse", "ever reve" );
test( "stable was I ere I saw elbatrosses", "table was I ere I saw elbat" );
test( "abracadabra", "aca" );
test( "drome", "d" );
test( "x", "x" );
test( "the abbatial palace", "abba" );
test( "", "" );
test( "abcc", "cc" );
test( "abbccc", "ccc" )
END
- Output:
"three old rotators" -> "rotator" "never reverse" -> "ever reve" "stable was I ere I saw elbatrosses" -> "table was I ere I saw elbat" "abracadabra" -> "aca" "drome" -> "d" "x" -> "x" "the abbatial palace" -> "abba" "" -> "" "abcc" -> "cc" "abbccc" -> "ccc"
Arturo
palindrome?: function [str]-> str = join reverse split str
lps: function [s][
maxLength: 0
result: new []
loop 0..dec size s 'fst [
loop fst..dec size s 'lst [
candidate: slice s fst lst
if palindrome? candidate [
if? maxLength < size candidate [
result: new @[candidate]
maxLength: size candidate
]
else [
if maxLength = size candidate ->
'result ++ candidate
]
]
]
]
return (maxLength > 1)? -> result
-> []
]
loop ["babaccd", "rotator", "several", "palindrome", "piété", "tantôt", "étêté"] 'str [
palindromes: lps str
print [str "->" (0 < size palindromes)? -> join.with:", " palindromes
-> "X"]
]
- Output:
babaccd -> bab, aba rotator -> rotator several -> eve palindrome -> X piété -> été tantôt -> tôt étêté -> étêté
AutoHotkey
LPS(str){
found := [], result := [], maxL := 0
while (StrLen(str) >= 2 && StrLen(str) >= maxL){
s := str
loop {
while (SubStr(s, 1, 1) <> SubStr(s, 0)) ; while 1st chr <> last chr
s := SubStr(s, 1, StrLen(s)-1) ; trim last chr
if (StrLen(s) < 2 || StrLen(s) < maxL )
break
if (s = reverse(s)){
found.Push(s)
maxL := maxL < StrLen(s) ? StrLen(s) : maxL
break
}
s := SubStr(s, 1, StrLen(s)-1) ; trim last chr
}
str := SubStr(str, 2) ; trim 1st chr and try again
}
maxL := 0
for i, str in found
maxL := maxL < StrLen(str) ? StrLen(str) : maxL
for i, str in found
if (StrLen(str) = maxL)
result.Push(str)
return result
}
reverse(s){
for i, v in StrSplit(s)
output := v output
return output
}
Examples:
db =
(
three old rotators
never reverse
stable was I ere I saw elbatrosses
abracadabra
drome
x
the abbatial palace
)
for i, line in StrSplit(db, "`n", "`r"){
result := "[""", i := 0
for i, str in LPS(line)
result .= str """, """
output .= line "`t> " Trim(result, """, """) (i?"""":"") "]`n"
}
MsgBox % output
return
- Output:
three old rotators > ["rotator"] never reverse > ["ever reve"] stable was I ere I saw elbatrosses > ["table was I ere I saw elbat"] abracadabra > ["aca", "ada"] drome > [] x > [] the abbatial palace > ["abba"]
DuckDB
The maximal_palindrome() function returns a maximal palindromic subsequence, using what is probably a maximally simple approach.
The triple-nesting in this function is necessitated by a current limitation of the DuckDB version being used.
create or replace function is_palindrome(s) as (
with nt as (select length(s) as n)
select not exists
(SELECT i
FROM (select n, unnest(range(1, n+1 // 2)) as i from nt)
WHERE substr(s,i,1) != substr(s, 1 + n - i,1) )
);
# Longest palindrome starting at 1
create or replace function max_palindrome(s) as (
select max_by(sub,i)
from ( SELECT i, substr(s, 1, i) as sub
FROM range(1, length(s)+1) t(i)
WHERE is_palindrome(sub) )
);
# A maximal palindrome within s
create or replace function maximal_palindrome(s) as (
select max_by(p, length(p))
from ( SELECT max_palindrome(sub) as p
FROM (SELECT substr(s, i) as sub
FROM range(1, length(s)) t(i) ))
);
# Examples
select s, maximal_palindrome(s) as maximal_palindromic_subseq
from (select unnest(
['babaccd', 'rotator', 'reverse',
'forever', 'several', 'palindrome',
'abaracadaraba']) as s);
- Output:
┌───────────────┬────────────────────────────┐ │ s │ maximal_palindromic_subseq │ │ varchar │ varchar │ ├───────────────┼────────────────────────────┤ │ babaccd │ bab │ │ rotator │ rotator │ │ reverse │ rever │ │ forever │ rever │ │ several │ eve │ │ palindrome │ p │ │ abaracadaraba │ aba │ └───────────────┴────────────────────────────┘
EasyLang
func$ reverse s$ .
a$[] = strchars s$
for i = 1 to len a$[] div 2
swap a$[i] a$[len a$[] - i + 1]
.
return strjoin a$[] ""
.
func palin s$ .
if s$ = reverse s$
return 1
.
return 0
.
func$ lpali st$ .
for n = 1 to len st$ - 1
for m = n + 1 to len st$
sub$ = substr st$ n (m - n)
if palin sub$ = 1
if len sub$ > len max$
max$ = sub$
.
.
.
.
return max$
.
for s$ in [ "three old rotators" "never reverse" "stable was I ere I saw elbatrosses" "abracadabra" "drome" "the abbatial palace" ]
print lpali s$
.
- Output:
rotator ever reve table was I ere I saw elbat aca d abba
F#
Manacher Function
// Manacher Function. Nigel Galloway: October 1st., 2020
let Manacher(s:string) = let oddP,evenP=Array.zeroCreate s.Length,Array.zeroCreate s.Length
let rec fN i g e (l:int[])=match g>=0 && e<s.Length && s.[g]=s.[e] with true->l.[i]<-l.[i]+1; fN i (g-1) (e+1) l |_->()
let rec fGo n g Ʃ=match Ʃ<s.Length with
false->oddP
|_->if Ʃ<=g then oddP.[Ʃ]<-min (oddP.[n+g-Ʃ]) (g-Ʃ)
fN Ʃ (Ʃ-oddP.[Ʃ]-1) (Ʃ+oddP.[Ʃ]+1) oddP
match (Ʃ+oddP.[Ʃ])>g with true->fGo (Ʃ-oddP.[Ʃ]) (Ʃ+oddP.[Ʃ]) (Ʃ+1) |_->fGo n g (Ʃ+1)
let rec fGe n g Ʃ=match Ʃ<s.Length with
false->evenP
|_->if Ʃ<=g then evenP.[Ʃ]<-min (evenP.[n+g-Ʃ]) (g-Ʃ)
fN Ʃ (Ʃ-evenP.[Ʃ]) (Ʃ+evenP.[Ʃ]+1) evenP
match (Ʃ+evenP.[Ʃ])>g with true->fGe (Ʃ-evenP.[Ʃ]+1) (Ʃ+evenP.[Ʃ]) (Ʃ+1) |_->fGe n g (Ʃ+1)
(fGo 0 -1 0,fGe 0 -1 0)
The Task
let fN g=if g=[||] then (0,0) else g|>Array.mapi(fun n g->(n,g))|>Array.maxBy snd
let lpss s=let n,g=Manacher s in let n,g=fN n,fN g in if (snd n)*2+1>(snd g)*2 then s.[(fst n)-(snd n)..(fst n)+(snd n)] else s.[(fst g)-(snd g)+1..(fst g)+(snd g)]
let test = ["three old rotators"; "never reverse"; "stable was I ere I saw elbatrosses"; "abracadabra"; "drome"; "the abbatial palace"; ""]
test|>List.iter(fun n->printfn "A longest palindromic substring of \"%s\" is \"%s\"" n (lpss n))
- Output:
A longest palindromic substring of "three old rotators" is "rotator" A longest palindromic substring of "never reverse" is "ever reve" A longest palindromic substring of "stable was I ere I saw elbatrosses" is "table was I ere I saw elbat" A longest palindromic substring of "abracadabra" is "aca" A longest palindromic substring of "drome" is "d" A longest palindromic substring of "the abbatial palace" is "abba" A longest palindromic substring of "" is ""
FreeBASIC
Function isPalindrome(s As String) As Integer
For i As Integer = 1 To Len(s) / 2
If Mid(s, i, 1) <> Mid(s, Len(s) - i + 1, 1) Then Return False
Next i
Return True
End Function
Sub LongestPalindrome(s As String)
Dim As String substr, longest = ""
Dim As Integer i, j
For i = 1 To Len(s)
For j = i To Len(s)
substr = Mid(s, i, j - i + 1)
If isPalindrome(substr) Andalso Len(substr) > Len(longest) Then longest = substr
Next j
Next i
Print "The longest palindromic substring is/are: "
For i = 1 To Len(s)
For j = i To Len(s)
substr = Mid(s, i, j - i + 1)
If IsPalindrome(substr) Andalso Len(substr) = Len(longest) Andalso Len(substr) > 2 Then Print substr; " ";
Next j
Next i
If Len(longest) <= 2 Then Print "<no palindromic substring of two of more letters found>"
End Sub
Dim s As String
Input "Enter a string: ", s
LongestPalindrome(s)
Sleep
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)
}
}
- 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.
-------------- LONGEST PALINDROMIC SUBSTRINGS ------------
longestPalindromes :: String -> ([String], Int)
longestPalindromes [] = ([], 0)
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))
| x == h = [("", (a, b))]
| otherwise =
[ ([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"
, "the abbatial palace"
, ""
]
------------------------ 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)
- 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) "the abbatial palace" -> (["abba"],4) "" -> ([],0)
jq
Adapted from #Wren
Works with gojq, the Go implementation of jq
def longestPalindromicSubstring:
length as $len
| if $len <= 1 then .
else explode as $s
| {targetLen: $len, longest: [], i: 0}
| until(.stop;
(.i + .targetLen - 1) as $j
| if $j < $len
then $s[.i:$j+1] as $ss
| if $ss == ($ss|reverse) then .longest += [$ss] else . end
| .i += 1
else
if .longest|length > 0 then .stop=true else . end
| .i = 0
| .targetLen += - 1
end )
| .longest
| map(implode)
| unique
end ;
def strings:
["babaccd", "rotator", "reverse", "forever", "several", "palindrome", "abaracadaraba"];
"The palindromic substrings having the longest length are:",
(strings[]
| longestPalindromicSubstring as $longest
| " \(.): length \($longest[0]|length) -> \($longest)"
)
- 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"]
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
- 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
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
- 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"
Mathematica /Wolfram Language
ClearAll[ExpandSubsequenceTry, LongestPalindromicSubsequence]
ExpandSubsequenceTry[seq_List, beginpos : {a_, b_}] :=
Module[{len, maxbroaden, last},
len = Length[seq];
maxbroaden = Min[a - 1, len - b];
last = maxbroaden;
Do[
If[! PalindromeQ[Take[seq, {a - j, b + j}]],
last = j - 1;
Break[];
]
,
{j, maxbroaden}
];
{a - last, b + last}
]
LongestPalindromicSubsequence[l_List] :=
Module[{evenposs, oddposs, subseqs},
evenposs = SequencePosition[l, {x_, x_}];
oddposs = SequencePosition[l, {x_, y_, x_}];
subseqs = Join[evenposs, oddposs];
subseqs = ExpandSubsequenceTry[l, #] & /@ subseqs;
If[Length[subseqs] > 0,
TakeLargestBy[Take[l, #] & /@ subseqs, Length, 1][[1]]
,
{}
]
]
StringJoin@LongestPalindromicSubsequence[Characters["three old rotators"]]
StringJoin@LongestPalindromicSubsequence[Characters["never reverse"]]
StringJoin@LongestPalindromicSubsequence[Characters["stable was I ere I saw elbatrosses"]]
StringJoin@LongestPalindromicSubsequence[Characters["abracadabra"]]
StringJoin@LongestPalindromicSubsequence[Characters["drome"]]
StringJoin@LongestPalindromicSubsequence[Characters["the abbatial palace"]]
- Output:
"rotator" "ever reve" "table was I ere I saw elbat" "aca" "" "abba"
Nim
Simple algorithm but working on Unicode code points.
import sequtils, strutils, unicode
func isPalindrome(s: seq[Rune]): bool =
## Return true if a sequence of runes is a palindrome.
for i in 1..(s.len shr 1):
if s[i - 1] != s[^i]:
return false
result = true
func lps(s: string): seq[string] =
var maxLength = 0
var list: seq[seq[Rune]]
let r = s.toRunes
for first in 0..r.high:
for last in first..r.high:
let candidate = r[first..last]
if candidate.isPalindrome():
if candidate.len > maxLength:
list = @[candidate]
maxLength = candidate.len
elif candidate.len == maxLength:
list.add candidate
if maxLength > 1:
result = list.mapIt($it)
for str in ["babaccd", "rotator", "several", "palindrome", "piété", "tantôt", "étêté"]:
let result = lps(str)
if result.len == 0:
echo str, " → ", "<no palindromic substring of two of more letters found>"
else:
echo str, " → ", result.join(", ")
- Output:
babaccd → bab, aba rotator → rotator several → eve palindrome → <no palindromic substring of two of more letters found> piété → été tantôt → tôt étêté → étêté
Pascal
Free Pascal
program FindLongestPalindrome;
uses
SysUtils,strutils;
const
arr: array of string = ('three old rotators', 'never reverse', 'stable was I ere I saw elbatrosses', 'abracadabra', 'drome', 'the abbatial palace', '');
var
st, longestPalindrome, dummy: string;
i, j, longest: integer;
begin
for st in arr do
begin
longest := 0;
longestPalindrome := '';
for i := 1 to Length(st) do
begin
for j := Length(st) downto i do
begin
dummy := Copy(st, i, j - i + 1);
if (j - i + 1 > longest) and (dummy = ReverseString(dummy)) then
begin
longest := j - i + 1;
longestPalindrome := dummy;
end;
end;
end;
WriteLn(Format('%-35s -> %s', [st, longestPalindrome]));
end;
end.
- Output:
three old rotators -> rotator never reverse -> ever reve stable was I ere I saw elbatrosses -> table was I ere I saw elbat abracadabra -> aca drome -> d the abbatial palace -> abba ->
Perl
The short one - find all palindromes with one regex.
use strict;
use warnings;
print "Longest Palindrome For $_ = @{[ longestpalindrome($_) ]}\n"
for qw(babaccd rotator reverse forever several palindrome abaracadabra);
sub longestpalindrome
{
my @best = {"''" => 0};
pop =~ /(.+) .? (??{reverse $1}) (?{ $best[length $&]{$&}++ }) (*FAIL)/x;
keys %{pop @best};
}
- Output:
Longest Palindrome For babaccd = aba bab Longest Palindrome For rotator = rotator Longest Palindrome For reverse = rever Longest Palindrome For forever = rever Longest Palindrome For several = eve Longest Palindrome For palindrome = '' Longest Palindrome For abaracadabra = aba ara aca ada
The faster one - does the million digits of Pi in under half a second.
use strict;
use warnings;
use feature 'bitwise';
#@ARGV = 'pi.dat'; # uncomment to use this file or add filename to command line
my $forward = lc do { local $/; @ARGV ? <> : <DATA> };
$forward =~ s/\W+//g;
my $range = 10;
my $backward = reverse $forward;
my $length = length $forward;
my @best = {"''" => 0};
my $len;
for my $i ( 1 .. $length - 2 )
{
do
{
my $right = substr $forward, $i, $range;
my $left = substr $backward, $length - $i, $range;
( $right ^. $left ) =~ /^\0\0+/ and # evens
($len = 2 * length $&) >= $#best and
$best[ $len ]{substr $forward, $i - length $&, $len}++;
( $right ^. "\0" . $left ) =~ /^.(\0+)/ and # odds
($len = 1 + 2 * length $1) >= $#best and
$best[ $len ]{substr $forward, $i - length $1, $len}++;
} while $range < $#best and $range = $#best;
}
print "Longest Palindrome ($#best) : @{[ keys %{ $best[-1] } ]}\n";
__DATA__
this data borrowed from raku...
Never odd or even
Was it a car or a cat I saw?
Too bad I hid a boot
I, man, am regal - a German am I
toot
Warsaw was raw
- Output:
Longest Palindrome (27) : ootimanamregalagermanamitoo
Phix
-- demo/rosetta/Longest_palindromic_substrings.exw (plus two older versions) with javascript_semantics 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 j=0 to iff(i>1 and s[i-1]=s[i]?2:1) do integer rev = j, fwd = 1 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 end for return res -- (or "sort(res)" or "unique(res)", as needed) end function constant tests = {"babaccd","rotator","reverse","forever","several","palindrome","abaracadaraba","abbbc"} for i=1 to length(tests) do printf(1,"%s: %v\n",{tests[i],longest_palindromes(tests[i])}) end for
- Output:
babaccd: {"bab","aba"} rotator: {"rotator"} reverse: {"rever"} forever: {"rever"} several: {"eve"} palindrome: {} abaracadaraba: {"aba","ara","aca","ada"} abbbc: {"bbb"}
with longest initialised to 1, you get the same except for palindrome: {"p","a","l","i","n","d","r","o","m","e"}
Python
Defines maximal expansions of any two or three character palindromic nuclei in the string.
(This version ignores case but allows non-alphanumerics).
'''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
) if s else ([], 0)
# 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 limit(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(limit)(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',
'the 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()
- 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) 'the abbatial palace' -> (['abba'], 4) '' -> ([], 0)
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.
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 = flat
(1 ..^ @chars).race(:1000batch).map: -> \idx {
my @s;
for 1, 2 {
my int ($rev, $fwd) = $_, 1;
loop {
quietly last if ($rev > idx) || (@chars[idx - $rev] ne @chars[idx + $fwd]);
$rev = $rev + 1;
$fwd = $fwd + 1;
}
@s.push: @chars[idx - $rev ^..^ idx + $fwd].join if $rev + $fwd > 2;
last if @chars[idx - 1] ne @chars[idx];
}
next unless +@s;
@s
}
"{.key} ({+.value})\t{.value.unique.sort}".put for @cpfoa.classify( *.chars ).sort( -*.key ).head(5);
- Output:
Returns the length, (the count) and the list:
29 (2) doninemeninterpretninemeninod godarednuggetafateggunderadog 26 (1) gohangasalamiimalasagnahog 23 (1) arwontloversrevoltnowra 21 (4) imanamregalagermanami mayamoodybabydoomayam ootnolemonsnomelontoo oozyratinasanitaryzoo 20 (1) ratsliveonnoevilstar
This isn't intensively optimised but isn't too shabby either. When run against the first million digits of pi: 1000000 digits of pi text file (Pass in the file path/name at the command line) we get:
13 (1) 9475082805749 12 (1) 450197791054 11 (8) 04778787740 09577577590 21348884312 28112721182 41428782414 49612121694 53850405835 84995859948 10 (9) 0045445400 0136776310 1112552111 3517997153 5783993875 6282662826 7046006407 7264994627 8890770988 9 (98) 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 546000645 549161945 557040755 559555955 563040365 563828365 598292895 621969126 623707326 636414636 636888636 641949146 650272056 662292266 667252766 681565186 684777486 712383217 720565027 726868627 762727267 769646967 777474777 807161708 819686918 833303338 834363438 858838858 866292668 886181688 895505598 896848698 909565909 918888819 926676629 927202729 929373929 944525449 944848449 953252359 972464279 975595579 979202979 992868299
in right around 7 seconds on my system.
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); x= word(s, i) /*obtain a string to be examined. */
L= length(x); m= 0 /*get the string's length; Set max len.*/
do LL=2 for L-1 /*start with palindromes of length two.*/
if find(1) then m= max(m, LL) /*Found a palindrome? Set M=new length*/
end /*LL*/
LL= max(1, m)
call find 0 /*find all palindromes with length LL.*/
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) /*display a " substring. */
end /*n*/; say; say /*display a two─blank separation fence.*/
end /*i*/
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
find: parse arg short /*if SHORT==1, only find 1 palindrome.*/
@= /*initialize palindrome list to a null.*/
do j=1 for L-LL+1; $= 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 then return 1 /*we have found one palindrome. */
end /*j*/; return 0 /* " " " some palindrome(s). */
- 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
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
- Output:
Input: babaccd Longest palindromic substrings: bab aba
Rust
fn manacher(input: &str) -> String {
let s = String::from("^") + input.split("").collect::<Vec<&str>>().join("#").as_str() + "$";
let len = s.len();
let mut pals = vec![0_usize; len];
let (mut center, mut right) = (0_usize, 0_usize);
for i in 1..len - 1 {
pals[i] = (right > i && right - i > 0 && pals[2 * center + 1 - i] > 0) as usize;
while s.as_bytes()[i + pals[i] + 1] == s.as_bytes()[i - pals[i] - 1] {
pals[i] += 1;
}
if i + pals[i] > right {
(center, right) = (i + 1, i + pals[i]);
}
}
let (centerindex, maxlen) =
pals.iter()
.enumerate()
.fold((0, 0), |max, (i, v)| if v > &max.1 { (i, *v) } else { max });
return input[(centerindex - maxlen) / 2..(centerindex + maxlen) / 2].to_string();
}
fn main() {
for teststring in [
"babaccd",
"rotator",
"reverse",
"forever",
"several",
"palindrome",
"abracadabra",
] {
let pal = manacher(teststring);
if pal.len() < 2 {
println!(
"No palindromes of 2 or more letters found in \"{}.\"",
teststring
);
} else {
println!(
"The longest palindromic substring of {} is: \"{}\"",
teststring, pal
);
}
}
}
- Output:
The longest palindromic substring of babaccd is: "bab" 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 abracadabra is: "aca"
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.
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)
}
- 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]