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 :
- Make a list with 1 element 1
- Take the first element from the list call it h.
- Add 2h, 3h, 5h to the list (There's a catch here).
- Return h
- 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).
So I've had some thoughts on the Perl Weekly challenge. First up I thought I'd do them in Perl5 as well.
Updating E
The code for this looks very similar to my Perl6 solution (because they aren't that different)
use v5.10;
use strict;
my $s = "Perl Weekly Challenge";
my $c = 0;
$c++ while $s =~ s!e!E!;
say "Updated $s";
say "Number of matches : $c";
All I had to do was tell it to use 5.10 (so I could use say
why this is not on by default now I don't know) and change $s ~~ s!e!E!
to $s ~= s!e!E!
so that was easy enough :)
Fizz Buzz
For FizzBuzz I'll take my Perl6 version and modify it to be Perl5 like. This took a little more work
use v5.10;
use strict;
sub fz { $_[0] % 3 == 0 ? "Fizz" : "" }
sub bz { $_[0] % 5 == 0 ? "Buzz" : "" }
sub fb { my $i = shift; (fz( $i ) . bz( $i ) ) || $i }
say join( "\n", map { fb($_) } (1..20) )
Once again I'm using 5.10 because I like say. Not making operators just simple functions and there's no divisible by operator %%
so I have to fall back to %% 3 == 0
but the core idea is the same.
Further FizzBuzzery
While I was thinking about this I realised that fz
and bz
are basically the same thing. And as has been said to me before repition of code is bad. Now in Perl5 you can make a closure and that's neat but Perl6 gives you some more options.
Lets start with a generic check function (I'm going to drop operators for this next bit and instead play with functional programming).
sub check( Int $n, Str $text, Int $val ) { $val %% $n ?? $text !! "" }
So the fizz function for variable $i
is :
check( 3, "Fizz", $i )
Which is lovely but the 3, "Fizz"
bit looks a bit magic. It'd be nice to encapsulate that in a closure luckily Perl6 gives us
a helpful method on Code blocks to do that. Say hello to assuming
.
my &fz = &check.assuming( 3, "Fizz" );
my &bz = &check.assuming( 5, "Buzz" );
Here we define fz
as being check
assuming you call it with 3
and "Fizz"
for the first two arguments. (And bz
as 5
and "Buzz"
).
Of course you can also use named arguments in assuming
lets create a checker
function that can work with one or more subs that
take 1 input and return a String (that might be blank).
sub checker( Int $i, :@refs ) {
([~] @refs.map( { $_($i) } ) ) || $i.Str;
}
So we take a list of references and then map over the list with our given number, use the reduction metaoperator to concatenate the
results. Using this we can make out fizz-buzz
function :
my &fizz-buzz = &checker.assuming( refs => [&fz, &bz] );
Of course since fz
and bz
are only used here we don't really need to define them before :
my &fizz-buzz = &checker.assuming( refs => [
&check.assuming( 3, "Fizz" ),
&check.assuming( 5, "Buzz" )
] );
And then we can call our function as before :
sub check( Int $n, Str $text, Int $val ) { $val %% $n ?? $text !! "" }
sub checker( Int $i, :@refs ) {
([~] @refs.map( { $_($i) } ) ) || $i.Str;
}
my &fizz-buzz = &checker.assuming( refs => [ &check.assuming( 3, "Fizz" ), &check.assuming( 5, "Buzz" ) ] );
(1..20).map( -> $i { fizz-buzz($i) } ).join("\n").say;
Of course that's a lot of work. But what if later we wanted to play FizzBuzzPingPong where you say "Ping" if it's a prime number and Pong if it's divisible by 2. Well then you can easily make the fizz-buzz-ping-pong
function :
my &fizz-buzz-ping-pong = &checker.assuming( refs => [
&check.assuming( 3, "Fizz" ),
&check.assuming( 5, "Buzz" ),
{ $_.is-prime ?? "Ping" !! "" },
&check.assuming( 2, "Pong" )
] );
Note that for Ping we need to create a new block but that drops into the array easily enough.
Running this :
(1..30).map( -> $i { fizz-buzz-ping-pong($i) } ).join("\n").say;
Gives us :
1
PingPong
FizzPing
Pong
BuzzPing
FizzPong
Ping
Pong
Fizz
BuzzPong
Ping
FizzPong
Ping
Pong
FizzBuzz
Pong
Ping
FizzPong
Ping
BuzzPong
Fizz
Pong
Ping
FizzPong
Buzz
Pong
Fizz
Pong
Ping
FizzBuzzPong
And... I think that'll do for this challenge.
Addendum
It was pointed out to me that the FizzBuzz challenge was supposed to be one line... Oops.
Here you go.
perl6 -e '(1..20).map( { ( [~] ( $_ %% 3 ?? "Fizz" !! "", $_ %% 5 ?? "Buzz" !! "" ) ) || $_.Str } ).join("\n").say'
Back to brute force. With a bite of meta reduction for the fun of it. I still like the functional stuff though.
Recently the wonderfully talented Mohammad S Anwar started a new project the Perl Weekly Challenge. As a lover of all (or at least many) things Perl and something of a Perl6 fanatic
I figured I would sign up and try to challenge each week using Perl6.
If you've entered the challenge and don't want your result spolied do not read further.
For week one we've got two challenges :
- Write a script to replace the character ‘e’ with ‘E’ in the string ‘Perl Weekly Challenge’. Also print the number of times the character ‘e’ found in the string.
- Write one-liner to solve FizzBuzz problem and print number 1-20. However, any number divisible by 3 should be replaced by the word fizz and any divisible by 5 by the word buzz. Numbers divisible by both become fizz buzz.
E challenge
So the obvious thought on this one is to use regular expressions and I initially whipped up a simple one liner :
perl6 -e 'my $s = "Perl Weekly Challenge";"Number of e {($s ~~ m:g/e/).elems.say}";$s ~~ s:g/e/E/;"Updated {$s.say}"'
Here I make use of the fact that if you do a global match you get a list of all the matches and .elems
gives you the count. Then I just do a global replace.
Of course I'm having to match twice against the string. Hmmm. After a little thought I realised there's a different way of doing it that's a little neater. This time I'll write it out in a bit more detail.
my $s = "Perl Weekly Challenge";
my $c = 0;
$c++ while $s ~~ s!e!E!;
say "Updated $s";
say "Number of matches : $c";
So here we make use of the fact that without the :g
adverb a replace only does one match at a time. Then we simply increment a counter for each time. Note in this case I fall back to one of my standard quoting options !
which I find works quite well when doing web development
where /
has a tendency to pop up all over the place.
If I can think of a wackier way to do this in Perl6 I will but a simple replace with counter seems the way I'd generally do it.
FizzBuzz
Ah FizzBuzz, if you ever get asked this in an interview try not to answer with "Really?". For those of you who don't know the main thing to remember about FizzBuzz is in the name. Some numbers are divisible by both 3 and 5 and in this case you need to output FizzBuzz.
The leading way to fail this test is not take that into account. Again my first attempt to resolve the challenge relied on my patented skills of brute force and ignorance. I sent it in to Mohammad as a one liner but here it is tided up a bit.
sub prefix:<fb> (Int $i) {
$i %% 15 ?? "FizzBuzz"
!! $i %% 5 ?? "Buzz"
!! $i %% 3 ?? "Fizz"
!! $i
}
(1..20).map( fb * ).join("\n").say
The indentation here is to mainly show how seriously brute force this method is. Firstly I test for the 3 and 5 case (using the %%
divisibility operator) then if that fails try 5, then 3 and finally return the number if there's no other matches. Note that I put this into
a fb
operator that you can use as a prefix to any Integer EG fb 10
(which would return 10). Currently the operator returns a String or an Integer, it would probably be best to make it always return a String.
Anyway once I've got the operator applying it to each number in 1 to 20 is easy enough. Map the operator (using a Whatever Star code block) against each value and then join the results with a newline and output them.
Still the fb
operator is a bit... clunky. Can I streamline things?
sub prefix:<fz> (Int $i) { $i %% 3 ?? "Fizz" !! "" }
sub prefix:<bz> (Int $i) { $i %% 5 ?? "Buzz" !! "" }
sub prefix:<fb> (Int $i) { (fz $i ~ bz $i) || $i.Str }
(1..20).map( fb * ).join("\n").say
Continuing with the operator theme (which fankly I probably shouldn't adding cutom operators to your code tends to slow down parse time.... but I like them) I add two new ones fz
and bz
these return either Fizz, Buzz or a blank string as required.
By concatenating the results of fz $i
and bz $i
I either have a string (Fizz, Buzz or sometimes FizzBuzz) or a blank string. I can then make use of the short circuit ability of the ||
or operator.
If the left hand side evaluates to true (which the blank string won't) then the ||
will be that side. Otherwise it's $i.Str
(now fb
always returns a String). Note that I don't need to use return
as the last thing evaluated in a block is it's value.
I've got some thoughts on further updates but I quite like this one.
So, I've been writing Perl for a living now for over 15 years. Which is kinda funny in some ways. There's been asides where I've been doing Javascript, PHP, Java and even some C at times.
But Perl is still the language my brain likes to revert to. There's a few others that have tempted me over the years, mostly in the functional areas, but my mind tends to just gel with Perl.
Shame really that my work is really, really into Java. Partly because it's quite easy to get java developers. (I have some thoughts about that but I don't like to be rude so I'll hold of on them).
But there's also a love of the ecosystem and reporting tools that you can get with the Java Virtual Machine. Which is cool, I understand that, we're not a tech ocmpany as such, we're basically printers.
We print your stuff, if you have a photo we'll print it on something and we make some really nice stuff. I'm always impressed with it.
But the fact that we do make bespoke stuff means we also have bespoke software and it's been mostly written in Perl. And now the company would like to replace it.
But I have a plan up my sleeve, because whilst I've written Java I'd rather not. Being punched in the genitals sounds more fun than developing in Java full time. It's just so verbose and overly complex. Bleh.
Anyway during the times I've been coding in Perl there have been work going on with Perl 6 which for a long time was something of a joke and had a serious impact on the development of
Perl 5. Well Perl 6 is finally ready for production and is having new versions coming out every few months, and it runs on the JVM... sort of.
Right now the JVM version doesn't work with al the modules though and especially doesn't work with Panda the module installer. So I'm going to try and work out why and
if I can help. Because if I can carry on writing Perl I'll be a happy bunny. More here soon.
Meanwhile here's a fun little bit of Perl 6 from the website how to define a Factorial Operator :
sub postfix: (Int $n) {
fail "Not a Natural Number in Factorial" if $n < 0;
[*] 2..$n
}
!>