develooper Front page | perl.fwp | Postings from April 2003

Pentomino Quine

Scott R. Godin
April 27, 2003 01:59
Pentomino Quine
Message ID:
hopefully the linewrapping doesn't mess this up. (Most) columns are 79
characters wide (exceptions are line 2, 8, 20, 38). 

CAUTION! CAUTION! This program can use a lot of computing resources for 
very long periods of time. It may take an hour or more just to find the 
first of thousands of possible solutions. CAUTION! CAUTION!

    $  perl  quine

For more output, try adding the --verbose command line option. This will 
cause the program to print incomplete results every few seconds, to help 
you see what it is doing. These partial results are usually full quines, 
but this isn't guaranteed. Full solutions are always quines.

$w=~s=\s|\n==sg ;++$L{'                 FfFffFF fFf'};($b,$B,$b b,$BB)=(10,6,8,
6);$q=int($b/2) ;($*,$"                 ,$/,$:, $;)=split//,"\0 40:\n\043_";$D=
$"x($b+2);$D=$D .($".($                 *x$b).$ ")x$B.$D;$Z=sub {reverse@_};++$
L{'IIIIi'};$T=s ub{my($                 x,$P,$T ,$O,$F)=(0,$b*$ q+$q,@_);$_=$"x
($b+$b*$b+$b);m y@T=(-2                 -$b,1,2 +$b,-1);@T=&$Z( @{T})if$F;while
($T){$X=substr( $T,0,1,                 '');$x= lc${X}i         f!$x;su
bstr($_,$P,1,$x );(${X}ne$x)?($         P+=$T[$ O]):($O =($O+1)%(@T))}s =\A$"+=
=s;s=$"+\z==s;$ _};++$L{'LlLLLl         '};$W=s ub{$_=s hift;eval(qq%y/ $"f-z/.
$*/%);s-(\.{4,} )-'.{'.length($         1).'}'- ge;qr/$ _/};++$L{'NNnnn NnNn'};
++$L{'PPpPpPp'} ;$r=sub{local($         _,$m)=@ _;s/$"/ /g;s/(.)/$1x$bb /ge;$x=
$bb*$b;s|(.{$x} )|$1x$BB|eg;s~(         ?<=(.)) (.)~($1 eq$2)?$2:$*~eg; $x--;s~
(?<=(.)         .{$x})(                 .)~($2n e$1)?$* :$2~ge;         s|.(.{$
x})|\1$ /|g;s!.*?$/!!s;                 $x=$w.$ ;.$w;s: \S:subs tr($x,0,1,''):g
e;print "$:!$^X$/",q@$_                 =$w=q@, $:,$/,$ _,"$:", q@=>s=\s|\n|@,$
;,$;,q@ .*==sg=>eval@,$                 /,"$;$; DATA$;$ ;$*$m$/ ";};++$L{'TTtTt
tTTt'}; $L=sub{my($Z,$O                 ,$F);fo r$x(key s%L){$L {$x}={};for$O(0
..3){fo r$F(0,1){$Z=&$T                 ($x,$O, $F);$L{ $x}{$Z} =&$W($Z);}}}};+
                                        +$L{'Uu UUuUu'}         ;($L5,$
L4,$L3,$LL)=($b -4,$b-3         ,$b-2,$ b-1);($ S,$s)=(         "S-S$LL :","S--
S$LL:");$h=["S$ b:S-S$b         :S","S$ b:${S}S -S$b:S"         ,"SS$LL :${s}SS
","S$b:${S}${S} S-S$b:S         ","SSS$ L4:S--- S$L4:SS         ","S$b: ${S}${s
}SS","S$b:S-S$L 3:${s}S         S","SS$ LL:S--S $L3:S-S         $b:S"," SS$LL:$
{s}S-S$b:S","S$ b:$S$S$         {S}S-S$ b:S","S SS$L5:S         ----S$L 5:SS","
SS$LL:S         --S$L3:         ${s}SS" ,"S$b:$                 S$S$S$S ${S}S-S
$b:S"]; for(@$h){s=S=\134S=g;s= \-=$*=g ;s=(\d+                 ):=.{$1 }=g;$_=
qr/$_/} ++$L{'VVvVVv'};$H=sub{m y$X=shi ft;for$                 x(@$h){ return'
'if$X=~ /$x/}1;};++$L{'WwWwwwWw Ww'};$V =sub{my                 ($I,$D, $q,$Q)=
(0,@_); for$I(0..-1+length($Q)) {$_=sub str($Q,                 $I,1);i f($"eq$
_){next }substr($D,$I+$q,1,$_); }&$H($D )&&&$A(                 $D);};+ +$L{'XX
xxXxXxx         XXx'};$         S=$c=0;                                 ++$L{'Y
yYyyYYYy'};$A=s ub{++$c ;my($D)=@_;!@A&&(&$r($D         ,"SOLUTION".++$S),retur
n);@ARGV&&(@A<3 )&&&$r( $D,"$c$*moves");my($aa,         $a)=('',pop@A);for$aa(s
ort(keys%{$L{$a }})){wh ile($D=~m/(?=$L{$a}{$aa         })/g){&$V($D,pos($D),$a
a);++pos($D);}} push@A, $a;};++$L{'ZzZZzzzZz'};         &$L;@A=&$Z(sort(keys%L)
);&$A($D);__@@* %&(*%(* @&%(*&@^_$w=~s=\s|\n==s         g;++$L{'FfFffFFfFf'};($
__DATA__                                            [ e d @ h a l l e y . c c ] Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at | Group listing | About