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=; 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($/);}) { 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__