Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

comment on

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

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 ;-)

In reply to Re: How to (ab)use map by kilinrax
in thread How to (ab)use map by Erudil

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

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?

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

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (5)
As of 2023-10-01 08:30 GMT
Find Nodes?
    Voting Booth?

    No recent polls found