http://qs321.pair.com?node_id=383423

in reply to Finding longest palindrome from a string

BUU,
I was frustrated that my original idea, which was elegant and fast, had a major logic flaw and fixing it made ugly inefficient code. I came up with the following instead:
```sub LR_Palindrome {
my \$forward = shift;
my \$reverse = reverse \$forward;

return \$forward if \$forward eq \$reverse;
my (\$max, \$pos, \$length, \$palindrome, \$test) = (0);

for \$pos ( 0 .. (length \$forward) - 1 ) {
for \$length ( \$max + 1 .. (length \$forward) - \$pos ) {
\$test = substr( \$forward, \$pos, \$length );
if ( index(\$reverse, \$test) != -1 ) {
\$max = length \$test;
\$palindrome = \$test;
}
}
}
return \$palindrome;
}
Of course I wanted to see how it stacked up against all the other solutions, so I created a program to generate strings that contained palindromes as well as added in the examples used elsewhere in the thread.
```#!/usr/bin/perl
use strict;
use warnings;

my @letters = 'a'..'z';
open (PALINDROMES, '>', 'palindromes.dat') or die "Unable to open pali
+ndromes.dat for writing : \$!";

for ( 0 .. 10 ) {
my \$string;
\$string .= rand() <= .3 ? gen_palindrome() : \$letters[ rand @lette
+rs ] for 0 .. (rand 25) + 2;
print PALINDROMES \$string, "\n";
}

sub gen_palindrome {
my \$string;
\$string .= \$letters[ rand @letters ] for 1 .. (rand 18) + 2;
return \$string . reverse \$string;
}
__END__
leostddtsoelirknmxrhwfuzoozufwhrjnwytnybfrrrrfbyntywnfxmqrepfcdojyovxe
+yaeeayexvoyjodcfperqmx
xrurqyovghhybqvbhvyyvhbvqbyhhgvoyqrrrppmycvoovcympprr
zrrpmmlygeyeqrttinhklxfccfxlkhnittrqeyegylryovaaavduooudvaaavoyttugqci
+hjrnmnmiywwyimnmnrjhicqgutdijvmpofmppmfopmvjimuccqieaeixkgzlpddplzgkx
+ieaeiqccumkagegqqgegakyuplcymxfrbpdzkzryxlxtmzvvzmtxlxyrzkzdpbrfxm
kreguugerfumcvzzvcmujtfjgwsjgfphkusqlgggglqsukhpfgjswsfmujzzjumfs
dhmopumbwennjaalwwlaajnnewbmupomwbyzrryoynrrokdiidkorrnyoyrrzllssllioy
+llrsnmffmnsrllvsttfeymdjjxbccbxjjdmxlwaiqjkyvsgzppzgsvykjqiawbgeingpa
+lebpivlokvt
cwxfymnrrnmyqiu
lamhzzcwlwoowlwczzzqeeavmfqvfsywwysfvqfmvaeequmycckptworpfyheawviuvaup
+nnpuavuivwaehyfprowt
frfbkjwtdgqqgdtwjkbfrfhiloxilguyqbssmbllbmssbqyucxjfjhjwkciuzjjzuickwj
+to
cvynpiipnyvcjybdltorcntkhpxpwcrvdjjdvrcwpxphktncrotlirekrmokbqkqaaqkqb
heucfmybrgwtikfussufkitwgrktxt
ababbab
1111111121111111111112111111111111111111111112111111111111211111
abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcb
+abcdefghijklmnoponmlkjihgfedcba
bbabbbabbb
2710327103701371111111111111111111611111111111111111111116602611111111
+1111111111111111111111111111111111111111111611111111111111111
61111111111111111111111111111111111111111111111111116
abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfedcba
ababcbabcdcbabcdedcbabcdefedcbabcdefgfedcbababcbabcdcbabcdedcbabcdefed
+cbabcdefgfedcba
edcbabcdefedcbabcde
abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcb
+abcdefghijklmnoponmlkjihgfedcba
onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno
I then created a benchmark script that would not only yield performance results, but accuracy as well. You have to look at the *.results files as I got lazy.
```#!/usr/bin/perl
use POSIX qw(ceil);
use Benchmark 'cmpthese';

my %methods = (
LR         => \&LR_Palindrome,
BUU        => \&BUU_Palindrome,
CCN1       => \&CCN1_Palindrome,
CCN2       => \&CCN2_Palindrome,
RW         => \&RW_Palindrome,
CLIVE      => \&cLive_Palindrome,
MURUGU     => \&murugu_Palindrome,
JASPER     => \&jasper_Palindrome,
DEIBYZ     => \&deibyz_Palindrome,
BGREENLEE  => \&bgreenlee_Palindrome,
BUK        => \&buk_Palindrome,
FIZBIN     => \&fizbin_Palindrome,
ARISTOTLE1 => \&aristotle1_Palindrome,
ARISTOTLE2 => \&aristotle2_Palindrome,
JDP        => \&JDP_Palindrome,
ELGON      => \&elgon_Palindrome,
JAPHY1     => \&japhy1_Palindrome,
JAPHY2     => \&japhy2_Palindrome,
WGD        => \&WGD_Palindrome,
);

for my \$method ( keys %methods ) {
open (DATA, '<', 'palindromes.dat') or die "Unable to open data fi
open (OUT, '>', "\$method.results") or die "Unable to open \$method.
+results for writing : \$!";
while ( <DATA> ) {
chomp;
print OUT \$methods{\$method}->( \$_ ), "\n";
}
}

cmpthese -10, {
'L~R' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
LR_Palindrome( \$_ );
}
},
'BUU' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
BUU_Palindrome( \$_ );
}
},
'CCN1' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
CCN1_Palindrome( \$_ );
}
},
'CCN2' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
CCN2_Palindrome( \$_ );
}
},
'RW' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
RW_Palindrome( \$_ );
}
},
'cLive' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
cLive_Palindrome( \$_ );
}
},
'murugu' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
murugu_Palindrome( \$_ );
}
},
'jasper' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
jasper_Palindrome( \$_ );
}
},
'deibyz' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
deibyz_Palindrome( \$_ );
}
},
'bgreenlee' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
bgreenlee_Palindrome( \$_ );
}
},
'buk' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
buk_Palindrome( \$_ );
}
},
'fizbin' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
fizbin_Palindrome( \$_ );
}
},
'aristotle1' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
aristotle1_Palindrome( \$_ );
}
},
'aristotle2' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
aristotle2_Palindrome( \$_ );
}
},
'JDP' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
JDP_Palindrome( \$_ );
}
},
'elgon' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
elgon_Palindrome( \$_ );
}
},
'japhy1' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
japhy1_Palindrome( \$_ );
}
},
'japhy2' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
japhy2_Palindrome( \$_ );
}
},
'WGD' => sub {
open (DATA, '<', 'palindromes.dat') or die "Unable to open dat
+a file for reading : \$!";
while ( <DATA> ) {
chomp;
WGD_Palindrome( \$_ );
}
},
};

sub LR_Palindrome {
my \$forward = shift;
my \$reverse = reverse \$forward;

return \$forward if \$forward eq \$reverse;
my (\$max, \$pos, \$length, \$palindrome, \$test) = (0);

for \$pos ( 0 .. (length \$forward) - 1 ) {
for \$length ( \$max + 1 .. (length \$forward) - \$pos ) {
\$test = substr( \$forward, \$pos, \$length );
if ( index(\$reverse, \$test) != -1 ) {
\$max = length \$test;
\$palindrome = \$test;
}
}
}
return \$palindrome;
}

sub BUU_Palindrome {
my @p;
my \$arg = shift;
my \$p;

while( \$arg =~ /((.).?\2)/g )
{
my \$m = \$1;
while( \$arg =~ /((.)\$m\2)/ )
{
\$m = \$1;
}
if( length(\$m) > length(\$p) )
{
\$p = \$m;
}
}

return \$p;
}

sub CCN1_Palindrome {
local \$_ = shift;
my @n;
for (my \$i = 0; \$i < length; pos = \$i++) {
\$n[length \$&] = \$& if /\G(.+).?(??{reverse  \$1})/;
}
return @n ? \$n[-1] : '';
}

sub CCN2_Palindrome {
local (\$_, \$s) = shift;
for (my \$i = 0; \$i < length; pos = \$i++) {
\$s = \$& if /\G(.+).?(??{reverse  \$1})/ and length(\$s) < length
+(\$&);
}
return \$s;
}

sub RW_Palindrome {
my (\$left, \$right, \$pal, \$i)=("", "", "", 1);
my \$test=join " ", @ARGV;
for (; \$i<((length \$test)/2)+2; \$i++) {
\$left.="(.)";
\$right="(\\\$i)".\$right;
if (\$test=~/\$left.?\$right/) {\$pal=\$&; next}
return \$pal;
}
}

sub cLive_Palindrome {
my \$rev = reverse \$_[0];

my \$len='';
my \$d;
for (0..length(\$_[0])-1) {
my \$c= join'',map { substr(\$rev,\$_,1) eq substr(\$_[0],\$_,1) ?
+1 : 0 } 0..length(\$_[0])-1;
my \$match = (sort {length(\$a)<=>length(\$b)} \$c =~ /(1+)/g)[-1]
+;
\$match>\$len and \$len=\$match and \$d=\$c;
\$rev = substr(\$rev,1).substr(\$rev,0,1);
}
\$d=~s/(.*)(\$len).*/substr(\$_[0],length(\$1),length(\$len))/e;
return \$d;
}

sub murugu_Palindrome {
my \$x=shift;
my \$prev=0;
while (\$x=~/(([a-z0-9]+)[a-z0-9]?(??{reverse \$2}))/gi) {
\$max=\$1 if (length(\$1)>\$prev);
\$prev=length \$max;
}
\$max;
}

sub jasper_Palindrome {
\$_ = pop;
s/\s//sg;
do {
push@a,\$1 if /((.*).?(??{reverse\$2}))/i;
} while s/.//;
(sort{length(\$b)<=>length\$a}@a)[0]
}

sub deibyz_Palindrome {
my \$match;
while(/.*?(.+)(.?)((??{reverse\$1})).*?/g){
\$match = \$1.\$2.\$3 if length(\$1.\$2.\$3)>length(\$match);
}
\$match;
}

sub bgreenlee_Palindrome {
my \$str = shift;
my \$longest = '';
while (\$str =~ /(?=(.*)(.?)((??{reverse \$1})))/g) {
\$longest = "\$1\$2\$3" if length("\$1\$2\$3") > length(\$longest);
}
return \$longest;
}

sub buk_Palindrome {
my \$string = shift;
my @pals;
while( \$string =~ m[(.) (?=( (?:\1) | (?:.\1) ) ) ]gx ){
my( \$left, \$right ) = ( \$-[ 0 ], \$+[ -1 ] );

while( \$left and \$right < length( \$string )
and substr( \$string, \$left, 1 ) eq substr( \$string, \$right, 1
+)
) {
\$left--; \$right++ ;
}
my \$pal = substr( \$string, \$left, \$right - \$left );

if( !@pals or length( \$pals[ -1 ] ) < length( \$pal ) ) {
@pals = \$pal;
}
else {
push @pals, \$pal unless @pals;
}
}
return wantarray ? \$pals[ 0 ] : @pals;
}

sub fizbin_Palindrome {
return \$_[0] unless (\$_[0] and length(\$_[0]) > 1);
my @string = (300, unpack("U*", \$_[0]), 301);
my \$palstart, \$palend;
my (\$bestlen, \$beststart, \$bestend) = (-1,-1,-1);
for (\$palmid = 1; \$palmid < \$#string; \$palmid++)
{
if (\$string[\$palmid] == \$string[\$palmid+1])
{ # try even-length palindrome
(\$palstart, \$palend) = (\$palmid, \$palmid+1);
while (\$string[\$palend+1] == \$string[\$palstart-1])
{
\$palend++; \$palstart--;
}
if (\$bestlen < \$palend - \$palstart)
{
(\$bestlen, \$bestend, \$beststart) =
(\$palend - \$palstart, \$palend, \$palstart);
}
}
# try odd-length palindrome
(\$palstart, \$palend) = (\$palmid, \$palmid);
while (\$string[\$palend+1] == \$string[\$palstart-1])
{
\$palend++; \$palstart--;
}
if (\$bestlen < \$palend - \$palstart)
{
(\$bestlen, \$bestend, \$beststart) =
(\$palend - \$palstart, \$palend, \$palstart);
}
}
pack("U*", @string[\$beststart..\$bestend]);
}

sub aristotle1_Palindrome {
my \$str = shift;
my \$rts = reverse \$str;

my \$palindrome = '';
for my \$rotate_count ( 0 .. length( \$str ) - 1 ) {
my \$mask = \$str ^ \$rts;

while( \$mask =~ /\0{3,}/g ) {
my \$len = \$+[0] - \$-[0];
next if \$len <= length \$palindrome;
my \$offs = \$-[0];
--\$offs if \$offs > \$rotate_count; # compensate for marker
\$palindrome = substr \$str, \$offs, \$len;
}

substr \$rts, 0, 0, chop \$rts;
}

return \$palindrome;
}

sub JDP_Palindrome {
my \$pal;
for my \$i ( 0 .. length(\$_) )
{
last if defined(\$pal) && length(\$_)-\$i < length(\$pal);
my \$j = rindex \$_, substr( \$_, \$i, 1 );
while ( \$j > \$i )
{
my \$s = substr \$_, \$i, \$j-\$i+1;
if ( \$s eq reverse \$s ) # it's a palindrome
{    # but is it the longest yet found?
\$pal = \$s unless defined \$pal && length(\$pal) > length
+(\$s);
}
\$j--;
\$j = rindex \$_, substr( \$_, \$i, 1 ), \$j;
}
}
\$pal
}

sub elgon_Palindrome {
my \$string = shift;
my %char_hash = map { \$_ => 1} split //, \$string;
foreach my \$key (keys %char_hash) {
my @appearances;
for (my \$i = 0; \$i < length(\$string); \$i++) {
push (@appearances, \$i) if substr(\$string, \$i, 1)  eq
+\$key;
}
foreach my \$start(@appearances) {
foreach my \$finish(reverse @appearances) {
next if \$start >= \$finish;
my \$half_length = ceil((\$finish - \$start + 1) / 2)
+;
return substr(\$string , (\$start) , (\$finish - \$sta
+rt + 1) ) if substr(\$string, \$start, \$half_length) eq reverse substr
+(\$string, (\$finish - \$half_length + 1), \$half_length);
}
}
}
return "FAILED!";
}

sub japhy1_Palindrome {  # 74
our\$P="";pop=~m{(.+).?(??{reverse\$1})
(?{length\$P<length\$&and\$P=\$&})^}xs;\$P
}

sub japhy2_Palindrome {  # 68
our@P="";pop=~m{(.+).?(??{reverse\$
1})(?{\$P[length\$&]=\$&})^}xs;\$P[-1]
}

sub aristotle2_Palindrome {
my \$str = shift;
my \$rts = reverse \$str;

my \$palindrome = '';
my \$minlen     = 3;
for my \$rotate_count ( 0 .. length( \$str ) - 1 ) {
my \$mask = \$str ^ \$rts;

while ( \$mask =~ /\0{\$minlen,}/g ) {
my \$offs = \$-[0];
--\$offs if \$offs > \$rotate_count;    # compensate for mark
+er
\$palindrome = substr \$str, \$offs, \$+[0] - \$-[0];
\$minlen = 1 + length \$palindrome;
}

substr \$rts, 0, 0, chop \$rts;
}

return \$palindrome;
}

sub WGD_Palindrome {

my \$longest_palindrome = '';

# look for two occurrences of the same character back to back or w
+ith another
# character in-between them to find palindromes:
while (\$input =~ /((.).?\2)/g)
{
my \$match_position = pos(\$input);

# get the positions of the two matching characters:
my \$left_pos  = \$match_position -  length \$1;
my \$right_pos = \$match_position - 1;

# now go looking to the left and right of each matching charac
+ter
# for more matching characters:
while (nextCharactersMatch(\$input, \$left_pos, \$right_pos))
{
\$left_pos--;
\$right_pos++;
}

# extract the palindrome:
my \$offset = (\$right_pos - \$left_pos) + 1;
my \$palindrome = substr(\$input, \$left_pos, \$offset);

\$longest_palindrome = \$palindrome
if (length \$palindrome > length \$longest_palindrome);

# backtrack, to find palindromes within this palindrome:
pos(\$input) -= (length(\$1) - 1);
}
}

sub nextCharactersMatch {
my (\$input, \$left_pos, \$right_pos) = @_;

return 1 if (substr(\$input, \$left_pos - 1, 1)
eq substr(\$input, \$right_pos + 1, 1));
}