So this weeks Perl Challenge is coming down to the wire. This is mostly because it's the Easter Holidays and I've been visiting family. Still as I did propose one of the two challenges I probably should do them.

Pi to n digits

The first challenge was to calculate Pi to N digits. I had a plan to go to Wikipedia an look into how to calculate the digits of Pi. Then Laurent Rosenfeld posted about the Bailey–Borwein–Plouffe formula in the Perl6 user mailing list.

So that made life a bit easier. One thing I did want was to ensure I use FatRat's and I thought this would be a good time to create a constuctor for them giving us this:

use v6;

sub infix:<///> ( Int() $nu, Int() $de ) { FatRat.new( $nu, $de ) }

sub bbp-digit ( Int $k ) {
    my $k8 = $k*8;
    (1 /// (16 ** $k)) * ((4 /// ($k8 + 1)) - (2 /// ($k8 + 4)) - (1 /// ($k8 + 5)) - (1 /// ($k8+6)));
}

sub calc-pi( Int $num ) {
    my $p = [+] ( 0..$num ).map( &bbp-digit );
    return $p.Str.substr(0,$num+1);
}

#| Calculate PI to a given number of digits
sub MAIN (
    Int $digits #= Number of digits to calcuate
) {
    say calc-pi( $digits );
}

Word puzzle solver

So this was my idea for a challenge and it comes from my spending too much time playing random word games on my phone while on the train to work. Some of these games entail making words from a limited set of letters and when I get stumped I tend to dive into the /usr/share/dict folder and start grepping. I'd kept meaning to writing a Perl6 script to do it for me and suggested it to Mohammad.

As I'm writing this I've got 25 minutes to hand in my homework so I'll post this quickly and them maybe come back to it and explain it more later :

use v6;

subset FilePath of Str where *.IO.f;

#| Given a dictionary of words to check and a list of available letters
#| Print the words that can be made using just those letters
sub MAIN (
    FilePath $dict, #= Dictionary file to read
    *@letters #= List of letters allowed to be used
) {
    my $check-set = bag( @letters.map( *.lc ) );

    $dict.IO.words.race.grep( { bag( $_.lc.comb ) (<=) $check-set } )>>.say;
}

Using Bags and set operators plus the race command and it will check the 102,000 lines American English dictionary for a list of 6 letters in 3 seconds. That'll do.

So I didn't blog last weeks challenge because it was a very busy week for me but this week I've got a bit of time so here's my solutions to this weeks challenges, in Perl6 for now.

Regular Numbers

I'm not a great mathematician, I've kind of got an instinct for a lot of it but formal math learning and me... have always been uneasy partners so I'd not heard of Regular Numbers before.

One nice thing about that article is it gives a nice algorithm which changes the problem to be "implement this algorithm" and that's something I can do. :)

So this break down to the following :

1. Make a list with 1 element 1
2. Take the first element from the list call it h.
3. Add 2h, 3h, 5h to the list (There's a catch here).
4. Return h
5. When you want the next element return to 2

Ok that's nice and looking at it a thought came to mind, this seems a great time to use gather and take to make a sequence of Regular Numbers.

Here's iteration one :

my @h = gather {
    my @items = [1];
    loop {
        my $h = @items.shift;
        @items.push( 2*$h, 3*$h, 5*$h );
        take $h;
    }
}
say @h[0..10];

This.... did not work. It's got a few bugs. Firstly the VM doesn't tag it as a lazy Sequence so it runs the loop forever (Perl6 has for loops for iteration, while loops for testing a truth value and loop which can be used as an infinite loop or as a C style loop).

Fixing the first issue is easy add a lazy in front of the gather and we get some results. But they are a bit all over the place.

(1 2 3 5 4 6 10 6 9 15 10)

Ooooh. Of course when we take 2 from the list we append [4,6,10] to [3,5] and then when we take 3 we append [6,9,15] so on. Now at this point I thought of using a SetHash to ensure I had unique values. But then I'd have to worry about sorting the keys each time. Easier instead to just sort the list and remove unique values. On top of that this seems a good time to add a MAIN wrapper to find out how many numbers are required.

sub MAIN(Int() $count) {
    my @h = lazy gather {
        my @items = (1);
        loop {
            my $h = @items.shift;
            take $h;
            @items.push(2*$h,3*$h,5*h);
            @items = @items.unique.sort( { $^a <=> $^b } );
        }
    };
    say @h[0..$count-1]
}

That's nice and seems to do the trick. Which means it's time for the next challenge.

Pascal's Triangle

So Pascal's Triangle is pretty and I decided I wanted to get it nicely laid out like so:

                   1
                 1   1
               1   2   1
             1   3   3   1
           1   4   6   4   1
         1   5   10  10  5   1
       1   6   15  20  15  6   1
     1   7   21  35  35  21  7   1
   1   8   28  56  70  56  28  8   1
 1   9   36  84 126 126  84  36  9   1

So this challenge has two parts. Generating the numbers for the triangle and then laying it out. In this case I didn't read the article too much but had a neat idea. For a given row (eg [1,2,1] you can generate the next row by implementing doing the following):

# Here's our row
my @row = [1,2,1];
# Make a copy with a 0 at the start
my @row1 = [0, |@row]; # [0,1,2,1] (| breaks the array down so it doesn't get added as a single object in this case)
# Make a copy with a 0 at the end
my @row2 = [|@row, 0]; # [1,2,1,0]

# For each item in row1 add it to the same item in row2
my @row3 = [ 
    @row1[0] + @row2[0], # 0 + 1 = 1
    @row1[1] + @row2[1], # 1 + 2 = 3
    @row1[2] + @row2[2], # 2 + 1 = 3
    @row1[3] + @row2[3], # 1 + 0 = 1
];

So... that's a thing but it's a bit unwieldy if only there was some kind of way to simplify this. Oh yes, the Zip metaoperator Z. Place a Z between two lists and it will default to applying the , operator to each item in turn to make a new list of lists :

(0, 1, 2, 1) Z (1, 2, 1, 0) => ((0,1), (1,2), (2,1), (1,0))

But you can give Z and inline operator to apply list for instance + giving you :

    (0,1,2,1) Z+ (1,2,1,0) => (1, 3, 3, 1)

Which looks very nice. So if we just wanted our script to out lists of lists that make up Pascal's Triangle we could to this :

# Note the challenge says we need at least 3 lines so we catch that here.
multi sub MAIN( Int() $lines is copy where * > 2 ) {
    # Set up the initial state.
    # Decrement lines.
    my @row = (1);
    my @out = [ [1], ]; # Note we need a trailing comma or the array will be flattened
    $lines--;

    # Did I mention this earlier? Repeat / While is like the Perl5 do / while pair
    repeat { 
        @row = (0, |(@row)) Z+ (|(@row), 0); # Here's the Zip magic
        @out.push( @row.clone ); # We need to clone our row or will get clobbered in the next loop
        $lines--;
    } while ( $lines );

    @out.say;
}

And that works but... well I wanted it pretty. The simple thought would be to join each row with spaces and then join the lot with newlines but just doing that you end up with :

1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
1 5 10 10 5 1
1 6 15 20 15 6 1
1 7 21 35 35 21 7 1
1 8 28 56 70 56 28 8 1
1 9 36 84 126 126 84 36 9 1

Which is.... a bit meh.

Of course you could make those lines up then find the length of the last line and left pad all the other by half that amount.

@out = @out.map( { $_.join(" ") } );

my $len = @out[*-1].codes;

@out.map( { ( " " x ( ($len - $_.codes) div 2) ) ~ "$_" } ).join("\n").say;

And that's a bit nicer :

             1
            1 1
           1 2 1
          1 3 3 1
         1 4 6 4 1
       1 5 10 10 5 1
     1 6 15 20 15 6 1
   1 7 21 35 35 21 7 1
  1 8 28 56 70 56 28 8 1
1 9 36 84 126 126 84 36 9 1

But it falls apart when larger numbers get added. So we need to pad our output based on the length of the biggers number. Here's what I came up with :

sub pad( Str $val, Int $len ) {
    my $diff = $len - $val.codes;
    my $rpad = " " x ( ( $diff div 2 ) + 1 );
    my $lpad = " " x ( ( $diff div 2 ) + ( $diff % 2 ) );
    return "{$lpad}{$val}{$rpad}";
}

Pass in the number to pad and the length of the largest number and it returns the number all laiud out nicely. With that here's my final code :

sub pad( Str $val, Int $len ) {
    my $diff = $len - $val.codes;
    my $rpad = " " x ( ( $diff div 2 ) + 1 );
    my $lpad = " " x ( ( $diff div 2 ) + ( $diff % 2 ) );
    return "{$lpad}{$val}{$rpad}";
}

multi sub MAIN( Int() $lines is copy where * > 2 ) {
    my @row = (1);
    my @out = [ [1], ];
    $lines--;
    my $max = 1;

    repeat {
        @row = (0, |(@row)) Z+ (|(@row), 0);
        @out.push( @row.clone );
        $max = @row.max;
        $lines--;
    } while ( $lines );

    my $len = $max.codes;

    @out = @out.map( -> @list { @list.map( { pad($_.Str,$len) } ).join("") } );

    $len = @out[*-1].codes;

    @out.map( { ( " " x ( ($len - $_.codes) div 2) ) ~ "$_" } ).join("\n").say;
}

multi sub MAIN($) {
    note "Please input a number of lines that must be at least 3";
}

And that seems to do the trick which is fun. (This is the code used to make the triangle at the top).