Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

Finding longest palindrome from a string

by BUU (Prior)
on Aug 13, 2004 at 07:45 UTC ( #382567=perlquestion: print w/replies, xml ) Need Help??

BUU has asked for the wisdom of the Perl Monks concerning the following question:

The title is the question. How would you write some code to find the longest palindrome from a string? Note that the entire string *may* or *may not* be a palindrome, you must find a substring from said string that is a palindrome. Also note that there are no "special characters" that you should ignore. So a palindrome is just the reverse of the string. So "foo bazzaboof" is not a palindrome because of the space.

Bonus points for speed, readability and general style. More bonus points for writing it in the form of a subroutine so I can benchmark them all. Name the sub after your self.

My attempt is as follows:
sub buu { 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; }

Update to respond to the criticism: Yes, I did get this problem from the job posting on Yes I had every intention of eventually applying for that job. I had no intention of ripping off people's code to get said job. If I had any intention of using replies to this node for that job, I would have mentioned it. My intentions were simply to share a fun puzzle I found with this community I have grown to love.

Looking at just the facts, in the worst light, I can see how limbic~region, merlyn and others might misinterpret the facts to reach a damning conclusion. I can only say that when I wrote this node, the job had nothing to do with it, so I didn't bother to mention it. That is how my mind works. I can understand why people would have problems with me not mentioning the source, and in retrospect I probably should have credited the source for the problem. Also considering where I got the problem, perhaps I should have waited longer or asked before I "published" the problem. I did not consider the affect this would have on etcshadow and his boss when I wrote this node, and I have already apologized to etcshadow, later on in this thread. I apologize for any impact this may have had on his business.

Having expressed my apologies, I want to reiterate that I have never, nor shall I ever, do something unethical to gain an advantage when applying for a job. I hope my future contributions will make this clear.

Update2, minor formatting changes

Update3, more formatting changes, slightly less inflammatory. Original commented.

Replies are listed 'Best First'.
Re: Finding longest palindrome from a string
by Limbic~Region (Chancellor) on Aug 13, 2004 at 12:09 UTC


    When you mentioned in #perl last night that you intended to make a SoPW post about this, I assumed you would have also mentioned that it was for a job application. I haven't had a chance to refine my non-regex solution on my scratch pad, but here it is for the record.

    #!/usr/bin/perl use strict; use warnings; print longest_palindrome( 'sacascascsacascascascadvgkgjsflfjgfk' ); sub longest_palindrome { my %lookup; my ($index, $record) = (-1, 0); push @{ $lookup{ substr($_[0], $_, 1) } } , $_ for 0 .. (length $_ +[0]) - 1; for my $letter ( keys %lookup ) { my $last = $#{ $lookup{ $letter } }; for my $start ( 0 .. $last - 1 ) { for my $end ( reverse ( $start + 1 .. $last ) ) { my $pos = $lookup{ $letter }[ $start ]; my $length = $lookup{ $letter }[ $end ] - $pos + 1; if ( $length > $record ) { my $palindrome = substr($_[0], $pos, $length); if ( $palindrome eq reverse $palindrome ) { ($index, $record) = ($pos, $length); last; } } } } } return substr($_[0], $index, $record); }

    Cheers - L~R

    Update: While I do not know if you intended to use any of the responses to your advantage in applying for the job, I do know you got the problem from the ad as you gave me the link in IRC. Additionally, you indicated you intended to apply for the job. Shame on me for not wording my admonishment better.

    Update 2: Corrected another logic flaw pointed out by ccn, which makes it even slower :-(

      When you mentioned in #perl last night that you intended to make a SoPW post about this, I assumed you would have also mentioned that it was for a job application.
      Limbic~Region, thanks for that revelation. I've both notified the original job posting author directly, and posted this travesty in use.perl blog for awareness.

      I can only hope that I never meet BUU in person, especially at a job hiring situtation. This is despicable. This is worse than homework, because it's about getting a job, by cheating.

      -- Randal L. Schwartz, Perl hacker
      Be sure to read my standard disclaimer if this is a reply.

        Methinks this might be a slight over-reaction (Update: or might have been, based on your original text), given that BUU did post his original solution to the problem. He may well have intended to go to the interview, describe his code, and then say "here are some alternatives that I solicited on Perl Monks", which is a valid thing to do when trying to solve a job-related Perl problem. One could say that he is showing initiative. Sure, it would have been polite to point this out in the OP. Maybe I'm too forgiving, but I always try to see the positive side.
        Not only is it cheating... but it's also plagiarism (of a sort)... no where does he mention that he ripped off this brain teaser from someone else. (Namely me, my boss, and a friend.)
        ------------ :Wq Not an editor command: Wq
        A reply falls below the community's threshold of quality. You may see it by logging in.

        Your reaction to notify the author is exactly what I would have done.

        But no more. I voted "keep" in your consideration for deletion. Deleting BUU's node alone would be ineffective as it leaves all the replies with solutions lingering, but these replies are valid contributions in their own right and deletion is not justified merely because they're in reply to a deceptive node. Further, any possible damage is already done at this point and cannot be averted by deleting the parent node, which would rob the replies of their context. An editorial amendment of the node might be called for, but deleting it would be counterproductive.

        Makeshifts last the longest.

        Let me repeat myself in large letters merlyn.


        . Do you get it now? I DO NOT WANT TO CHEAT TO GET THE JOB. I just *assumed* other people would enjoy solving this problem, since I enjoyed writing the code.

        Shame on you merlyn, for the same reasons as limbic~region. You have *no* evidence that I have ever cheated to get a job (because I never have or will). All you have is some unfounded slander from limbic~region saying that "I want to cheat" or some such, and you launch off to critically castigate me, not only here, but posted to, a much more public site, WITHOUT EVEN CONSIDERING THAT THERE BE MORE TO THE ISSUE. Now I have large amounts of slander over something I HAVE NEVER DONE, WILL NEVER DO, AND HAD NO INTENTION OF DOING, and some people will probably never believe it, all because of some baseless slander.
        A reply falls below the community's threshold of quality. You may see it by logging in.


      Why the shame? Because you have attacked me for I haven't done, wouldn't do and HAD NO INTENTION OF DOING. This has absolutely *no* relationship to aforesaid job search other than the problem is mostly the same ( I don't think the problem is even exactly the same ). I had NO FUCKING INTENTION of posting this "just so I could steal peoples work to get a job by cheating". None. If I had that intention, it would have been 10 times easier to steal it by googling for solutions, instead of risking my stealing being found out by someone, as the boss for said job could easily read perlmonks and see where I got my solution. This would be much more difficult if I got it off google.

      But I HAD NO INTENTION OF DOING THIS. But instead of even verifying that I was going to, or had done it, you just blatantly attacked me over the *possibility* of me doing it.

      For your information, the reason I posted this question, with any mention of where I got it from, is I just assumed that it was a challenge lots of other people would enjoy also. And, judging by the sheer number of responses, lots of other people enjoyed writing a solution to it. Generally enabling this many people to write some cool perl for a solution would make me very happy, but in this case I find all my happiness is ruined by your slander.
        My better judgement says I shouldn't reply to this at all but... you appear to be quoting me:

        "just so I could steal peoples work to get a job by cheating"

        I never said that. In fact, I am the one in IRC that gave you the benefit of the doubt when others thought you intended to be unscrupulous. What I was addressing is:
        • You did indeed get the problem from the job ad
        • You did indicate you intended to apply for that position saying that you would use the fact you were a Saint at PerlMonks to your advantage
        • You posted the question here without reference to the first two points
        This all transpired on Freenode's #perl of which I do not log. Should you want to dispute any of this I am sure someone has these logs and it will be easy to determine. I certainly would not have said shame on you for anything if you had just acknowledged this when you posted.

        Cheers - L~R

Re: Finding longest palindrome from a string
by japhy (Canon) on Aug 13, 2004 at 15:55 UTC
    Because the golf isn't complete without an insanely short regex solution:
    sub japhy { # 74 our$P="";pop=~m{(.+).?(??{reverse$1}) (?{length$P<length$&and$P=$&})^}xs;$P }
    Update: inspired by ccn's array approach:
    sub japhy { # 68 our@P="";pop=~m{(.+).?(??{reverse$ 1})(?{$P[length$&]=$&})^}xs;$P[-1] }
    Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
    How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart
      I forgot to mention that one of the golf competitions had a palindrome slant. Terje's perlgolf competitions site. There are some nice solutions there, as usual. Shorter than japhy's! :)
Re: Finding longest palindrome from a string
by ccn (Vicar) on Aug 13, 2004 at 08:27 UTC
    sub ccn { local $_ = shift; my @n; for (my $i = 0; $i < length; pos = $i++) { $n[length $&] = $& if /\G(.+).?(??{reverse $1})/; } return @n ? $n[-1] : ''; } sub ccn2 { local ($_, $s) = shift; for (my $i = 0; $i < length; pos = $i++) { $s = $& if /\G(.+).?(??{reverse $1})/ and length($s) < length +($&); } return $s; }

    Update: minor bugs fixed

    Update2: improved version added

Re: Finding longest palindrome from a string
by cLive ;-) (Prior) on Aug 13, 2004 at 09:42 UTC
    Sorry, I can't name the sub after myself since ;-) doesn't compile :)
    sub cLive { 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; }
    cLive ;-)

    ps - if more than one longest palindrome, first is returned.

      my $name = 'cLive ;-)'; no strict 'refs'; *$name = sub { print "This is not my name\n" }; $name->();


Re: Finding longest palindrome from a string
by murugu (Curate) on Aug 13, 2004 at 09:50 UTC

    here is my code:
    sub 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 }


    Sorry monks i haven't read the question carefully, left out space condition itself.

      Your code doesn't work with 'ababbab'

Re: Finding longest palindrome from a string
by Elgon (Curate) on Aug 13, 2004 at 15:29 UTC
    I'm insanely proud of this one as it represents the most interesting bit of coding I've had to do in a while. It even seems to work, although I did cheat by importing POSIX.

    #! /usr/bin/perl -w use strict; use POSIX qw(ceil); sub elgon { my $string = shift; my @answers; 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 - $sta +rt + 1) / 2); push @answers, substr($string , ($star +t) , ($finish - $start + 1) ) if substr($string, $start , $half_length) eq reverse substr ($string, ($finish - $half_length + +1), $half_length); } } } return "FAILED!" if ! scalar(@answers); my $longest = ""; map { $longest = $_ if length($longest) < length($_) } @answer +s; return $longest; }

    UPDATE: There may be a minor bug in my use of POSIX, however I may be able to get round this as substr() automagically rounds down fractional values which are passed to it.

    UPDATE^2: Fencepost error in ceil() function call fixed.

    UPDATE^3: The reason why it fails is that the ordering can sometimes be wrong if there is more than one palindrome in the same string, due to the randomisation as the hash keys are fetched. I'll fix this at some point in the near future...

    UPDATE^4: Issue fixed; Was in fact due to boneheadedness on my part. Now should work nicely, although not as pretty as it was.

    UPDATE^5: Prettified a bit.


    "Stercus! Dixit Pooh. Eeyore, missilis lux navigii heffalumporum iaculas. Piglet, mecum ad cellae migratae secundae concurras."

      And so you should be :) Here are the benchmarks...

        Unfortunately, the benchmark doesn't tell the whole story. Many of the regex-based solutions fail on unescaped regex characters.

        All of the faster ones fail to correctly find the longest string when fed either of:

        1111111121111111111112111111111111111111111112111111111111211111 ababacababacadacababacadaeadacabaz

        (Including mine, which is sad, as the first one is my publish test string:()

        Examine what is said, not who speaks.
        "Efficiency is intelligent laziness." -David Dunham
        "Think for yourself!" - Abigail
        "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
Re: Finding longest palindrome from a string
by Random_Walk (Prior) on Aug 13, 2004 at 09:29 UTC
    Nice puzzle, I offer my humble attempt
    sub Random_Walk { 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; } }
    I tried a recursive one first which was fun but I had to do lots of work to cut the string into different slices so regex it is.

    cnn, Thanks for the hint on code blanking.

    Off by two error fixed in the for loop

    Added .? in the middle to allow palindromes symetrical around a single character (borrowed that idea from ccn ;)

      I do not know how to black the code out

      You can use

      <table><tr><td bgcolor="#000000" color="#000000"> [[[ YOUR CODE HERE ]]] </td></tr></table>
Re: Finding longest palindrome from a string
by Jasper (Chaplain) on Aug 13, 2004 at 10:14 UTC
    sub jasper { $_ = pop; s/\s//sg; do { push@a,$1 if /((.*).?(??{reverse$2}))/i; } while s/.//; (sort{length($b)<=>length$a}@a)[0] }

    edit: erg! I see that this is very similar to murugu's code.
Re: Finding longest palindrome from a string
by Aristotle (Chancellor) on Aug 13, 2004 at 14:30 UTC

    The XOR dance, with a rotating mirror copy. This runs in O(n). Err, it actually runs in O(n2) of course. The inner loop just happens to be shrouded: Perl's string XOR is not O(1).

    sub aristotle { 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; }

    If you don't understand what's going on, run this for a visual demonstration:

    #!/usr/bin/perl use strict; use warnings; sub hd { join ' ', map sprintf("%02X", ord $_), split //, $_[0] } my $str = "abcbadddd"; my $rts = reverse $str; for my $rotate_count ( 0 .. length( $str ) - 1 ) { my $mask = $str ^ $rts; # turn all non-nulls to 0xFF for demonstration purposes $mask =~ tr/\1-\377/\377/; # to distinguish adjacent palindromes substr $mask, $rotate_count, 0, "\1"; while( $mask =~ /\0{3,}/g ) { my $len = $+[0] - $-[0]; my $offs = $-[0]; --$offs if $offs > $rotate_count; # compensate for marker print substr( $str, $offs, $len ), "\n"; } print "$rotate_count: ", hd( $str ), " ^ ", hd( $rts ), " = ", hd( + $mask ), "\n"; substr $rts, 0, 0, chop $rts; }

    Update: changed 0 .. POSIX::ceil( length( $str ) / 2 ) to 0 .. length( $str ) - 1. It was a vestige from an earlier trail of thought that was no longer valid.

    Update: since I was asked how this works, I'm adding an explanation here.

    It is pretty simple: a XOR b = 0 when a = b. If you XOR two strings with each other, you will get a NULL at all locations with identical characters. Now obviously, if you XOR a string with a mirror copy of itself and get all NULLs, then it's a palindrome, because all characters in the rotated copy were identical with all characters of the original.

    That's the gist of it. The particular problem given for this thread is complicated by the fact that we have to look for embedded palindromes, and rotating the string unfortunately displaces the rotated copy of an embedded palindrome. To find all embedded palindromes, the mirror copy must be XORed against the original string at each offset. The code does this by rotating the copy n times for a string of length n.

    There is one nasty trap left. If the string consists of two adjacent palindromes, such as abbabbafef. Mirroring that yields fefabbabba. If you rotate this three times to the left, the mirror copy becomes abbabbafef and XORing them yields a string of all NULLs, which would indicate that the palindrome is abbabbafef. Oops. The problem is that we forgot to keep track of where inside the mirror copy its original start and end used to be. Palindromes obviously cannot run across that location. That is what the substr $mask, $rotate_count, 0, "\1"; is about: a non-NULL is added to break a string of NULLs running across that location. Of course, now we have to account for that extra character in offsets in the mask.

    And that's it. The bulk of the work happens in a single XOR and a pattern match, and other auxiliary tasks are done using very few builtins. That's where it gets its speed. The bulk of the code is merely simple math.

    Makeshifts last the longest.

      It's a perfect idea, but your code doesn't work for 'dsdadadcccasdasd'. It outputs 'ccc' instead of 'dadad'.

        Ouch. Thanks for catching that. Only doing length / 2 iterations was a remnant from a slightly different approach I abandoned half-way in. I even tested the final code on a bunch of different inputs but somehow managed not to run into this issue… ugh.

        Sometimes I wonder if I should add Boneheaded Mistakes R Us to my signature.

        Makeshifts last the longest.

Re: Finding longest palindrome from a string
by jdporter (Chancellor) on Aug 13, 2004 at 14:31 UTC
    I hate writing Perl that looks like Pascal. Oh well...
    sub JDP::longest_palindrome # operates on $_ { 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 }

    Edit by tye, change PRE to CODE around long lines, close FONT tag

Re: Finding longest palindrome from a string
by deibyz (Hermit) on Aug 13, 2004 at 10:48 UTC
    Here is my try,

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

Re: Finding longest palindrome from a string
by bgreenlee (Friar) on Aug 13, 2004 at 12:48 UTC
    sub bgreenlee { my $str = shift; my $longest = ''; while ($str =~ /(?=(.*)(.?)((??{reverse $1})))/g) { $longest = "$1$2$3" if length("$1$2$3") > length($longest); } return $longest; }


Re: Finding longest palindrome from a string
by BrowserUk (Patriarch) on Aug 13, 2004 at 12:57 UTC

    #! perl -slw use strict; sub buk { 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; } print $ARGV[ 0 ]; print ' ' x index( $ARGV[ 0 ], $_ ), $_ for buk $ARGV[ 0 ]; __END__ P:\test>382567 1111111121111111111112111111111111111111111112111111111 +111211111 1111111121111111111112111111111111111111111112111111111111211111 11111121111111111112111111111111111111111112111111111111211111 P:\test>382567 1111111121111111111112111111111111111111111112111111111 +1121111 11111111211111111111121111111111111111111111121111111111121111 111111111111211111111111111111111111211111111111

    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
Re: Finding longest palindrome from a string
by fizbin (Chaplain) on Aug 13, 2004 at 14:14 UTC
    Given the number who have gone before, surely this has been done already, but...

    sub fizbin {
      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]);
    It's also unfortunately an O(n^2) algorithm, but my initial O(n) idea turned out to be badly flawed. (Actually, I guess it's O(n*m), where "n" is the length of the input and "m" is the length of the longest palindrome - in the worst case, a string of all the same letter, it'd be O(n^2))

    Note that it'll also work on unicode strings, assuming that perl knows that its argument is a unicode string.

    -- @/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/; map{y/X_/\n /;print}map{pop@$_}@/for@/
Re: Finding longest palindrome from a string
by Limbic~Region (Chancellor) on Aug 16, 2004 at 19:38 UTC
    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: 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. 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. I made no attempt to fix the results, so I gigged any solution that didn't have a proper .results file

    Cheers - L~R

      I took some advice and rebuilt the benchmark. I disqualified anyone who didn't get accurate results, so be sure you didn't get disqualified due to my error in your code. Here is the code that I used to generate the new palindromes: Here is the actually benchmark itself: And here are the results:

      Cheers - L~R

      return $string . reverse $string;

      That only generates even length palindromes. I instead suggest

      return ( $string . ( rand < .5 ? $letters[ rand @letters ] : '' ) . reverse $string );

      Also, Don't Repeat Yourself. That's far too much copy-paste code there. Look at the benchmark script I wrote: much less code, and it tells you exactly which input strings each solution failed on and what it produced instead.

      Makeshifts last the longest.

      You might want to add some non-alphanumeric characters into the mix as allowed by the original challenge.

      Examine what is said, not who speaks.
      "Efficiency is intelligent laziness." -David Dunham
      "Think for yourself!" - Abigail
      "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
Re: Finding longest palindrome from a string
by Aristotle (Chancellor) on Aug 14, 2004 at 01:50 UTC

    A slight modification of my previous entry yields the winning entry (so far). :-)

    sub { 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 mark +er $palindrome = substr $str, $offs, $+[0] - $-[0]; $minlen = 1 + length $palindrome; } substr $rts, 0, 0, chop $rts; } return $palindrome; }

    Makeshifts last the longest.

      And here's the proof (sorry it's so wide).

      Note that I had to disqualify some entries for failing the tests.

      The full benchmark I ran follows. Note that some entries required slight modifications in order to compile with strictures and run without warnings. I paid careful attention to keep the semantics intact, but if I disqualified your entry, please check my copy of your code for potential breakage.

      Makeshifts last the longest.

        Oops, thank you. I missed that one because I downloaded the solutions by crawling the displaycode links on the thread page and he didn't put his entry in CODE tags.

        It works correctly and therefor qualifies, but I only get about 340 iterations/s for it. That puts it next to Limbic~Region's entry in my chart. I'm not surprised, as his code is quite complex and involves a true for(;;) loop (relatively slow in Perl). Fast code in Perl means as few opcodes as possible and letting builtins do work implicitly as much as possible. (See GRT, f.ex.)

        That is how I arrived at my second version. I copied the first version, ripped everything except the XOR out of the loop, and started benchmarking them against each other as I tried to accelerate extraction of null runs from the bitmask and rotation of the reverse string. Every single operation I added to the (non-functional, skeletal) second version had a dramatic impact on speed. Whatever I did, I found nothing with which to improve upon while( /\0{3,}/g ) { } and substr+chop. I only managed to get a speedup when I constrained the match further so that the regex engine isn't exited to drop into the loop body for null runs that are too short to be candidates. Apparently, avoiding that penalty by skipping matches implicitly more than makes up for the additional cost of having to compile the regex multiple times, which skipping them explicitly didn't require.

        The version and compile-time flags of the Perl in use probably matter to some degree, as well.

        Makeshifts last the longest.

Re: Finding longest palindrome from a string
by tune (Curate) on Aug 13, 2004 at 08:43 UTC
    A very humble attempt:
    sub tune { my $l = ""; map {$l=$_ if ($_ eq reverse $_)&&(length $l<length $_)} split /\s ++/, $_[0]; return $l; }


      Oops, mine won't work with in-string palindromes. Disqualify me. =:(


Re: Finding longest palindrome from a string
by William G. Davis (Friar) on Aug 16, 2004 at 00:29 UTC

    All right, here's my attempt:

    UPDATE: fixed it to account for "aba" palindromes, thanks BrowserUk:

    UPDATE2: fixed again, thanks ccn:

    #!/usr/bin/perl -w use strict; my $input = <STDIN>; chomp($input); 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) { # the first character beyond the three or two character middle of +a # palindrome: 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)) { last if ($left_pos <= 0 or $right_pos >= length $input); $left_pos--; $right_pos++; } # extract the palindrome: my $offset = $left_pos; my $length = ($right_pos - $left_pos) + 1; my $palindrome = substr($input, $offset, $length); $longest_palindrome = $palindrome if ($length > length $longest_palindrome); # backtrack, to find palindromes within this palindrome: pos($input) -= (length($1) - 1); } print $longest_palindrome; sub nextCharactersMatch { my ($input, $left_pos, $right_pos) = @_; return 1 if (substr($input, $left_pos - 1, 1) eq substr($input, $right_pos + 1, 1)); }

      You don't appear to have catered for the 'aba' situation? Ie. Where the palindrome is symetrical around a single central character.

      Examine what is said, not who speaks.
      "Efficiency is intelligent laziness." -David Dunham
      "Think for yourself!" - Abigail
      "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon

      For bbabbbabbb your version outputs 7 chars bbbabbb instead of 9 chars bbabbbabb

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://382567]
Approved by cLive ;-)
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (4)
As of 2023-04-01 07:08 GMT
Find Nodes?
    Voting Booth?

    No recent polls found