# Largest palindrome from given string

Someone recently posted a request on LinkedIn for an algorithm to find the largest palindrome from a given string.

I came up with this, which I believe does the trick, but I am wondering if there are more elegant and/or faster solutions?

nlargest = 5;

TakeLargestBy[Cases[StringCases[#1, __, Overlaps -> All], _?PalindromeQ],
StringLength, #2] &[teststring, nlargest] // Flatten

with result:

• Your code is corrupted, please fix it. – Kuba Dec 5 '16 at 19:19
• PalindromeQ is new in 10.3.. in case anyone else has issues with this. – george2079 Dec 5 '16 at 19:36

Brute force but more compact:

StringCases[
teststring,
x : Repeated[LetterCharacter, {2, ∞}] /; PalindromeQ[x],
Overlaps -> True
] // MaximalBy[StringLength]

{"acivica", "deified"}

edit: I've replaced _ with LetterCharacter since we are not interested in palindromes across many words.

• a better solution. I couldn't figure out how to get StringCases to work for this. – Jonathan Kinlay Dec 5 '16 at 19:40

A non-pattern version of Kuba's solution would be this:

MaximalBy[Select[
StringJoin /@ Subsequences[Characters[str]],
PalindromeQ
], StringLength]

{"acivica", "deified"}

The following is a solution in many cases, but Kuba noted that it only works if the string does not contain substrings which are reversed copies of each other, and happen to be longer than any real palindrome in the string.

str2 = StringReverse[str];

LongestCommonSubsequence[str, str2]

"acivica"

• This doesn't appear to work. For example: Aeneid = ExampleData[{"Text", "AeneidEnglish"}]; LongestCommonSubsequence[teststring, StringReverse[teststring]] produces the answer: tes d – Jonathan Kinlay Dec 6 '16 at 9:37
• @JonathanKinlay This is because of the same problem that Kuba pointed out to me, which I've remarked upon in my answer. Somewhere in the text is the reverse string, "d set". I guess you could add another caveat: it does not work well with spaces. However, spaces were not part of the original problem. – C. E. Dec 6 '16 at 9:53

Manacher's algorithm is much faster than brute-force solutions. ($O(n)$ vs $O(n^3)$) Here's an implementation (it only returns the first longest palindrome though):

findLongestPalindrome[""] = "";
findLongestPalindrome[s_String] :=
FromCharacterCode @ findLongestPalindromeList[ToCharacterCode @ s];

findLongestPalindromeList = Compile[{{s, _Integer, 1}},
Module[{s2, p, c, r, n, m, i2, len, cc},
s2 = Riffle[s, -1, {1, -1, 2}];
p = ConstantArray[0, Length[s2]];
c = 1; r = 1; m = 1; n = 1; len = 0; cc = 1;
Do[
If[i > r,
p[[i]] = 0; m = i - 1; n = i + 1,
i2 = 2 c - i;
If[p[[i2]] < (r - i),
p[[i]] = p[[i2]]; m = 0,
p[[i]] = r - i; n = r + 1; m = 2 i - n
]
];
If[OddQ[m],p[[i]]++; m--; n++];
While[m > 0 && n <= Length[s2] && s2[[m]] == s2[[n]],
p[[i]] += 2; m -= 2; n += 2;
];
If[(i + p[[i]]) > r,
c = i; r = i + p[[i]];
];
If[len < p[[i]],
len = p[[i]]; cc = i;
],
{i,2,Length[s2]}
];
s[[Quotient[cc - len + 1, 2] ;; Quotient[cc + len - 1, 2]]]
]
]

StringLength[aeneid] (* 606071 *)
AbsoluteTiming[findLongestPalindrome[aeneid]] (* {0.236135, "man nam"} *)

A simpler but not much more elegant solution that's $O(n^2)$ (actually, $O(nm)$ for $m$ is the length of the longest palindrome):

findLongestPalindrome[s_String] := Module[
{ss = Characters @ s, even, odd, best = {}, i, j, n = 0},
odd =  Reverse @ Range[Length[ss]];
even = Reverse @ Range[Length[ss] - 1];
While[Length[even] > 0 || Length[odd] > 0,
odd  = Select[ odd, ({i,j} = {# - n, # + n    }; i > 0 && j <= Length[ss] &&
ss[[i]] == ss[[j]] && (best = {i, j}; True)) &];
even = Select[even, ({i,j} = {# - n, # + n + 1}; i > 0 && j <= Length[ss] &&
ss[[i]] == ss[[j]] && (best = {i, j}; True)) &];
n++;
];
StringTake[s,best]
]

AbsoluteTiming[findLongestPalindrome[aeneid]] (* {7.8125, "man nam"} *)
• 10 bonus points for the implementation of Manacher's algorithm. – Jonathan Kinlay Dec 8 '16 at 9:21
Aeneid = ExampleData[{"Text", "AeneidEnglish"}];
StringLength[Aeneid]
606071

teststring = StringTake[Aeneid, 1000];
nlargest = 20;

TakeLargestBy[Cases[StringCases[teststring, __, Overlaps -> All], _?PalindromeQ],
StringLength, nlargest] // Flatten // Timing

{16.2909, {"ivi", "t t", "a a", " I ", "ele", "t t", "ovo", " O ", " I ", "h h", "s s", "g g", "t t", "awa", "ses", "ese", " a ", "t t", "exe", "s s"}}

MaximalBy[Select[StringJoin /@ Subsequences[Characters[teststring]],
PalindromeQ], StringLength, nlargest] // Timing

{16.9451, {" I ", " I ", "ele", "t t", "a a", "t t", "ivi", "g g", " O ", "ses", "ovo", " a ", "s s", "h h", "ese", "exe", "t t", "awa", "t t", "s s"}}

MaximalBy[StringCases[teststring, x : Repeated[_, {2, \[Infinity]}]
/; PalindromeQ[x], Overlaps -> True], StringLength, nlargest] // Timing

{12.1068, {" I ", " I ", "ele", "t t", "a a", "t t", "ivi", "g g", " O ", "ses", "ovo", " a ", "s s", "h h", "ese", "exe", "t t", "awa", "t t", "s s"}}

LongestCommonSubsequence[teststring, StringReverse[teststring]]

"tes d"

I declare C.E.'s first solution to be the winner. It is both the fastest and most elegant.

Not sure what is going on with C.E.'s second solution, which appears to fail completely.

• I don't see how is 16.9 shorter than 12.1 – Kuba Dec 6 '16 at 9:51