Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

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
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'MSWin32'?'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:

    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}
Is it possible to shorten this code?
2 direct replies — Read more / Contribute
by uacnix
on Jun 16, 2015 at 13:18

    Hello dearest Monks,

    i'm looking for the wisdom of shorthening my code:
    use LWP::Simple; @a = <>; getprint("".($a[0])."&b=".($a[2]));
    As You have noticed, i'm not interested in the second line, but it is required that the program takes 3 lines of input:

    -a digit

    -some bollox that You can skip in the program execution, but it will have to bypass/workaround/skip this line

    -some more or less random characters, that have to be passed as argument.

    I'm just a peasant in PERL, but I heard it's the best language to write shortest code, so i'm trying my luck with It.

    Thank You in advance guys.


    -I've checked the codes, and I've been able to use only the choroba's first code and at this place I'm really sorry that I didn't mention the STDIN input and chomp.

    I found a workaround for chomp- I do it "serverside", my script on the site checks for newline symbols and replaces them

    Anyway, thanks to You, dear Monks, my code is 14 chars shorter, and that's great progress, thank You!
Optimized Mandelbrot set generator
1 direct reply — Read more / Contribute
by thisisdada
on Jun 14, 2015 at 18:30

    I wrote a Mandelbrot set generator. It works on Windows ActivePerl 5.20.2 x64, but I haven't tried it on *nix. It outputs a smoothed, anti-aliased fractal image to 24-bit .bmp file. For optimizations, it takes advantage of symmetry; it skips the cardoid, the main bulb, and the line across y=0; and it checks for cycles when the iteration count gets high. On my computer (2.40GHz i5-2430M), it takes about 10 minutes to generate a 1500x1000 image.

    The code's designed to look like the set, of course. It takes user input to determine the size of the image and the outfile, i.e.:

    C:\Users\Kevin> 1200 mandel.bmp Generating fractal with dimensions 1200 by 800... [==================================================] Saving fractal to mandel.bmp... Done!

    If the given pixel width isn't divisible by 12, the program subtracts until it is.

    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}
Convoluted Echo
2 direct replies — Read more / Contribute
by KurtSchwind
on May 22, 2015 at 14:19

    So let's say you are on a *nix machine and you need an application that echos what you type. And let's further say that you want to use perl, python, ruby and shell to do it. I bring you convoluted echo. A perl script the writes and executes a python script that's and executes a ruby script which writes and executes a shell script to echo your command line arguments.

    Happy Memorial Day

    #!/usr/bin/perl my $echo = q{}; open my $py, '>', '' or die "Cannot open $!\n"; $py->print("#!/usr/bin/python\n\n"); $py->print("import os\n\n"); $py->print("fo = open(\"ce.rb\",\"w\")\n\n"); $py->print("fo.write(\"#!/usr/bin/ruby\\n\")\n"); $py->print("fo.write(\"out_file =\\\"\\\", \\\"w\\\ +")\\n\")\n"); $py->print(q{fo.write("out_file.puts(\"#!/bin/sh\\n\\necho $*\\n\\ +")\n")}); $py->print("\n"); $py->print(q{fo.write("out_file.close\n\n")}); $py->print("\n"); $py->print("\n"); foreach my $a (@ARGV) { $echo .= " ".$a; # $py->print( " $a "); } $py->print(q{fo.write("system(\"/bin/sh }); $py->print(" $echo "); $py->print(q{\")\n")}); $py->print("\nfo.close()\n"); $py->print("os.system(\"/usr/bin/ruby ce.rb\")\n"); close $py; system("/usr/bin/python");
    “For the Present is the point at which time touches eternity.” - CS Lewis

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 all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (9)
    As of 2018-05-23 17:06 GMT
    Find Nodes?
      Voting Booth?