note Limbic~Region [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: <readmore> <CODE> 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; } </CODE> </readmore> 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. <readmore> <code> #!/usr/bin/perl use strict; use warnings; my @letters = 'a'..'z'; open (PALINDROMES, '>', 'palindromes.dat') or die "Unable to open palindromes.dat for writing : $!"; for ( 0 .. 10 ) { my $string; $string .= rand() <= .3 ? gen_palindrome() : $letters[ rand @letters ] 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__ leostddtsoelirknmxrhwfuzoozufwhrjnwytnybfrrrrfbyntywnfxmqrepfcdojyovxeyaeeayexvoyjodcfperqmx xrurqyovghhybqvbhvyyvhbvqbyhhgvoyqrrrppmycvoovcympprr zrrpmmlygeyeqrttinhklxfccfxlkhnittrqeyegylryovaaavduooudvaaavoyttugqcihjrnmnmiywwyimnmnrjhicqgutdijvmpofmppmfopmvjimuccqieaeixkgzlpddplzgkxieaeiqccumkagegqqgegakyuplcymxfrbpdzkzryxlxtmzvvzmtxlxyrzkzdpbrfxm kreguugerfumcvzzvcmujtfjgwsjgfphkusqlgggglqsukhpfgjswsfmujzzjumfs dhmopumbwennjaalwwlaajnnewbmupomwbyzrryoynrrokdiidkorrnyoyrrzllssllioyllrsnmffmnsrllvsttfeymdjjxbccbxjjdmxlwaiqjkyvsgzppzgsvykjqiawbgeingpaywctdaadtcwyapgnie mzvnytslsnqadhcsccschdaqnsxvuhrhcnrrnchrhuvxswetuutewdctvkolvipbelnbbnlebpivlokvt cwxfymnrrnmyqiu lamhzzcwlwoowlwczzzqeeavmfqvfsywwysfvqfmvaeequmycckptworpfyheawviuvaupnnpuavuivwaehyfprowt frfbkjwtdgqqgdtwjkbfrfhiloxilguyqbssmbllbmssbqyucxjfjhjwkciuzjjzuickwjto cvynpiipnyvcjybdltorcntkhpxpwcrvdjjdvrcwpxphktncrotlirekrmokbqkqaaqkqbkomrkerigxknxhekcdmuecceumdckehxneqzxkqryadbfzxvwwvxzfbdayrqkxzqe heucfmybrgwtikfussufkitwgrktxt dsdadadcccasdasd ababbab 1111111121111111111112111111111111111111111112111111111111211111 ababacababacadacababacadaeadacabaz sacascascsacascascascadvgkgjsflfjgfk abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmnoponmlkjihgfedcba bbabbbabbb 27103271037013711111111111111111116111111111111111111111166026111111111111111111111111111111111111111111111111111611111111111111111 61111111111111111111111111111111111111111111111111116 abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfedcba ababcbabcdcbabcdedcbabcdefedcbabcdefgfedcbababcbabcdcbabcdedcbabcdefedcbabcdefgfedcba edcbabcdefedcbabcde abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmnoponmlkjihgfedcba onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno </code> </readmore> 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. <readmore> <code> #!/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 file for reading : $!"; 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 data file for reading : $!"; while ( <DATA> ) { chomp; LR_Palindrome( $_ ); } }, 'BUU' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; BUU_Palindrome( $_ ); } }, 'CCN1' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; CCN1_Palindrome( $_ ); } }, 'CCN2' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; CCN2_Palindrome( $_ ); } }, 'RW' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; RW_Palindrome( $_ ); } }, 'cLive' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; cLive_Palindrome( $_ ); } }, 'murugu' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; murugu_Palindrome( $_ ); } }, 'jasper' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; jasper_Palindrome( $_ ); } }, 'deibyz' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; deibyz_Palindrome( $_ ); } }, 'bgreenlee' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; bgreenlee_Palindrome( $_ ); } }, 'buk' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; buk_Palindrome( $_ ); } }, 'fizbin' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; fizbin_Palindrome( $_ ); } }, 'aristotle1' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; aristotle1_Palindrome( $_ ); } }, 'aristotle2' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; aristotle2_Palindrome( $_ ); } }, 'JDP' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; JDP_Palindrome( $_ ); } }, 'elgon' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; elgon_Palindrome( $_ ); } }, 'japhy1' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; japhy1_Palindrome( $_ ); } }, 'japhy2' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data file for reading : $!"; while ( <DATA> ) { chomp; japhy2_Palindrome( $_ ); } }, 'WGD' => sub { open (DATA, '<', 'palindromes.dat') or die "Unable to open data 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; # to distinguish adjacent palindromes substr $mask, $rotate_count, 0, "\1"; 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 - $start + 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; # to distinguish adjacent palindromes substr $mask, $rotate_count, 0, "\1"; while ( $mask =~ /\0{$minlen,}/g ) { my $offs = $-[0]; --$offs if $offs > $rotate_count; # compensate for marker $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 with 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 character # 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)); } </code> </readmore> I made no attempt to fix the results, so I gigged any solution that didn't have a proper .results file <ul> <li>[bgreenlee] : 0.332/s : accurate</li> <li>[Jasper] : 0.474/s : not-accurate</li> <li>[japhy]2 : 0.655/s : accurate</li> <li>[japhy]1 : 0.658/s : accurate</li> <li>[ccn]1 : 0.684/s : accurate</li> <li>[ccn]2 : 0.690/s : accurate</li> <li>[cLive ;-)] : 2.47/s : not-accurate</li> <li>[deibyz] : 4.12/s : not-accurate</li> <li>[murugu] : 4.30/s : not-accurate</li> <li>[Limbic~Region|L~R] : 12.3/s : accurate</li> <li>[BUU] : 18.3/s : not-accurate</li> <li>[jdporter] : 39.6/s : accurate</li> <li>[aristotle]1 : 64.6/s : accurate</li> <li>[fizbin] : 75.4/s : accurate</li> <li>[aristotle]2 : 93.9/s : accurate</li> <li>[Elgon] : 114/s : not-accurate</li> <li>[BrowserUk] : 124/s : not-accurate</li> <li>[Random_Walk] : 1117/s : not-accurate</li> <li>[William G. Davis] : 1404/s : not-accurate</li> </ul> <div class="pmsig"><div class="pmsig-180961"> Cheers - [Limbic~Region|L~R] </div></div> 382567 382567