laurent_r

These are some answers to the Week 4 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

This post will be relatively short, because I don't have too much time this week.

Challenge #1: Pi Digits

Write a script to output the same number of PI digits as the size of your script. Say, if your script size is 10, it should print 3.141592653.

A Perl 5 Solution

Here, I decided to make it really short. This a Perl 5 one-liner:

perl -E '
say 4*atan2 1,1
'
3.14159265358979

I consider that the script is what is between the single quotes, so that's 15 characters (not counting the newlines, because they are only there to show that the code has the same number of characters as the number of digits of the output).

Some might argue that this is cheating a bit but, hey, that satisfies the request. I'll give a more extensive script in the Perl 6 section, and I think it could easily be adapted to P5, using for example the https://metacpan.org/pod/bigrat module.

A Perl 6 Solution

Of course, we can do more or less the same in Perl 6, with just some variations for fun:

perl6 -e '
print pi, "\n";
'
3.14159265358979

But let's try to be more serious and adapt the size of our output to the size of the script, which means to actually calculate some digits of pi.

I've tried several formulae known for centuries (François Viète, John Wallis, Isaac Newton, Gottfried Wilhhem Leibniz, etc.), but will show only one of them to illustrate the problem.

John Wallis's infinite product can be reformated as:

pi / 2 = (2 * 2 * 4 * 4 * 6 * 6 * 8 * 8 ... ) / (1 * 3 * 3 * 5 * 5 * 7 * 7 * 9 ... )

We can build two lazy infinite lists, one for the numerator and one for the denominator and use the reduction operator to calculate Wallis's infinite product:

my @numerators =  2, 2, -> $a, $b {| ($a + 2, $b + 2) } ... *;
my @denominators = 1, 3, 3, -> $a, $b {| ($a + 2, $b + 2) } ... *;
my $pi = 2 * ([*] @numerators[0..2000]) / ([*] @denominators[0..2000]);

The value obtained for $pi is:

3.14237736509388

Only the first three digits are correct with a product of two thousands terms! Quite obviously, those century-old formulas converge much too slowly for our purpose. We need something more efficient.

The Indian mathematician Srinivasa Ramanujan is known as the author of a number of innovative new formulae for calculating digits of pi during the first decades of the twentieth century, but the one I looked at is not so easy to implement, notably because it involves the square root of two, so we would need to start by calculating the digits of that number.

In 2006, Franco-Canadian mathematician Simon Plouffe used the so-called PSLQ integer relation algorithm to generate several new formulae for pi. One of them was described back in 1995 and is known as one of the spigot algorithms.

We can write the following plouffe subroutine:

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

to calculate the individual terms of the infinite sum and then compute pi as follows:

my $pi = [\+]  (plouffe $_ for 0..20);

That does not work properly, however, as the plouffe terms get converted from rationals to floats (well, really from Rat to Num) when the input value reaches 11 or more.

> say (plouffe $_).WHAT for 0..15;
(Rat)
(Rat)
(Rat)
(Rat)
(Rat)
(Rat)
(Rat)
(Rat)
(Rat)
(Rat)
(Rat)
(Num)
(Num)
(Num)
(Num)
(Num)

so that we are losing accuracy and the result:

3.141592653589793129614170564041344859

is correct only up to the 16th digit.

So, let's try to use the FatRat type:

sub plouffe (Int $k) {
    my $result = 1.FatRat *  (1 / 16 ** $k) * (  (4 / (8 * $k + 1)) - (2 / (8 * $k + 4)) - (1 / (8 * $k + 5)) - (1 / (8 * $k + 6) )  );
}

It is a bit better, but we are again falling back to Num when the subroutine input value reaches 17 or above:

> say (plouffe $_).WHAT for 0..20;
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(FatRat)
(Num)
(Num)
(Num)
(Num)
(Num)

For some reason, coercing the input value to a FatRat:

sub plouffe (FatRat $k) {
    my $result =  (1 / 16 ** $k) * (  (4 / (8 * $k + 1)) - (2 / (8 * $k + 4)) - (1 / (8 * $k + 5)) - (1 / (8 * $k + 6) )  );
}
say (plouffe $_.FatRat).WHAT for 0..20;

doesn't work either.

While still trying to understand why we are falling from FatRat to Num, I posted a question on perl6-users, and I quickly received very useful tips from Fernando Santagata and Brian Duggan. Many thanks to them.

The following syntax suggested by Brian works properly:

sub plouffe (Int $k) {
    my $result = (1.FatRat / 16 ** $k) * (  (4 / (8 * $k + 1)) - (2 / (8 * $k + 4)) - (1 / (8 * $k + 5)) - (1 / (8 * $k + 6) )  );
}
# printing 200 digits of pi
my $pi = [+] (plouffe $_ for  0..200);

Now, $pi is populated with about 750 digits, two thirds of which are wrong, but the important point is that they are all correct up to the 249th digit. In general, we get an average of about 1.2 correct digits per term in the sum. So, with the above input values, we're on the safe side of things if we print out the first two hundred digits:

> say substr $pi, 0, 201;
3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819

It is now fairly easy to output the same number of PI digits as the size of the script:

sub plouffe (Int $k) {
    my $result = (1.FatRat / 16 ** $k) * (  (4 / (8 * $k + 1)) - (2 / (8 * $k + 4)) - (1 / (8 * $k + 5)) - (1 / (8 * $k + 6) )  );
}
my $script-size = $*PROGRAM-NAME.IO.s;
my $pi = [+] (plouffe $_ for  0..$script-size);
say substr $pi, 0, $script-size + 1;

The script has 290 bytes and the script prints the first 290 digits of pi:

$ perl6 pi.p6
3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072

The script runs in slightly less than 1.5 sec.

Challenge #2: Letters and Word List

You are given a file containing a list of words (case insensitive 1 word per line) and a list of letters. Print each word from the file than can be made using only letters from the list. You can use each letter only once (though there can be duplicates and you can use each of them once), you don’t have to use all the letters.

A Perl 5 One-Liner

I was running out of time and also a bit too lazy to include the list of letters in the input file. Therefore, the list of letters is hard-coded in the one-liner below. Otherwise, I have in the current directory a words.txt file containing 113,809 lower-case words usually accepted for word games, crossword puzzles, and so on. The words.txt file can be found here.

The basic idea is to sort the letter list and build a string with that, and then to sort the letters of each word, and finally to check whether the string containing the sorted letters of the word can be found in the string of the sorted input letters.

This is the one-liner:

perl -E 'my $letters = join "", sort qw/a e i t r s o u a /; while (<>) { chomp; my $norm = join "", sort split //, $_; say $_ if index($letters, $norm) >=0;}' words.txt
aa
ae
ariose
or
ors
orts
osier
outraise
riots
rots
roust
routs
rust
ruts
sautoire
sori
sort
sortie
stour
stourie
suitor
tiros
tories
tors
torsi
torus
tours
trios
triose
trois
ut
uts

This is the same script reformatted to make it slightly clearer:

perl -E 'my $letters = join "", sort qw/a e i t r s o u a /; 
    while (<>) { 
        chomp; 
        my $norm = join "", sort split //, $_;
        say $_ if index($letters, $norm) >=0;
    } ' words.txt

A Perl 6 Solution

We can use a one-liner similar to the P5 solution:

perl6 -e 'my $letters = join "", sort qw/a e i t r s o u a /; for "words.txt".IO.lines -> $line { my $norm = $line.comb.sort.join(""); say $line if defined index($letters, $norm);}'

The output is the same as for the P5 one-liner.

The following script fully complies with the requirement. I have created a new words2.txt file where the first line is a list of letters: aeiortgsdf (and the rest of the file the same list of words). The script looks like this:

my @lines = 'words2.txt'.IO.lines;
my $first-line = shift @lines;
my $letters = $first-line.comb.sort.join("");
for @lines -> $line { 
    my $norm = $line.comb.sort.join(""); 
    say $line if defined index($letters, $norm);
}

And this is the output:

$ perl6 words.p6
ad
da
de
deaf
ef
fade
fadge
fed
fidge
fig
firedog
firedogs
fogie
giro
giros
or
ors
orts
riots
rots
sori
sort
tiros
tors
torsi
trigos
trios
trois

Wrapping up

The next week Perl Weekly Challenge is due to start very soon. If you're interested in participating in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 6 p.m. BST (British summer time) on next Sunday, April, 28. And, please, also spread the word about the Perl Weekly Challenge if you can.