use strict;
use warnings;
use Benchmark qw( cmpthese );
use Test::More qw( no_plan );
use CGI qw/ :html /;

my %contestant = (
	aristotle => sub {
		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;
	},

	aristotle2 => 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 marker
				$palindrome = substr $str, $offs, $+[0] - $-[0];
				$minlen = 1 + length $palindrome;
			}

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

		return $palindrome;
	},

	buu => sub {
		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;
	},

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

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

	tune => sub {
		my $l = '';
		map { $l = $_ if ( $_ eq reverse $_ ) && ( length $l < length $_ ) }
			split /\s+/, $_[0];
		return $l;
	},

	random_walk => sub {
		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;
		}
	},

	clive => sub {
		my $rev = reverse $_[0];

		my $len = 0;
		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;
	},

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

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

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

	limbic_region => sub {
		my %lookup;
		my ( $index, $record ) = ( -1, 0 );
		push @{ $lookup{ substr( $_[0], $_, 1 ) } }, $_
			for 0 .. ( length $_[0] ) - 1;

		LETTER: 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;
					next LETTER if $length <= $record;
					my $palindrome = substr( $_[0], $pos, $length );

					if ( $palindrome eq reverse $palindrome ) {
						( $index, $record ) = ( $pos, $length );
						last;
					}
				}
			}
		}
		return substr( $_[0], $index, $record );
	},

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

	browseruk => sub {
		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;
	},

	jdporter => sub {
		local $_ = shift;
		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;
	},

	elgon => sub {
		use POSIX qw(ceil);
		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!";
	},

	japhy => sub {
our$P="";pop=~m{(.+).?(??{reverse$1})
(?{length$P<length$&and$P=$&})^}xs;$P
	},

	japhy2 => sub {
our@P="";pop=~m{(.+).?(??{reverse$
1})(?{$P[length$&]=$&})^}xs;$P[-1]
	},
);

my @input = (
	'2710327103701371111111111111111111611111111111111111111116602611111111'
	. '1111111111111111111111111111111111111111111611111111111111111',
	'abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfedcba',
	'ababcbabcdcbabcdedcbabcdefedcbabcdefgfedcbababcbabcdcbabcdedcbabcdefedcbabcdefgfedcba',
	'abcdedcbabcdefgfedcbabcdefghijklmnonmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmnoponmlkjihgfedcba',
);

my @correct = (
	'61111111111111111111111111111111111111111111111111116',
	'abcdefghijklmnopqrstuvwxyz12345678987654321zyxwvutsrqponmlkjihgfedcba',
	'edcbabcdefedcbabcde',
	'onmlkjihgfedcbabcdefghijklkjihgfedcbabcdefghijklmno',
);

for my $user ( sort keys %contestant ) {
	my @result = map $contestant{ $user }->( $_ ), @{[ @input ]};
	for( 0 .. $#input ) {
		is $result[ $_ ], $correct[ $_ ], "$user test $_";
	}
}

print "\nRunning benchmark\n";

my $result = cmpthese( 0, { map +( $_ => do {
	my $user = $_;
	sub { $contestant{ $user }->( $_ ) for @{[ @input ]} };
} ), keys %contestant }, "none" );

print map Tr( td( $_ ) )."\n", @$result;