Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

How to (ab)use map

by Erudil (Prior)
on Aug 14, 2000 at 15:48 UTC ( #27731=obfuscated: print w/ replies, xml ) Need Help??

#!/usr/bin/perl -w # how to (ab)use map use strict; map{map{map{y; $_=map{}(/^?.*/); $_=1612a45368054;d; $_=(++$a==1?$b--:0)+hex$_; $_=$a&1?$"x $_:"_\/"x $_;print}split//}/../g;$a=0;print$/}split/_|\s+/,<<map; .map?()map_.1(1{1)map{map_.1{map{map{map_.1{map{map{map .1{/{()/_.1{map{1}map_*map{map{1}map_*map{map{1}map_{^)map{1}map map BEGIN{$b=1<<(@_=split//,"map")}

Comment on How to (ab)use map
Download Code
RE: How to (ab)use map
by mrmick (Curate) on Aug 14, 2000 at 20:18 UTC
    Cool!

    I'ts going to take more than a few minutes for me to figure out how this works. Especially since I've never used map before.

    I especially like the 3D-ish look.

    Mick
Re: How to (ab)use map
by kilinrax (Deacon) on Apr 04, 2001 at 21:18 UTC

    Caution: Spoilers Ahead

    Since this is a downright devious japh, and no-one else has tried to expain it yet, I feel the need to try.

    Firstly, let me rearrange the code so it's slightly easier to read:
    #!/usr/bin/perl -w # how to (ab)use map use strict; map{ map{ map{ y;$_=map{}(/^?.*/);$_=1612a45368054;d; $_ = (++$a == 1 ? $b-- : 0) + hex $_; $_ = $a & 1 ? $" x $_ : "_\/" x $_; print } split//; } /../g; $a = 0; print $/ } split /_|\s+/, <<map; .map?()map_.1(1{1)map{map_.1{map{map{map_.1{map{map{map .1{/{()/_.1{map{1}map_*map{map{1}map_*map{map{1}map_{^)map{1}map map BEGIN{ $b=1 << (@_ = split//, "map") }

    As you can probably tell, the key to this japh is realising that the maps at the end are part of a here doc, delimited by 'map' (I said it was devious ;-)
    Taking that, and applying the split (on underscores or whitespace) to it, results in the following array:

    qw[ .map?()map .1(1{1)map{map .1{map{map{map .1{map{map{map .1{/{()/ .1{map{1}map *map{map{1}map *map{map{1}map {^)map{1}map ];

    Lets clean up a few more things, then we can see what those maps are doing to that array.

    1. The 'BEGIN'routine initialises '$b' to the value 1, left shifted by the number of elements in the array of characters in "map" (i.e. 3)
      1 << 3 is equal to 8, so functionally the routine is equivalent to putting 'my $b = 8' at the top of the script.
    2. '$/' and '$"', the input record and list separators have values of "\n" and " " by default, so I'll just substitute them for clarity. Also "_\/" is less confusingly written as '_/'.
    3. 'y;$_=map{}(/^?.*/);$_=1612a45368054;d;' is functionally equivalent to 'tr|map{}(/^?.*/)|1612a45368054|d;', so again, I'll substitute for clarity.
    4. Any 'map' can be replaced with a foreach. Doing so will hopefully make the code easier to read.
    Applying all the above, and assuming '@array' to be the array defined above:

    my $b = 8; foreach (@array) { my $a; foreach (/../g) { foreach (split //) { tr|map{}(/^?.*/)|1612a45368054|d; $_ = (++$a == 1 ? $b-- : 0) + hex $_; $_ = $a & 1 ? ' ' x $_ : '_/' x $_; print } } $a = 0; print "\n" }

    So what are the map/foreach loops doing to the array?
    Well, fairly obviously, the outer one iterates over the array, resetting '$a' to 0 and printing a newline at the end of each one (note: setting '$a' at the end of the loop is functionally equivalent to setting it at the beginning, as it will have an effective value of 0 the first time it is used anyway).
    The middle one splits the current element into two-character chunks, and iterates over them, and then the inner one splits the chunks into component characters. The astute amongst you will have noticed that this makes the middle loop entirely redundant (except for it's intended purpose, I suspect, of confusing the hell out of anyone trying to fathom the reason for it's existence).

    The real magic is going on in the three lines of the inner loop:

    tr|map{}(/^?.*/)|1612a45368054|d; $_ = (++$a == 1 ? $b-- : 0) + hex $_; $_ = $a & 1 ? ' ' x $_ : '_/' x $_;

    The first line is obviously applying a translation from the map-esque line noise in the here doc to what looks like hex digits.
    Applying this to the array manually gives us:

    qw[ 8161644161 81412141612161 81216121612161 81216121612161 81252445 81216121a161 0161216121a161 0161216121a161 23416121a161 ];

    The second line first pre-increments '$a', and then adds either 0 or the value of '$b', post-decremented (if '$a' currently equals one, which it will do on the first iteration of the loop), to the current character, taken as a hex value, and assigns it back to '$_'.
    The third line tests if '$a' is odd or even, and assigns '$_' times either ' ' or '_/' (respectively) back to '$_', which is printed in the next line.

    That's not too easy to express in words, so here's a much-simplified version of the japh, with all the clean-ups I've mentioned so far, plus quite a few others:

    #!/usr/bin/perl -w use strict; my $b = 8; foreach my $line (<DATA>) { chomp $line; my $a = 0; foreach my $num (split //, $line) { my ($multiplier, $char); $a++; if ($a == 1) { $b--; $multiplier = $b + hex $num; } else { $multiplier = hex $num; } if ($a & 1) { $char = ' '; } else { $char = '_/'; } print $char x $multiplier; } print "\n"; } exit 1; __DATA__ 8161644161 81412141612161 81216121612161 81216121612161 81252445 81216121a161 0161216121a161 0161216121a161 23416121a161

    Essentially, each array element corresponds to a line.
    At the start of the line, the script prints a number of spaces equal to the value of the first character, plus the current value of '$b' (which it reduces at the same time, giving the slanting effect). It then takes the value of the next character, and prints that many '_/' strings. It then carries on converting values into strings, alternating between using ' ' and '_/'. At the end of the line, '$a' is reset to make sure the next line starts with spaces, and a newline is printed.
    Adding a print statement in between the second and third line of the inner loop demonstrates this effect quite nicely.

    Yet again, much respect to Erudil for a impressively sick japh ;-)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: obfuscated [id://27731]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (13)
As of 2014-08-27 18:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (248 votes), past polls