Re: Number Theory Monster

Truly a monster, here it is with whitespace

use strict;
my@l=(1);
my($c,$d)=(75,0);
push@l,q|-84|;
sub t{
    my$o=shift;
    print$o @_
}
push@l,qw{-1 43 -2};
unshift@l,@l[$#l-2..$#l];
pop@l;
pop@l;
pop@l;
sub c{
    my$f=pop;
    open M,$f;
    my @l=<M>;
    chomp@l;
    pop@l while$l[$#l]ne'__END__';
    open M,">$f";
    t *M,(join"\n",@l),$/
}
push@l,qw-33 45 1 5-;
push @l,qw @-12 -3@;
sub i{
    my(@a,$n)=@_;
    $n+=shift@a while$n++,@a&&!--$a[0];
    {
        @a||last;
        @a=($a[0]<$n?$a[0]:$n,@a);
        ($n-=$a[0])&&redo
    }
    @a
}
unshift@l,qw[13-82];
push@l,@l[0,1];
shift@l;
shift@l;
sub P{
    my($P,$p)=@_;
    $P<$p? 0 :  $P==1   ||
                $p==1   ||
                $P-$p==1 ?  1 : P($P-1,$p-1)+P($P-$p,$p)
}
push@l,qw-48 21  13-,q;-6;;
$l[$#l+1]=-76;
push@l,qw/40 25 2  8/,q#-6#;
sub p{
    my$e;
    my@r=[];
    $e=$_,@r=map{my@a=@$_;map[@a[0..$_-1],$e,@a[$_..$#a]],0..@a}@r for
+@_;
    @r
}
push@l,qw@13-104@;
if(my@t=unpack"C*",do{local($/);<DATA>}) {
    my$t=0;
    {
        $t[0]==126 ?((t *STDERR,chr$t),last): ($t+=shift@t)and redo
    }
    c $0;
    $d=$t[$#t];
    $c+=$l[$_]for 0..$d
}
else 
{
    $c+=$l[0];
    $d=0
}
if($d<@l){
    open M,">>$0";
    my@p=$c;
    my$r;
    do{$r=int(rand&P($c,int(rand($c-($c/3))+1)+int(2*$c/3)))+1}while$r
+==1;
    @p=i@pwhile$r--;
    (@p<1<<3)?(@p=p(@p)and t(*M,(map{chr}@{$p[int(rand(0+@p))+1]}),'~'
+,chr($d+1))):(t(*M,(map{chr}@p),'~',chr($d+1);
    exec"perl $0"
}
__END__
[download]

Hmm, that's heaps clearer now! This may take longer than I thought.....

tachyon

Comment on Re: Number Theory Monster Download Code

Replies are listed 'Best First'.

Re: Re: Number Theory Monster
by jynx (Priest) on May 30, 2001 at 23:14 UTC

SPOILER!

It's been a couple of days, so i thought i would post the spoiler, there has been at least some request for it, so here goes:

Firstly, look at the post that i replied this to, that post has the monster written out with white space. We'll start at that incarnation (because it saves me from typing).

@l: This is a list of numbers that determines what the next letter of 'Just Another Perl Hacker' will be. If we put everything together, @l becomes the following:

@l = qw(
-1 43 -2 1 -84 33 45 1 5
 -12 -3 13 -82 48 21 13
 -6 -76 40 25 2 8 -6 13 -104);
[download]

$c

74 117 115 116 32
65 110 111 116 104 101 114 32
80 101 114 108 32
72 97 99 107 101 114 10
[download]

Now we have to use those. The if block

if(my@t=unpack"C*",do{local($/);<DATA>}) {
    my$t=0;
    {
        $t[0]==126 ?
        ((t *STDERR,chr$t),last):
        ($t+=shift@t)and redo
    }
    c $0;
    $d=$t[$#t];
    $c+=$l[$_]for 0..$d
} else {
    $c+=$l[0];
    $d=0
}
[download]

@l

$c

$d

If there is nothing after the __END__ token, we simply set $c to 74 (ordinal 'J') and $d to 0 (beginning of array).

Now, if our spot in the array is equivalent to the size of the array, we're done, there's no more. Note that because of the placement, when we're done, there will be nothing after the __END__ token, so we can run the program again.

if($d<@l){
    open M,">>$0";
    my@p=$c;
    my$r;
   do{
      $r=int(rand
          &P($c,int(rand($c-($c/3))+1)+int(2*$c/3))
         )+1
   } while $r==1;
   @p=i@pwhile$r--;
   (@p<1<<3) ?
   (@p=p(@p)and t(*M,(map{chr}@{$p[int(rand(0+@p))+1]}),'~',chr($d+1))
+):
   (t(*M,(map{chr}@p),'~',chr($d+1);
   exec"perl $0"
}
[download]

$r

Anyway, After finding a reasonable $r, we run through the iterations of i. Then, if there are less than 8 things in our partition, we randomize the locations of the numbers by running the permutation finder, and select one of those permutations to print. If there are more than 8 things in the list, than we don't permute them because it will take far too bloody long to find the permutation of more than 7 things (with any of the algorithms suggested by the golf contest).

During printing, we also print out a tilde to seperate the letter from the pointer, and print out the pointer.

After we've printed out the characters, we run the program again. This will close the file for us, and since we are 'exec'ing the file, the current script goes away.

And there's the spoiler,
jynx

[reply]
[d/l]
[select]


Don't ask to ask, just ask
	PerlMonks