The Perl Review

[Kit]

brian d foy has started up a new online Perl magazine. check it out here http://www.perl.org/ThePerlReview

Kit

[blakem]

Looks like a great contender to replace the downtrodden TPJ. Anyone interested in the golf-master position detailed below?

Perl Golf

We have not figured out the rules, chosen the judges, or calculated what your chances of winning really are, but we do have the prizes – Perl Mongers hats or tshirts along with a chance for fame and glory in the next issue of The Perl Review.

Solve the following problem with a ridiculously low number of keystrokes, uses Perl in some clever or devious way, or is otherwise interesting and send it to [e-mail].

Convert a base 36 number, with the digits [0-9A-Z], to its base 10 representation

If you would like to be a judge, or the maintainer of this column, or have an interesting golf problem, let us know. We can send you a hat or a t-shirt too.

Update: To get it started, here is my first attempt.... 61 chars

#!/usr/bin/perl -wT
use strict;

my $base36 = shift;
$base36 = 10 if !defined $base36;
die "invalid input, only 0-9 and A-Z allowed\n"
    if $base36 !~ /^[0-9A-Z]+\z/;

my $dec = base36($base36);

print "$base36 => $dec\n";

sub base36 {
  #        1         2         3         4         5         6
  #234567890123456789012345678901234567890123456789012345678901
  $%+=$_*36**$?++for reverse map/\d/?$_:ord($_)-55,pop=~/./g;$%
}

-Blake

[tilly]

How about 48?

sub h{
#        1         2         3         4
#23456789_123456789_123456789_123456789_12345678
($_,$s)=@_;y/A-Z/:-T/;$s=36*$s-48+ord for/./g;$s
}

PS If you read the problem statement carefully, there is a 1 character answer:

sub convert_0 {
0
}

tilly ducks

[blakem]

The y/// is very sneaky, but why play games with that $s? If you want a 0, see if one of $% $- $? or $[ work for you. Here it is shortened to 43 chars and as an added bonus, its now strict compatible.

#        1         2         3         4
#23456789_123456789_123456789_123456789_1234
$_=pop;y/A-Z/:-T/;$?=36*$?-48+ord for/./g;$?

-Blake

[jackdied]

Could someone brief me on the y/// syntax? I took a look in man perlre, and tried stepping through it in the debugger - both were futile.

-jackdied

[jynx]

ok,

i'm not even a contender for this one, but in the spirit of TMTOWTDI i submit the following 2:

# 1 (57 characters)
$a+=($_-($_|0?0:55))*36**$b++while$_=chop$ARGV[0];print$a

# 2 (63 characters)
print[map$a+=($_-($_|0?0:55))*36**$b++,reverse pop=~/./g]->[-1]

jynx

update: bad jynx! bad, evil, naughty jynx! not testing thoroughly! not golfing thoroughly! *sigh* neither of the above work correctly, i'm currently working on fixing them. *sigh* sorry 'bout that.

update2: here's both of them:

# 1 (still 57 characters, with props to petral for the idea)
$a+=(-55+/\d/*7+ord)*36**$b++while$_=chop$ARGV[0];print$a

# 2 (now 64 characters, with props to blakem for the idea)
print[map$a+=(/\d/?$_:-55+ord)*36**$b++,reverse pop=~/./g]->[-1]

[Koschei]

An amusing little test suite. The assorted strings in q!! are various peoples golf attempts from here and use.perl.org's article.

#!/usr/bin/perl -w
use Test::More qw/no_plan/;
use strict;

my%v=(
    '1'         => 1,
    '4'         => 4,
    'A'         => 10,
    '0'         => 'zero',
    'B'         => 11,
    'Z'         => 35,
    'AA'        => 370,
    '1F'        => 51,
    '03F'       => 3*36+15,
    'BF'        => 11*36+15,
    '2B3F'      => 107691,
);
foreach my$g(
    q!y/0-9A-Z/\0-#/;($a*=36)+=ord for/./g;$a! ,
    q!map{$t+=(ord()-(/\d/?48:55))*36**$l++}reverse split//,pop;$t! ,
    q!map{$t+=(ord()-(/\d/?48:55))*36**$l++}reverse split//,shift;$t! 
+,
    q!$a+=$_*36**$b++for reverse map/\d/?$_:ord($_)-55,pop=~/./g;$a! ,
    q!($_,$s)=@_;y/A-Z/:-T/;$s=36*$s-48+ord for/./g;$s! ,
    q!y/A-Z/:-T/;$a=36*$a-48+ord for/./g;$a! ,
    q!$a+=(-55+/\d/*7+ord)*36**$b++while$_=chop$ARGV[0];$a! ,
    q![map$a+=(/\d/?$_:-55+ord)*36**$b++,reverse pop=~/./g]->[-1]! ,
    q!$n=ord(pop);$a=($n>>6)?(($n&31)+9):($n&15);! ,
    q!eval join"+",map{$_=(-55+ord uc);$_+=6if/-/;"$_*36**".$i++}rever
+se split('');!,
    q!map$d=$d*36+(/\d/?$_:-55+ord),pop=~/./g;$d! ,
    q!$b=$b*36-48-7*/\D/+ord for pop=~/./g;$b! ,
    q!sub x{$_&&-7*/\D$/+ord(chop)-48+36*&x}x$_! ,
    #q!$n=pop;for(;$n ne((0..9),(A..Z))[$a];$a++){}"$a"||0;! ,
){while(my($i,$n)=each%v){my$o=eval"package G;no strict;no warnings;\@
+A".
"RGV=\@_=(\$_='$i');do{$g}||'zero';"or die$@;delete $::{'G::'};if(defi
+ned
$o){ok($o eq$n,sprintf("| %-4s -> %-6s == %-6s (length %3d) [%s]",$i,$
+o,
$n,length $g,$g))}else{fail "Return value undefined ($g)"}}}

[Biker]

Nice. Interesting. If ever they go paper, I'll send in my subscription.

Just one comment: I noticed they've given a new, or at least different, meaning to 'XP'. ;-)

"Livet är hårt" sa bonden.
"Grymt" sa grisen...

[Anonymous Monk]

My first golf attempt (the base 36 question above).. any inspirational thoughts/comments?


$_="asd123";

print eval join"+",map{$_=(-54+ord uc);$_+=6if/-/;"$_*36**".$i++}rever
+se split('');

[blakem]

Two quick comments. Your values are off by one 'A' => 11 instead of 10. Also split('') is shorter as /./g

Other than that, I like it... eval entries are always cool.

-Blake

[jackdied]

Here are mine,

Update : since I didn't understand anyone elses (give or take) I've added explanations to mine

The first is obvious (51 chars)
The second is stated in a couple different ways (43 chars, 50 chars obfu'd)


sub obvious{
#  (explained : count from zero until Z, return the current count if w
+e found the position we are looking for)
    #        1         2         3         4         5         6
    #23456789012345678901234567890123456789012345678901234567890
    $n=pop;for(;$n ne((0..9),(A..Z))[$a];$a++){}"$a"||0;
}

This one is more fun, it uses bitwise arithmatic to get the solution. The commented line is the same as the first, but more obfu


sub fun {
# (explained : reduce the numbers to their base2 (binary)
# representation.  we always care about the
# lowest four bits ($n & 0x1111 is $n & 15).  If the ord of
# the number is in the A-Z range the 7th bit will be set
# ($n >> 6) will be true.  In this case, also include the
# 6th bit in the number ($n & 31) instead of ($n & 15).
# Since A-Z starts at ten, add 9 as well)
    #        1         2         3         4         5         6
    #23456789012345678901234567890123456789012345678901234567890
    $n=ord(pop);$a=($n>>6)?(($n&31)+9):($n&15);
    # same thing, but obfu
  # $n=ord(pop);$a=($n&(1<<(4+($n>>6)))-1)+($n>>6&&9);
}


Enjoy, or not, at your leisure.

-jackdied

PS, posting with mozilla is the biggest pain in the ass ever. It tries to do smart things with wrapping in a text box, and translating spaces and returns for you with some AI that makes posting code hell.

[Purdy]

Here was my final submission, from a beginner ... 71

map{$t+=(ord()-(/\d/?48:55))*36**$l++}reverse split//,shift;print"$t\n"

If I took out the final ;print"$t\n", that would take it down to 59. Cool to use pop vs. shift ... shave off 2 more strokes. I'll have to remember that for the next round. :)

Jason

[chipmunk]

My best solution is 47 characters:

#!/usr/local/bin/perl -l

print hole(uc $_) for @ARGV;

sub hole {
#        1         2         3         4
#2345678901234567890123456789012345678901234567
my$d;map$d=$d*36+(/\d/?$_:-55+ord),pop=~/./g;$d
}

The simple framework allows for convenient testing: % perl base36.pl 1 A 10

[arhuman]

Hey ! I just read the (GREAT) magazine, here's my proposition :



perl -F// -ane'print+(map{($r*=36)+=/\d/?$_:-55+ord$_}@F)[-2]'


it's a filter so call it as usual through a pipe :


echo 1Z|perl -F// -ane'print+(map{($r*=36)+=/\d/?$_:-55+ord$_}@F)[-2]'


UPDATE :
Congratulations to all of you.
After reading your solutions, I found several neat tricks to enhance mine
(Epecially thanks to blakem and tilly's post) .
'ord' should definitly replace 'ord$_'...
For some (yet unknown) reasons I can't replace ($r*=36)+=... by $r=$r*36+...
(I'll work on it tomorrow, I REALLY need to sleep ;-)
Last :


perl -F// -ane'print+(map{($r*=36)+=/\d/?$_:-55+ord}@F)[-2]'



"Only Bad Coders Code Badly In Perl" (OBC2BIP)

[jmcnamara]

25 chars.

I wasn't going to post this since it uses a module but I guess that someone should.

sub base36 {
    #23456789_123456789_12345 (25)
    use POSIX;0+strtol+pop,36
}

--
John.

[petral]

Here's another similar one:

$b=$b*36-48-7*/\D/+ord for pop=~/./g;
print$b,$/

36 or 47 chars depending on how you count. Another WTDI using recursion:

sub x{
  $_&&-7*/\D$/+ord(chop)-48+36*&x
}
$_=pop;
print x,$/

which is 31 chars inside the sub and 55 chars total.

  p

[Dog and Pony]

Oh, I should have known there would be a thread like this one here somewhere. :)

Anyways, here is my best shot, as it were:



map{$r+=36**$i++*(/\D/?-55+ord:$_)}reverse split'';

The result going into $r, this is 50 or 51 characters depending on if you count the semi-colon. Since this was my first attempt at something like this ever, I think it was pretty good.

As proof of concept, I did try some of the other variants aswell (you only replace the '36' above):



#!/usr/bin/perl

# Base 36, [0-9A-Z]
$_="II";
map{$r+=36**$i++*(/\D/?-55+ord:$_)}reverse split'';
print "$r\n";

# Hex
$_="29A";
map{$t+=16**$j++*(/\D/?-55+ord:$_)}reverse split'';
print "$t\n";

# Bin
$_="1010011010";
map{$s+=2**$k++*(/\D/?-55+ord:$_)}reverse split'';
print "$s\n";

# Dec :)
$_="666";
map{$u+=10**$l++*(/\D/?-55+ord:$_)}reverse split'';
print "$u\n";

Comments on how to not beat this one, but rather if this special path could have been improved would be appreciated. I was looking into some of the deprecated stuff about a split in scalar mode going into @_, but although that shortened the routine with one character, it also produced the wrong result by -36, and with that fixed, it had lost again. :) Same thing with all my tries to get rid of that pesky reverse.

[redsquirrel]

Here's my somewhat belated attempt.

!perl -n
$n+=(/\d/?$_:-55+ord)*36**$i++for reverse/./g;print$n

This solution assumes the number is coming at it via STDIN. Standard FWP golf scoring shows a score of 57.

--Dave