This is my response to the Perl Weekly Challenge #105.
$N and $k.
Write a script to find out the $Nth root of $k. For
more information, please take a look at the
wiki page.
Input: $N = 5, $k = 248832
Output: 12
Input: $N = 5, $k = 34
Output: 2.02
#! /usr/bin/env raku
unit sub MAIN (:$N, :$k, :i($iterations) = 10, :v($verbose)); # [1]
my $start = 1; # [2]
$start++ while ($start + 1) ** $N < $k; # [3]
say ": Start: $start" if $verbose;
my $seq := gather # [4]
{
take $start; # [5]
my $index = 0; # [5a]
loop # [6]
{
take (1/$N)
* (($N - 1) * $seq[$index] + ($k / $seq[$index] ** ($N - 1)));
# [7]
$index++; # [7a]
}
}
say ": ", $seq[^$iterations].join(" | ") if $verbose;
say $seq[$iterations -1]; # [8]
[1] I have chosen to use Named arguments this time, as that makes it hard to mix up the order.
[2] The initial guess, starting at the lowest possible number.
[3] Then we add one as long as the resulting value (inital guess to the power
of $N) is lower than $k.
[4] Using gather/take to
set up the values as a sequence.
[5] Start with the initial guess, at index 0 (in the Sequence).
[6] An eternal loop, which is ok as we have a lazy data structure (because
of the := assignment in [4]).
[7] Each value is defined like this, depending on the previous value (in
$seq[$index]). We increase the index after computing
the value [7a].
[8] Print the value at the given position in the sequence. This will compute the values up to this one.
See my Raku Gather,
I Take article or
docs.raku.org/syntax/gather take for more information about
gather/take.
Running it:
$ ./nth-root -N=5 -k=248832
12
$ ./nth-root -N=5 -k=34
2.024397458499885
The second result is not what the challenge specified (i.e. «2.02»), so let us do the math manually (in e.g. REPL modem, so not really manually…):
$ raku
> say 2.024397458499885 ** 5 # -> 33.99999999999999
> say 2.02 ** 5 # -> 33.6323216032
So we got the correct answer (or at least something very close to it), and the challenge got it wrong.
We can run it with verbose mode:
$ ./nth-root -N=5 -k=248832 -v
: Start: 11
: 11 | 12.199112 | 12.006394530167233 | 12.00000680774632 |
12.000000000007724 | 12 | 12 | 12 | 12 | 12
12
$ ./nth-root -N=5 -k=34 -v
: Start: 2
: 2 | 2.025 | 2.02439781697 | 2.0243974585000117 | 2.024397458499885 |
2.024397458499885 | 2.024397458499885 | 2.024397458499885 |
2.024397458499885 | 2.024397458499885
2.024397458499885
As you can see from the list of values, both of them arrive at the final answer quite some time before stopping. So adding more iterations would not help us. But we can do so anyway, with the «-i» command line option:
$ ./nth-root -N=5 -k=248832 -i=20 -v
: Start: 11
: 11 | 12.199112 | 12.006394530167233 | 12.00000680774632 |
12.000000000007724 | 12 | 12 | 12 | 12 | 12 | 12 | 12 | 12 | 12 | 12 |
12 | 12 | 12 | 12 | 12
12
An optimisation could be to go on in the sequence, as long as the value changes, and stop when we get two identical values:
File: nth-root-better
#! /usr/bin/env raku
unit sub MAIN (:$N, :$k, :i($iterations) = 10, :b($best), :v($verbose));
# [1] ##
my $start = 1;
$start++ while ($start + 1) ** $N < $k;
say ": Start: $start" if $verbose;
my $seq := gather
{
take $start;
my $index = 0;
loop
{
take (1/$N)
* ( ($N - 1) * $seq[$index] + ($k / $seq[$index] ** ($N - 1) ));
$index++;
}
}
if $best # [2]
{
my $index = 0; # [3]
my $current = $seq[$index++];
$current = $seq[$index++] while $current != $seq[$index]; # [4]
say ": ", $seq[0..$index].join(" | ") if $verbose;
say $seq[$index]; # [5]
}
else # [6]
{
say ": ", $seq[^$iterations].join(" | ") if $verbose;
say $seq[$iterations -1];
}
[1] Use the «-b» command line option to get the best value, and no more iterations after that.
[2] If we have asked for the best value,
[3] Keep track of the index.
[4] Go on, as long as the next value differs from the current one.
[5] Print the last value we computed.
[6] The old behaviour.
Running it:
$ ./nth-root-better -N=5 -k=248832 -b -v
: Start: 11
: 11 | 12.199112 | 12.006394530167233 | 12.00000680774632 |
12.000000000007724 | 12 | 12
12
$ ./nth-root-better -N=5 -k=32 -b -v
: Start: 1
: 1 | 7.2 | 5.7623815 | 4.615709792667913 | 3.706668057515866 |
2.9992379973399035 | 2.478483071376254 | 2.152390478860902 |
2.020104202537039 | 2.0003961939397454 | 2.0000001569074692 |
2.0000000000000244 | 2 | 2
2
$ ./nth-root-better -N=5 -k=34 -b -v
: Start: 2
: 2 | 2.025 | 2.02439781697 | 2.0243974585000117 | 2.024397458499885 |
2.024397458499885
2.024397458499885
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'signatures';
use feature 'say';
use Getopt::Long;
no warnings qw(experimental::signatures);
my $N = 0;
my $k = 0;
my $iterations = 10;
my $best = 0;
my $verbose = 0;
GetOptions("N=i" => \$N,
"k=i" => \$k,
"i=i" => \$iterations,
"b" => \$best,
"v" => \$verbose);
my $start = 1;
$start++ while ($start + 1) ** $N < $k;
say ": Start: $start" if $verbose;
my @seq; $seq[0] = $start;
sub get_iteration ($index) # [1]
{
unless (defined $seq[$index])
{
$seq[$index] = (1/$N) *
(
($N - 1) * get_iteration($index -1)
+ ($k / get_iteration($index -1) ** ($N - 1) )
);
}
return $seq[$index]
}
if ($best)
{
my $index = 0;
my $current = get_iteration($index++);
$current = get_iteration($index++)
while $current != get_iteration($index); # [1a]
say ": ", join(" | ", @seq) if $verbose; # [2]
say $seq[$index];
}
else
{
my $value = get_iteration($iterations -1); # [1b]
say ": ", join(" | ", @seq) if $verbose; # [2]
say $value;
}
[1] We use «get_iteration» to get (and possibly calculate) the value with the specified index. It stores the value in the array, so that we only calculate any single value once.
[2] We array has the calculated values only (obviously), so we can print them all.
Running it gives the same result as the Raku version:
$ ./nth-root-perl -N=5 -k=248832 -v
: Start: 11
: 11 | 12.199112082508 | 12.0063945301672 | 12.0000068077463 |
12.0000000000077 | 12 | 12 | 12 | 12 | 12
12
$ ./nth-root-perl -N=5 -k=248832 -v -b
: Start: 11
: 11 | 12.199112082508 | 12.0063945301672 | 12.0000068077463 |
12.0000000000077 | 12 | 12
12
$name.
Write a script to display the lyrics to the Shirley Ellis song The Name Game.
Please checkout the wiki page for more information.
Input: $name = "Katie"
Output:
Katie, Katie, bo-batie,
Bonana-fanna fo-fatie
Fee fi mo-matie
Katie!
The letter «y» is either a consonant or a vowel in English, depending on who you ask. See e.g. www.merriam-webster.com/words-at-play/why-y-is-sometimes-a-vowel-usage. The Raku and Perl programs below regard it as a consonant, unless explicitly told otherwise.
This is pretty straight forward, given the explanation in the Wikipedia article.
File: name-game
#! /usr/bin/env raku
unit sub MAIN ($x, :y(:$y-is-a-vowel)); # [1]
my @vowels = $y-is-a-vowel ?? <a e i o u y> !! <a e i o u>; # [2]
my $y = $x.substr(0,1).lc eq any(@vowels) ?? $x.lc !! $x.substr(1); # [3]
say # [4]
"$x, $x, bo-{ $x.substr(0,1).lc eq "b" ?? $y !! "b$y" } # [5]
Bonana-fanna fo-{ $x.substr(0,1).lc eq "f" ?? $y !! "f$y" } # [6]
Fee fi mo-{ $x.substr(0,1).lc eq "m" ?? $y !! "m$y" } # [7]
$x!"; # [8]
[1] Specify the name to use, and optionally «-y» if you want the program to treat «y» as a vowel.
[2] The vowels, depending on the «-y» command line option.
[3] The (Y) value. If the first letter in the name (the (X)
value) is a consonant, we remove it. Note the lc to turn the name into
lower case when we did not remove the inital character (which usually is an upper case
letter).
[4] A multi line string.
[5] Note the use of embedded code inside {…} in strings. If the original
name (the (X) value) starts with «b» (or «B», as lc coerces
it lo lower case), we drop the leading «b».
[6] As [5], but checking for «f».
[7] As [5] and [6], but checking for «m».
[8] The last line. Note the final quote to mark the end of the string.
Note that the comments marked with red must be removed from the code, if you want to run it, as they reside inside a (multi line) text string. (And will end up in the ourtput.)
Running it:
$ ./name-game Katie
Katie, Katie, bo-batie
Bonana-fanna fo-fatie
Fee fi mo-matie
Katie!
$ ./name-game Billy
Billy, Billy, bo-illy
Bonana-fanna fo-filly
Fee fi mo-milly
Billy!
$ ./name-game Fred
Fred, Fred, bo-bred
Bonana-fanna fo-red
Fee fi mo-mred
Fred!
$ ./name-game Marsha
Marsha, Marsha, bo-barsha
Bonana-fanna fo-farsha
Fee fi mo-arsha
Marsha!
Let us try a name starting with «Y», which either is a consonant (first run) or a vowel (second run, with «-y»):
$ ./name-game Yasmine
Yasmine, Yasmine, bo-basmine
Bonana-fanna fo-fasmine
Fee fi mo-masmine
Yasmine!
$ ./name-game -y Yasmine
Yasmine, Yasmine, bo-byasmine
Bonana-fanna fo-fyasmine
Fee fi mo-myasmine
Yasmine!
Looking good.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use Perl6::Junction 'any';
my $y_is_a_vowel = 0;
GetOptions("y_is_a_vowel" => \$y_is_a_vowel);
my $x = shift(@ARGV) // die 'Please specify the name';
my @vowels = $y_is_a_vowel ? qw/a e i o u y/ : qw/a e i o u/;
my $y = lc(substr($x,0,1)) eq any(@vowels) ? lc($x) : substr($x, 1);
say "$x, $x, bo-", ( lc(substr($x,0,1)) eq "b" ? $y : "b$y" ); # [1]
say "Bonana-fanna fo-", ( lc(substr($x,0,1)) eq "f" ? $y : "f$y" );
say "Fee fi mo-", ( lc(substr($x,0,1)) eq "m" ? $y : "m$y" );
say "$x!";
[1] perl does not support code inside strings, so we do it with 4
says, and a list of two arguments (note the comma) for the first
three.
Running it gives the same result as the Raku version:
$ ./name-game-perl Yasmine
Yasmine, Yasmine, bo-basmine
Bonana-fanna fo-fasmine
Fee fi mo-masmine
Yasmine!
$ ./name-game-perl -y_is_a_vowel Yasmine
Yasmine, Yasmine, bo-byasmine
Bonana-fanna fo-fyasmine
Fee fi mo-myasmine
Yasmine!
And that's it.