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 comdog@panix.com.

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.

#!/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;$%
}
[download]

-Blake

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
}
[download]

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

sub convert_0 {
0
}
[download]

tilly ducks

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;$?
[download]

-Blake

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

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]
[download]

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]
[download]

#!/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)"}}}
[download]

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...

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('');
[download]

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

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;
}
[download]

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);
}
[download]

-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.

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

#!/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
}
[download]

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

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

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

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
}
[download]

--
John.

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

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

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

#!/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";
[download]

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

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

--Dave