Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options

Obfuscated code

( #1597=superdoc: print w/ replies, xml ) Need Help??

Got some code which would take a Perl grand master to understand without running it? Post it in this section so we can stare at it in awe.

Word of warning, though: Don't be too cocky with your post — almost inevitably someone will post a reply that does the exact same thing in even fewer characters!

New Less than Readable Code
Having fun with ambiguity
No replies — Read more | Post response
by trizen
on May 23, 2016 at 14:30
    print $$ /0; # a legit division by zero ^....some.....^ ^^ ^....magic....^ |(?{m}(?{"\[\[\) \.\\\|\`\]\[\[\{ \[\.\@\/\(\^\.\[ \{\;\\\,\[\@\:\? \+\^\)\("=~s\}[\ \s]\}\}rg^"\+\)\ \@\@\(\^\*\(\(\/ \[\:\@\/\[\@\;\\ \{\+\^\.\@\{\(\[ \\\@\;\[\"\""=~s \}\s\}\}gr\})},s \/\/$^R\/esex})| ^....hugs....^ ^.....&......^ ^...kisses...^ // //xo//xo//xo//xo//xo//xo//xo// //
Test Post to check new edit feature
1 direct reply — Read more / Contribute
by LanX
on Mar 10, 2016 at 17:14
    If you are a cabal and want to test jdporter's new edit/update button reply in this thread. We can delete later again.

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

Using the olde times internet
3 direct replies — Read more / Contribute
by lemonCurd
on Feb 14, 2016 at 09:45

    I'm contemplating about this very little piece of Perl code. I'm already more than a little bit proud of it, but I wondered if the venerated Monks had suggestions to make it even shorter:

    print"@ARGV"=~s|.|$_=2+index'temaniowkugrdsXjyqxvpcfzlbh',lc$&;$Q= 1.45*log;$_-=1<<$Q;for($O='';--$Q>0;$_/=2){$O.=chr$_%2+45}"$O "|ger

    Try it with some text as command line arguments.

    Especially I'm curious about:

    • Is there any way to avoid initializing $O?
    • I use $Q=1.45*log to approximate the number of bits in $_. Any shorter way?
    Every comment is very much appreciated!

    2/15/2016: Corrected two typos!

Not a golf but a wish..
1 direct reply — Read more / Contribute
by Discipulus
on Dec 23, 2015 at 04:50
    i've been inspired by this code by LanX and mtve (read: i've stolen their golfs as the base..)
    to produce something for you all, which intent is clear from BEGIN where the root of every (binary?) tree sleeps...
    not a golf but a wish!
    # ## ##!/env/perl # # $} ;$| ++; $p;$x; #\*/# foreach $b( split '\+','+0+77+ -8+13+0+7+-57 //\\//\\//\\/ +35+5+10+-9+10+1 +-7+-12+18+-51+ 33 //\\//\\//\\//\\//\\ +13+-10+-36+40+-7+15+0+ 9+-57+46+-9+18+-55+57+-20 //\\//\\//\\//\\//\\//\\//\\ +-4+17+-50+18+-2+1+5+-44+22+0+0+ 52+-5+-47+57+-10+6+-53+33+11+0+-44 //\\//\\//\\//\\//\\//\\//\\//\\//\\ +48+-11+13+-6+1+2+-1+-3+8+-51+38+12+-3+ -2+-45+36+5+10+-16+6+7+5+-9+9+-2+-51+0+10 //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\//\\ +-32+0'){system$};eval 'printf qq(%22s%s\n), $_ %=21,$_=4**$_,y/0/^/c,s/0/$b<0?o:O/eeee for 1..23'; print $y.= chr($x += $p);$p = $b; sleep 1 } print chr( $x += $p ) ; # BEGIN{$}=$^O eq'Linux'?'clear':'cls';$^W=0} BEGIN{$}=$^O eq'Win32'?'cls':'clear';$^W=0}
    Justin Case there is gift under the tree..

    update: changed the BEGIN block to be more inclusive..

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
/dev/rand quoting practice
No replies — Read more | Post response
by ohcamacj
on Oct 13, 2015 at 10:05
Amusement Japh
2 direct replies — Read more / Contribute
by golux
on Oct 12, 2015 at 23:32
    Tested on both Linux and Windows, and requires the Tk module to be installed. There's a lot more I could add to the basic program, but the obfuscated version was already getting fairly large.

    Without giving too much away (and perhaps you've already guessed what it does), the arrow keys work the same as the keys 'h', 'j', 'k' and 'l'. Use ^C to quit, and try the <space> and 'n' keys too.

    Visually, there's a nice surprise when it runs (see if you can figure out the trick). I had a lot of fun getting the format "just right", and was pleased to see that "perl -MO=Deparse" didn't give anything away :-)


    s''$a=[];$ b=[];$c={} ;$d={};$e= [];$f={};$ g=[];use`T k;$W=MainW indow->new ;$W->iconi fy;$W->geo metry("1x1 -1-1");$W- >repeat(50 =>sub{$h`o r$W->deico nify;$i#0; if($o){#1i f$h++%5}el sif(!$j){# 1if$h++%20 }if($o){#3 Y=21;$Y>1; $Y--){my$J =$a#6Y];#3 X=0;$X<@$J ;$X++){my$ V=$J#6X]|| 0;(#7$o->{ $V})#2my$T =#5f->{$Y} ->{$X};my$ Z=$Y+1;$a# 6Y]#6X]=0; $a#6Z]#6X] =$V;$f->{$ Z}->{$X}=$ T;J($T,$X, $Z)}}$o=&M }my$N=0;#3 Y=2;$Y<22; $Y++){my$J =$a#6Y];my $K=1;#3X=0 ;$X<@$J;$X ++){(2==$J #6X])or$K= 0}if($K){+ +$N;$J->[0 ]=3}}if($N ){#3Y=2;$Y <22;$Y++){ my$J=$a#6Y ];(3==$J-> [0])#2#3X= 0;$X<@$J;$ X++){$a#6Y ]#6X]=0;(# 5f->{$Y}-> {$X})#4}my $L=5;#3Y=2 ;$Y<22;$Y+ +){my$J=$a #6Y];#3X=0 ;$X<@$J;$X ++){L($X,$ Y,2,$L++)i f(2==$a#6Y ]#6X])}}$o =&M;$o#0}@ $b`or`do{m y$M=$n||&I ;@$g`and`D ($g);$n=&I ;my$v=$d-> {$n}->[0]; for(@$v){m y($X,$Y)=@ $_;my$x0=4 24+14*$X;m y$y0=32+14 *$Y;my$G=[ $x0,$y0,14 ,14];my$T= B($c->{$n} ,$G);#8@$g ,[$x0,$y0, $T];}$m=$M ;my$Q=$d-> {$M}->[0]; $k=0;$b=[] ;for`my$w( @$Q){my($X ,$Y)=@$w;i f($a#6Y]#6 X+3]){for` my$R(keys% $f){my$x=$ f->{$R};ma p{$_->conf igure(-bg= >"gray")}v alues%$x}& F;$h=0;$b= [];#1$i=1} }my$I=0;fo r(@$Q){my( $X,$Y)=@$_ ;$X+=3;$I+ +or$l=$X;m y$T=B($c-> {$M},0);#8 @$b,[$X,$Y ,$T];J($T, $X,$Y);$a# 6Y]#6X]=1} #1&N};for( @$b){my($x 1,$Z)=($_- >[0],1+$_- >[1]);($Z< 22)or`goto `N;my$V=$a #6Z]#6x1]| |0;($V>1)a nd`goto`N} for(@$b){m y($X,$Y)=@ $_;$a#6Y]# 6X]=0;}for (@$b){++$_ ->[1];my($ X,$Y,$T)=@ $_;J($T,$X ,$Y);$a#6Y ]#6X]=1}#1 ;N:$j=0;wh ile(@$b){m y$w=shift@ $b;my($X,$ Y,$T)=@$w; $a#6Y]#6X] =2;$f->{$Y }->{$X}=$T }$b=[];&N; });$W->bin d("<Contro l-c>"=>sub {exit});$W ->bind("<K eyPress>"= >sub{my$E= shift;my$F =lc($E->XE vent->K);( $F`eq"n")# 0&E;@$b#0( $F=~/\Ah|l eft/)?G(-1 ):($F=~/\A l|right/)? G(1):($F=~ /\Aj|down/ )?H(-1):($ F=~/\Ak|up /)?H(1):(" space"eq$F )?$j=1:0}) ;&A;for`my $P([qw[I`1 59d`89ab`e a62`7654`c yan]],[qw[ J`159`8456 `a951`2654 `blue]],[q w[L`1598`4 56a`9512`6 540`orange ]],[qw[O`4 589`4589`4 589`4589`y ellow]],[q w[S`4158`4 59a`9562`6 510`green] ],[qw[T`14 59`4956`96 51`6154`pl um]],[qw[Z `459`8956` a651`2154` red]],){my $R=shift@$ P;my$O=$d- >{$R}=[];$ c->{$R}=po p@$P;map{m y$Q=[];my$ V=hex($_); for(1..4){ my$Y=$V&0x 03;$V>>=2; my$X=$V&0x 03;$V>>=2; unshift@$Q ,[$X,$Y]}# 8@$O,$Q}@$ P}map{B("b lack",$_)} ([128,648, 280,8],[12 0,620,8,36 ],[408,620 ,8,36]);Tk ::MainLoop ;^A{#9Y=0; $Y<22;$Y++ ){map{$a#6 Y]#6_]=0}( 0..9)}}^B{ my($B,$G)= @_;my$T=$W ->Toplevel ;$T->overr ideredirec t(1);$T->c onfigure(- highlightt =>1,-highl ightb=>"bl ack",-back ground=>$B );#1$G?K($ T,@$G):$T} ^C{my($X,$ Y)=@_;#1($ X<0or$X>9o r$Y<0or$Y> 21)?0:1}^D {my$t=pop; while(my$P =shift@$t) {$P->[2]#4 }^E{&A;D($ b);D($g);$ b=[];for(k eys%$f){my $S=#5f->{$ _};map{(#5 S->{$_})#4 keys%$S}&F ;$i=$j=$h= 0}^F{map{$ _->[0]#4@$ e;$e=[]}^G {my$D=pop; for`my$u(@ $b){my($X, $Y)=@$u;($ a#6Y]#6X+$ D]>1)#0;C( $X+$D,$Y)o r#1}my$I=0 ;for(@$b){ my($X,$Y,$ T)=@$_;--$ a#6Y]#6X]; ++$a#6Y]#6 X+=$D];J($ T,$X,$Y);$ I++or$l=$X ;$_->[0]=$ X}&N}^H{my $p=pop;($m `eq"O")#0; my$N1=($k+ $p)%4;my$A r=$d->{$m} ;my$As=$Ar #6k];my$At =$Ar#6N1]; my$O=[];my $N=[];#9I= 0;$I<@$b;$ I++){my$u= $b#6I];my( $X,$Y,$T)= @$u;my($x0 ,$y0)=@{$A s#6I]};my( $x1,$Z)=@{ $At#6I]};m y$D=$x1-$x 0;my$s=$Z- $y0;#8@$O, [$X,$Y];C( $X+=$D,$Y+ =$s)or#1;# 8@$N,[$X,$ Y,$T];}$b= $N;$k=$N1; #9I=0;$I<@ $O;$I++){m y($x0,$y0) =@{$O#6I]} ;my($x1,$Z ,$T)=@{$N# 6I]};--$a# 6y0]#6x0]; ++$a#6Z]#6 x1];J($T,$ x1,$Z);$I` or$l=$x1}& N}^I{@r=ke ys%$c;$r[r and@r]}^J{ my($T,$X,$ Y)=@_;K($T ,128+28*$X ,32+28*$Y) }^K{my($T, $X,$Y,$W,$ H)=@_;$W|| =28;$H||=2 8;$T->geom etry("${W} x$H+$X+$Y" );$T}^L{my ($X,$Y,$U, $V)=@_;#1i f$X<0or$X> 9or$Y<0or$ Y>21;if($U !=$V){($U= =$a#6Y]#6X ])or#1;$a# 6Y]#6X]=$V ;L($X-1,$Y ,$U,$V);L( $X+1,$Y,$U ,$V);L($X, $Y-1,$U,$V );L($X,$Y+ 1,$U,$V)}} ^M{my$E={} ;my$F={};# 9Y=2;$Y<22 ;$Y++){my$ J=$a#6Y];# 9X=0;$X<@$ J;$X++){my $V=$J#6X]| |0;($V>4)# 2++$F->{$V };next`if( #7$E->{$V} );my$Z=$Y+ 1;my$G=($Z >21)?4:$a# 6Z]#6X];($ G>0and$G!= $V)and++$E ->{$V}}}#9 Y=2;$Y<22; $Y++){my$J =$a#6Y];#9 X=0;$X<@$J ;$X++){my$ V=$J#6X]|| 0;(#7$E->{ $V})#2#5F- >{$V};$J#6 X]=2}}(key s%$F)?$F:0 }^N{&F;for `my$u(@$b) {my$X=128+ 28*$u->[0] ;my$G=[$X, 664,28,14] ;my$T=B("p urple",$G) ;push@$e,[ $T,$G]}}'; s+\s*++g;$o=0;for$l(' and return ',' return ',' or next;',########### ' for(my$','->destroy}','delete$','->[$','exists','push',# by golux # 'for(my$'){s&#$o&$l&g&&++$o}eval if s&\^&sub &g&&s&`&$"&g#2015-10-12#
    say  substr+lc crypt(qw $i3 SI$),4,5
42-character maze generator
4 direct replies — Read more / Contribute
by Grimy
on Sep 07, 2015 at 08:46
    print$/,map~ZjN^G^0.0.3x rand 2,1..80for%!
3 direct replies — Read more / Contribute
by Grimy
on Aug 24, 2015 at 05:24
    sub'r{$==rand pop}$|=print"\e[2J";r$l=`tput lines`-2,s/^$/"\e[$=;".r($ +c =`tput cols`-2).f.' Oo*... '=~s!\S\K!\e[B\b !gr/e/s/\d++\B/($a=$&-1)+( +$ ==!$a+r$a%$c?3:2)/e/s/(?<=(.)...B.)./$1/g/s/f\K./chr 32>>$=/e/s/\d+/($ +& ||$l)-1/e,select$,,$,,$,,.009*print$&?$_:"\e[f"."\e[K\n"x6while*_=r.r+ +9
    EDIT: golfed it down a bit, also fixed some literal edge cases (the sprites where behaving strangely when they hit the edges of the screen).
    sub'v{$==!$-+rand pop}[s/\d+/$|--?($-=$&-1)+v$-%$c?3:2:$&-print||`stty + size`- print$&?"\e[?25l\e[2J":y!Oo*.! !r/ge?s/(?<=f|(.))...B.\K./$1||chr 32>> +$=/ge.. 4E4:s/|/o*... //s//\e[B\b /g/s//\e[1;${\v$c=`tput cols`-2}fO/]while*_= +_.v-42#
    The number at the beginning of the last line determines the speed (smaller = faster). The number at the end of the last line is the maximum number of sprites that can be on screen simultaneously.
Autobots, roll out
3 direct replies — Read more / Contribute
by drpaz
on Aug 06, 2015 at 16:05

    Been a while since I posted anything new, had some fun with this. This uses xterm-256 but tested well with putty and comes out fine on cygwin as well.

    #!/usr/bin/perl -w use strict; my @d; my$__ # = ':'; my # $___ =18 ;for( 'a' ..'d' ){ push # @d,$_ .$__. $___;$___ ++;}$___ +=5;for('e'..'i'){push @d,$_.$__ .$___ ;$___+=6;}$___=''; for(1..3) { $___.=$_}push@d,'j'.$__.$___ ;$___=''; for( 1..9){$___.=$_ unless(($_-1)%4 ); }push@d,'k'.$__.$___;$___=''; for('a'.. 'am'){$___.=$_;}push@d,'l'.$__. length($___ );$___=length($___)+36;push @d,'m' . $__.$___;$___*=2;$___-=16;push @d,'n' . $__.$___;$___+=36;for('o'.. 's'){push @d,$_.$__.$___;$___+=7;}push @d,'W'. $__ .$___;my@__;$___=''; while( <DATA>){chomp;s/\s//g; $___.=$_; }push@d,split/\//, $___;my$m; foreach(@d){if( m/^(\w):(.*)$/ ){$m->{$1}="\033". '[48;5;'. $2."m \033[0m";} else{ s/S/ /g;my$_oO_; while((s/^(\d+)(.)//)) {$_oO_ .=$2 x$1}$_oO_ .=$_;$_= $_oO_;$_.= ######### reverse$_; s/(\w)/$m->{$1}/g; print;print "\n";}}#### __DATA__ 22S18 a/18S22b/16S24c /14a2S21d3S/ 14b2S13e11S/14c 3S17f6S/1S13d 3S17g6S/1S13e3S2 1h2S/1S6f3S5f5 S20i/2S5g5S6g6S1 6j/2S7h5S7h5S1 4k/2S9i5S8i5S11W/3 S4j2S5j4S10j4S8 W/3S4k4S5k4S9k6S5W/ 3S4W6S5W5S6W9S2W /3S6W6S5W5S4W3S2W6S/ 4S7W6S5W5S3W2S4W4S /4S9W7S4W3S3W3S5W2S/ 4S 12W6S8W3S6W1S/6S 12W7S6W2S7W/8S13W6S4 W3S6W/3S3W6S1W10l5S2 l1W3S1W5l/3S1W2l 2W 5S2W16l1W2S1W5l/3S2 W3l2W5S3W13l1W3S 1W4l/4S1W5m2W6S14W3S 1W4m/4S1W7m2W21S1W 4m/4S1W8m1W21S1W4m/ 5S1W7n1W21S1W4n/6S1W 6n1W16S3W3S1W3n/6S1 W7n4W10S2W2n1W3S1W3n/ 6S1W11o4W3S3W4o1W3S1W 3o/6S1W14o1W2S1W7o1W3 S1W3o/6S1W14o1W2S1W7o1 W3S1W3o/6S1W14p1W2S1W7 p1W3S1W3p/7S1W13p1W2S1W 7p1W3S1W3p/7S1W13p1W2 S1W7p1W3S1W3p/7S1W13q1W2S 1W7q1W3S4W/7S1W13q1W2 S1W7q1W7S/7S1W13q1W2S1W7q 8W/7S2W12q1W2S1W15q/9 S1W11r1W2S1W15r/10S1W10r 1W2S1W8r7W/11S1W9r1W2 S1W7r1W7S/12S4W5s1W2S1W5s2W 2S6W/16S2W3s1W2S1W4s1 W3S1W6q/18S4W2S1W4s1W2S1W7r /24S5W2S1W8s/24S5W2S9W /26S2W3S9W/
How not to do prime factorization
2 direct replies — Read more / Contribute
by thisisdada
on Jun 30, 2015 at 10:05
    $"x=$%="@ARGV";$~=$;='( +)';while($%>>$:++){if($"=~/$~$/^$"=~/$;$/){$ |=$?=$:>2||die"prime\n";eval"print length(\$$?)".($:>++$?&&"/length(\$ $?).'*'")while$:>$?;die$/}$;=$~;$~=~s~.*~^($&\\1+)~;$~=~s;\d+;1+$&;eg}

    The best thing I can say about this code is that it works. It will take a number via argv give you the prime factorization of that number... eventually. It's not very efficient. At all. I had a lot of fun writing it, but it's really bad at what it does. To give you an idea of how erratic it is, here are some benchmarks:

    Kevin@muzyx /cygdrive/c/users/kevin $ time perl 10000 2*2*2*2*5*5*5*5 real 0m4.001s user 0m3.977s sys 0m0.015s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 32767 7*31*151 real 0m6.891s user 0m6.832s sys 0m0.031s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 32768 2*2*2*2*2*2*2*2*2*2*2*2*2*2*2 real 2m50.119s user 2m49.588s sys 0m0.015s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 32769 3*3*11*331 real 0m13.282s user 0m13.213s sys 0m0.015s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 65535 3*5*17*257 real 1m11.228s user 1m8.422s sys 0m0.061s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 65536 2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2 real 22m20.875s user 20m55.277s sys 0m0.920s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 65537 prime real 0m0.903s user 0m0.842s sys 0m0.031s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 65538 2*3*3*11*331 real 1m40.633s user 1m40.183s sys 0m0.077s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 100000 2*2*2*2*2*5*5*5*5*5 real 20m59.463s user 20m53.998s sys 0m0.202s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 100003 prime real 0m2.090s user 0m2.043s sys 0m0.046s Kevin@muzyx /cygdrive/c/users/kevin $ time perl 1000003 prime real 3m23.670s user 3m22.411s sys 0m0.062s

    While it can distinguish primes at a reasonable rate, it takes a really long time to factor composite numbers. Particularly composite numbers made up of several small primes. Powers of 2 are the worst-case scenario.

    for$b(-25..25){for$a(-50..29){$x=$a/21;$y=$b/15;print$b?chr:chr^chr ord(substr'<6C}'.1x29 .'[FDEq2?@E96Cqa6C=q924',$a)-49;$_=30;($y,$x) =(2*$x*$y+$b/15,$x*$x-$y*$y+$a/21)while$x*$x+$y*$y<9&$_++<95}$_=10}

Set the new obfuscation standard
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (9)
    As of 2016-07-25 12:55 GMT
    Find Nodes?
      Voting Booth?
      What is your favorite alternate name for a (specific) keyboard key?

      Results (224 votes). Check out past polls.