Slash Boxes
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

dpuu (6090)

  (email not shown publicly)
Yahoo! ID: dave_whipp (Add User, Send Message)

Journal of dpuu (6090)

Wednesday December 24, 2008
05:16 PM

Instant runoff voting...

Advanced Challenge 3...

A couple of different approaches here: one is
to maintain a list of excluded candidates, and then ignore them during
recounts. The other is to actually delete them from the ballot and then
recount. Both solutions work: the first uses junctions; the other uses the
"is rw" trait on a for loop. So both are of some interest.

First: the junctional approach...

my @ballots = (
        [< A B C D >],
        [< B D C A >],
        [< C D B A >],
        [< B A C D >],
        [< A D C B >],

my $winner;
my @excluded;

while ! $winner {

        my %tallies;
        for @ballots -> @ballot {
                if @ballot.first: { $_ ne all(@excluded) } -> $chosen {
                        %tallies{ $chosen } ++;

        my $total = [+] %tallies.values;

        if %tallies.pairs.first: { .value > $total/2 } -> $kv {
                $winner = $kv.key;
        else {
                my $losing_tally = min %tallies.values;
                for %tallies.pairs.grep: { .value == $losing_tally } -> $kv {
                        my $loser = $kv.key;
                        say "exclude $loser";
                        @excluded.push: $loser;

say "WINNER IS: $winner";

That wasn't too hard. Note the "pointy-block" used with the "if" statement -- this syntax isn't limited to "for" loops!

The other way is almost identical:

my $winner;

while ! $winner {

        my %tallies;
        for @ballots.grep: {.elems} -> @ballot {
                %tallies{ @ballot[0] } ++;

        my $total = [+] %tallies.values;

        if %tallies.pairs.first: { .value > $total/2 } -> $kv {
                $winner = $kv.key;
        else {
                my $losing_tally = min %tallies.values;
                for %tallies.pairs.grep: { .value == $losing_tally } -> $kv {
                        my $loser = $kv.key;
                        say "exclude $loser";
                        for @ballots -> @ballot is rw {
                                @ballot = @ballot.grep: { $_ ne $loser }

say "WINNER IS: $winner";

Again, no problems.

Two things were "slightly harder than they should be".

First, the "inverse lookup" of a hash key from its value seems a little
cumbersome. Sure, there's probably no getting round the need to iterate
over all the values: but wouldn't it be nice the perl took care of that
for me. In the first solution I did this iteration as a "for" loop;
in the latter I used ".first" and ".grep" methods

The other niggle is that the "dot-assign" concept doesn't seem to
exist yet. Theoretically I should have been able to write:

    @ballot.=grep: { $_ ne $loser }

to do the ballot modification for exclusion. Hopefully that'll be
implemented in the fullness of time.

03:37 PM


The final challenge was blackjack. The instructions said that we
could choose to implement that aces always equal 11, but that seems
insufficiently interesting: I wanted to use junctions!

To start with, a simple definition of a deck of cards. The challenge
required humanly named cards: so I started with a list of pairs, and
then crossed this list against the list of suites. Finally, "@cards =
@deck.pick( @deck.elems )" results in a random shuffle.

my @values = (
        ace => 1|11,
        two => 2,
        three => 3,
        four => 4,
        five => 5,
        six => 6,
        seven => 7,
        eight => 8,
        nine => 9,
        ten => 10,
        jack => 10,
        queen => 10,
        king => 10,

my @suites = < spades clubs diamonds hearts >;

my @deck = ( @values X @suites ).map: {
                my ($name, $value) = $^a.kv;
                "$name of $^b" => $value

my @cards = @deck.pick( @deck.elems );

So that's my deck of cards. I first deal the initial hands:

my @dealer;
my @player;

@dealer.push( @cards.shift );
@player.push( @cards.shift );
@dealer.push( @cards.shift );

say "DEALER:";
say @dealer[0].key; #only display the first card of dealer's hand
say "";

say "PLAYER:"; .key.say for @player;

Now we come to the main player loop. Card values are junctions, so I
don't need to worry about calculating all possible values of hands that
include aces. However, I do need to remember to not test for "bust"
using a "greater-than" test. Because of the logic of "any" junctions,
I need to check only for "less than 21" is not bust (and == 21 is WIN):

my $choice = "hit";

my $player_value = [+] { .value };

while ($choice ~~ /h/) {

        my $card = @cards.shift;

        @player.push( $card );
        say $card.key;

        $player_value += $card.value;

        say "current value is { $player_value.perl }";

        if $player_value == 21 {
                say "congradulations, you win!";
                $choice = "s";
        elsif $player_value < 21 {
                say "hit (h) or stay (s)";
                $choice = "stay" unless $player_value < 16;
                say $choice;

                #TODO: read STDIN
        else {
                say "Sorry, you bust!";
                $choice = "s";

Note that my version of Rakudo doesn't implement "last" properly yet,
so I arranged my code to not need it.

Now the dealer gets to play (but only if the game is still live). A
problem here was to figure out what "player value" to use. If a player
hand is (ace, ace, eight), then possible values are 10, 20, and 30. I
need to make sure that "20" is used for all tests against the dealers
value. I couldn't figure out an analytic way to achieve this, so I brute
forced it: "max (4 .. 21).grep: { $_ == $player_value }". (I start the
list at 4 because that's the lowest possible blackjack hand).

Checking for a dealer win has the same problem: I can't use "less-than"
or "greater-than" tests because of possible junctional values (e.g. "ace,
six, ten" is both not-bust, and greater than any possible play hand).

say "";

if $player_value < 21 && not $player_value == 21 {

        $player_value = max (4 .. 21).grep: { $_ == $player_value };

        say "DEALER:"; .key.say for @dealer;

        my $dealer_value = [+] { .value };
        my $done = 0;

        while ! $done {
                say "dealer value: {$dealer_value.perl}";

                if $dealer_value == any( $player_value ^.. 21) {
                        say "you loose!";
                        $done = 1;
                elsif $dealer_value < 21 {
                        my $card = @cards.shift;
                        @dealer.push( $card );
                        say $card.key;
                        $dealer_value += $card.value;
                else {
                        say "dealer bust: you win!";
                        $done = 1;


And so that's it. Junctions work, but I can't help feeling that we need
some more language features to help with the "collapsing" of a junction
to its appropriate value -- and that includes a "partial collapse" that,
for example, excludes all values greater than 21 after I've checked that
there'd be at least one value left over. Hmm, perhaps that could be done
with a subset type...

01:38 PM

plus a couple of one-liners

event 6 asks us to generate the prime numbers from 1 to 200:

% ./perl6 -e 'my @primes; for 2 .. 200 -> $n { @primes.push($n) unless $n % any(@primes)==0 }; .say for @primes'

and event 7 asks for a random scheduling of a round-robin tournament with 6 teams:

% ./perl6 -e 'my @teams = "A" .. "F"; my @games = (@teams X~X @teams).grep: { [le] $_.split("") } ; .say for @games.pick( @games.elems )'

This latter would be even easier if we had a "combinations" operator

01:07 PM

Phone Numbers to Words

I couldn't stop with just the "beginners" challenges. "Expert" event 1 asks use to take a phone number, and convert it to a valid word using standard mapping of digits to letters --

The actual challenge uses a file that contains the list of words: I decided to hard code the array:

my @words = <
>.map: { [ .split("") ] };

my @mappings = <
>.map: { [ .split("") ] };

sub word_matches( @word, @phone ) returns Bool {
        return False unless @word.elems == @phone.elems;
        for @word Z @phone -> $letter, $digit {
                return False unless $letter eq any( |@mappings[$digit] );
        return True;

sub find_word( $phone ) {
        my @phone = $phone.split("");
        for @words -> @word {
                if word_matches( @word, @phone ) {
                        say "number: { @phone }";
                        say "result: { @word }";

find_word "7323464"

which gives the result:

number: 7 3 2 3 4 6 4
result: R E A D I N G

What's interesting here?

This solution uses the zip operator, and junctions. It demonstrates nicely how these features simplify the code.

I originally attempted to write it without the subroutines, but ran into problems because "last" isn't implemented yet. So I formed a subroutine and used "return" for my early exit.

Oh yes, one other thing I hit: I originally wrote "any( @mappings[$digit] )"; That didn't work because, even in perl6, it's still necessary to dereference the inner array of an AofA -- in this case, using the "|" flattening operator.

I can't help but feel that there's a deeper elegance waiting to reveal itself in a reduction of the outer loop. The use of "for" in this context over constrains the implementation in that it is an explicit sequential iteration statement. It should be possible to form the result as a pure functional expression

Tuesday December 23, 2008
11:13 PM

The Bowling challenge

Having played with the "pairs" challenge, I looked through the other beginners events. Most dealt with files and databases: I didn't want to tackle that right now. So I skipped to challenge-10: interpret a bowling game that is input as an array.

For this one, my thought was to exploit "multi" subs: there're only so many patterns to each frame: I can just code them explicitly. Lets start with my solution:

my @scores = 2,5,7,"/",8,1,"X",9,"/",5,3,7,0,4,5,"X",2,0;

my $total = 0;

multi frame_score ( Str $a, Str $b, Str $c ;; *@next ) { 30 }
multi frame_score ( Str $a, Str $b, Int $c ;; *@next ) { 20 + $c }
multi frame_score ( Str $a, Int $b, Str $c ;; *@next ) { 20 }
multi frame_score ( Str $a, Int $b, Int $c ;; *@next ) { [+] 10, $b, $c }
multi frame_score ( Int $a, Str $b, Str $c ;; *@next ) { 20 }
multi frame_score ( Int $a, Str $b, Int $c ;; *@next ) { 10 + $c }
multi frame_score ( Int $a, Int $b ;; *@next ) { $a + $b };

while @scores {
        $total += frame_score |@scores;
        say "score now $total";

        @scores.shift unless @scores[0] eq "X";

So what went wrong? Actually, this one went pretty smoothly. I probably should use specific string values, instead of relying on just the fact that "/" and "X" are generic strings (and it doesn't matter which). That's something I need to investigate. The one thing that feels a bit clunky is that logic at the bottom that decides how many bowls were bowled in each frame (and therefore how many to shift off the array. I'd really like to be able to use a "for" loop to iterate the array.

The're two features missing that don't permit that: one is that it's not possible to do multi pointy-blocks. That would need a syntax something like:

for @x:
    Int $x -> { ... },
    Str $x -> { ... }

That specific syntax possibly wouldn't work, but you get the idea...

the other thing missing is the ability to pass non-consumed args to the pointy-block. Something like:

for @a -> $x, $y ;; $z { ... }

where "$x" would not be consumed: only two items would be consumed from the list. ";;" wouldn't be the right syntax for the separate though, because there's not necessary relation between the usage of args for selecting between multi-pointies, and the args that are to be consumed.

Overall, this challenge was felt good in perl6!

02:40 PM

My first experiment with Perl6

So Patrick suggested on that playing with Microsoft's "Winter Scripting Games" would be a good way to get started with Rakudo.

I liked that idea, so I went to the first challenge (for beginners) -- simply count the number of pairs in a list. For their test data (7,5,7,7,13), the correct answer is to be "3", because "7" is paired 3 different ways.

I immediately thought of the new cross-product operator:

my @x = < 7 5 7 7 13 >;
say for @x X~X @x;

Here I found my first p6 gotcha. In perl5, "say for @x" will print the values of @x, one per line. In P6, $_ is not implicit in a function call to the builtins: you need to use a method call:

.say for @x X~X @x;

For something to be a pair, the two values will be the same. So what I need to do is to count the number of combinations of elements for which the value is the same:

say ((@x X==X @x).grep:{ $^same }).elems;

This works, but the result is way too big. The X==X operator counts every pairing twice; plus every element is paired with itself. We need to adjust the result:

say ((( @x X==X @x ).grep: { $^same }).elems - @x.elems)/2;

This indeed prints the correct answer. And it nicely shows the power of P6. But it also suggests that more power is needed. The need to adjust the result to eliminate duplicates is bad. What is really needed is an operator that crosses every element of a list with each element that is to its right in the original list -- what I might call a diagonal cross.

I need to figure out how to define such a meta-operator in P6 -- and then figure out how to implement it in Rakudo! If my diagonal-cross was defined, say, using "%==%" then the implementation of the original challenge would become:

say ((@x %==% @x).grep: { $^same }).elems

That would be truly awesome and, to my mind, elegant!