This is my response to the Perl Weekly Challenge #154.
'PERL'
.
PELR, PREL, PERL, PRLE, PLER, PLRE, EPRL, EPLR, ERPL,
ERLP, ELPR, ELRP, RPEL, RPLE, REPL, RELP, RLPE, RLEP,
LPER, LPRE, LEPR, LRPE, LREP
Write a script to find any permutations missing from the list.
Let us write a program using the supplied string and permutations as default values, with support for user supplied alternatives.
File: missing-permutations
#! /usr/bin/env raku
unit sub MAIN (
:s(:$string) = 'PERL', # [1]
:p(:$permutations) = "PELR PREL PERL PRLE PLER PLRE EPRL EPLR ERPL # [2]
ERLP ELPR ELRP RPEL RPLE REPL RELP RLPE RLEP
LPER LPRE LEPR LRPE LREP",
:v(:$verbose)
);
my %permuations = $permutations.words.Set; # [2a]
my @missing; # [3]
for $string.comb.permutations>>.join -> $candidate # [4]
{
say ": Checking candidate: $candidate" if $verbose;
@missing.push: $candidate unless %permuations{$candidate}; # [4a]
}
say @missing.uniquejoin(", ") if @missing; # [5]
[1] The default string.
[2] The default list of permutations, as a single string. We turn it
into a hash of words with .words
and .Set
. A Set is a hash
like structure where all the values are True
, so coercing a list (a list
like structure, really) like this works out (as opposed to in Perl, which we will show
later on).
See
docs.raku.org/type/Set
for more information about the Set
type, and
docs.raku.org/routine/Set
for more information about the Set
method.
[3] The list of missing permutations will end up here.
[4] Iterate over all the permutatations of the list of individual
characters (the .comb
), as a string (the .join
), and add the
candidate if it is missing in the hash [4a].
See
docs.raku.org/routine/permutations for more information about permutations
.
[5] Print the result, if any. Note the .unique
call that gets rid of duplicates,
if any. This is not the case for the default value, but duplicate letters in the input string
will lead to duplicate permutations:
> 'abc'.comb.permutations>>.join.join(" ").say;
abc acb bac bca cab cba
> 'abb'.comb.permutations>>.join.join(" ").say;
abb abb bab bba bab bba
Running it:
$ ./missing-permutations
LERP
With verbose mode:
$ ./missing-permutations -v
: Checking candidate: PERL
: Checking candidate: PELR
: Checking candidate: PREL
: Checking candidate: PRLE
: Checking candidate: PLER
: Checking candidate: PLRE
: Checking candidate: EPRL
: Checking candidate: EPLR
: Checking candidate: ERPL
: Checking candidate: ERLP
: Checking candidate: ELPR
: Checking candidate: ELRP
: Checking candidate: RPEL
: Checking candidate: RPLE
: Checking candidate: REPL
: Checking candidate: RELP
: Checking candidate: RLPE
: Checking candidate: RLEP
: Checking candidate: LPER
: Checking candidate: LPRE
: Checking candidate: LEPR
: Checking candidate: LERP
: Checking candidate: LRPE
: Checking candidate: LREP
LERP
With a custom string and list of permutations:
$ ./missing-permutations -s=abba -p="abba aabb baab"
abab, baba, bbaa
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Algorithm::Combinatorics 'permutations'; # [1]
use List::Util 'uniq'; # [1]
use Getopt::Long;
my $verbose = 0; GetOptions("verbose" => \$verbose);
my $string = shift(@ARGV) || 'PERL'; # [2]
my $permutations = shift(@ARGV) || "PELR PREL PERL PRLE PLER PLRE EPRL EPLR ERPL
ERLP ELPR ELRP RPEL RPLE REPL RELP RLPE RLEP
LPER LPRE LEPR LRPE LREP";
my @letters = split("", $string);
my %permuations = map { $_ => 1} split(/\s+/, $permutations); # [3]
my @missing;
for my $candidate (permutations(\@letters))
{
my $as_string = join("", @$candidate);
say ": Checking candidate: $as_string" if $verbose;
push(@missing, $as_string) unless $permuations{$as_string};
}
say join(", ", uniq @missing) if @missing;
[1] Perl does not have these Raku methods built in, but CPAN has alternatives that work quite well.
[2] I have chosen to use positional arguments this time, as opposed to the named ones in the Raku version.
[3] Just coercing the list to a hash would not work out. The first value woule be taken as the key, with the second one as the value (and so on). We would loose half the permutations. And this would only work if the number of elements is an even number. Thus the elaborate «map» to set it up.
Running it gives the same result as the Raku version:
$ ./missing-permutations-perl
LERP
$ ./missing-permutations-perl -v
: Checking candidate: PERL
: Checking candidate: PELR
: Checking candidate: PREL
: Checking candidate: PRLE
: Checking candidate: PLER
: Checking candidate: PLRE
: Checking candidate: EPRL
: Checking candidate: EPLR
: Checking candidate: ERPL
: Checking candidate: ERLP
: Checking candidate: ELPR
: Checking candidate: ELRP
: Checking candidate: RPEL
: Checking candidate: RPLE
: Checking candidate: REPL
: Checking candidate: RELP
: Checking candidate: RLPE
: Checking candidate: RLEP
: Checking candidate: LPER
: Checking candidate: LPRE
: Checking candidate: LEPR
: Checking candidate: LERP
: Checking candidate: LRPE
: Checking candidate: LREP
LERP
$ ./missing-permutations-perl abba "abba aabb baab"
abab, baba, bbaa
Padovan Prime
is a Padovan Number
that’s also prime.
P(0) = P(1) = P(2) = 1
First few Padovan Numbers
are as below:
1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, ...
and then followed by
P(n) = P(n-2) + P(n-3)
Write a script to compute first 10 distinct Padovan Primes
.
2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057
Let us start with the plain Padovan Sequence:
File: padovan-seq
#! /usr/bin/env raku
unit sub MAIN (:c(:$count) = 10);
my $padovan := ( 1, 1, 1, ( * + * + * * 0 ) ... Inf); # [1]
say $padovan[^$count].join(", ");
[1] The first three values are 1, 1, 1, followed by a rule used to generate the rest (until
we reach infinity, which is not very likely to happen). We can access previous values in the
sequence with a *
, as you probably have seen used in the Fibonacci Sequence:
my $fib := (1, 1, * + * ... Inf);
The last *
is the previous value in the sequene, and the first one is the value
before that one. (They are mapped in the same order as the sequence, left to right.) A
*
is either a backreference or a multiplication symbol, depending on the contect.
So this is perfectly legal:
my $not-fib := (1, 1, * * * ... Inf);
The result is an infinite sequence of ones, which is not very useful. But you get the idea.
We are not limited to the two previous values, as in the Fibonacci Sequence. In this program we have three of them:
( * + * + * * 0 )
-3 -2 -1
The last one (n-1
) does not appear in the rule, so we get rid of it by multiplying
it with zero (before adding it to the current value).
Running it:
$ ./padovan-seq
1, 1, 1, 2, 2, 3, 4, 5, 7, 9
$ ./padovan-seq -c=20
1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, 49, 65, 86, 114, 151
Then we can do the (unique) Padovan Primes:
File: padovan-prime
#! /usr/bin/env raku
unit sub MAIN (:c(:$count) = 10);
my $pp := ( 1, 1, 1, ( * + * + * * 0 ) ... Inf)
.squish.map({ .is-prime ?? $_ !! next; }); # [1]
say $pp[^$count].join(", ");
[1]
We start by getting rid of duplicates with squish
. This
is a quicker way of getting rid of duplicates than unique
, as long as the
values are sorted - which they are here.
See
docs.raku.org/routine/squish
for more information about squish
.
See
docs.raku.org/routine/unique
for more information about unique
.
The next
inside the
map
throws away unwanted values for us. We can do this because
map
is just a loop in disguise. As discussed last week, the
perhaps intuitive approach of using grep
will not work, as that
will coerce the sequence to a list. Coercing an infinite sequence to a list
is not a good idea...
The statement above is wrong, as lists can be lazy. We can use grep
here. See Fooled by a Sequence, Twice for details.
Running it:
$ ./padovan-prime
2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057
$ ./padovan-prime -c=20
2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057, 136300555243\
4666078217421284621279933627102780881053358473, 15588776951416085077510989418\
99265975115403618621811951868598809164180630185566719, 9514203022010025394023\
10273090843853120870141909600424753183817462900358600208645068320916119500070\
3512605873489625155263832444165133265702781668278617857, 90940451276093003077\
18864183055951739592090107263864059593370868669195215030390809976516513500476\
90363279721460283023944262487276272988950339344843066772030059953258336155241\
604336995582305603, 296366550330506514449537888675381711839579331860043184177\
19183707179305662773345978196190310748479760080388318037731846935500353864309\
53696258830596487192090007879034974299810336115728932804032510539591791791124\
1134544611612574306149191156818561, 56412823570187882990087438701915989853561\
06741716061884326327233703904981919635108230122321389676915239917194911992553\
56041943030136093202352235201665050772535553662284803550135930534349142210158\
025255694494615533071533403645328131733455622011742300001108369104945607561, \
25068496605423409875670210849179322228964873400612804176906096990585621105923\
56970876869925638367726053328850171255169828859233086406877843126569253689742\
38339976820267205534725372227207301634518581372758802287622233061492522744267\
0392064674135679905751603325619757776206503774609, 18131086079835702083001057\
52248658360532183508189648529465491925911281663106714103080294620023450197425\
46270751069456570457666254617953776159464977697249630718556891794069211945515\
96715529379050318821662798104171888481353067531375964034582907393366605502699\
96809755349404944550036798217467457892803914565780947918753266899486846722959\
78055327881924264729417959195321775485865940312218621319935896405007817092694\
64691404924869740349183441090715200854672993805541021772384142291595537223787\
785826591643110001911, 102325153348233538676707143261344910867902664379074754\
88551245381448253675656839027055414259563289688832927425772167072845104993091\
62587468388849321677548309589707109456052743116936338107991442608481303764209\
09794970634163317774026788493260806057039067309298285082541699255609773131964\
06597710152864099585519997063599854607053117227234835995878640758565995607490\
60118452749938634436622794116406206558307481872226731380767964196889938550667\
33374205627375028153096761498213103871689043652250982401286151921654932683348\
71759581479386724923950824134953217032530790092750402487808903170412985286291\
12883616155583324993376009973537051979558473590080543716521927002021159122761\
839830889, 696841126833041392535276133694672517816579382807868540085206122940\
37787334363876537245242072063632999927645185655574682758125027509931068481276\
39270224683311190122343973053515480407432949673988624840172657054111881322225\
86801999614151920719386833734062821779218058695823768418751009288180440147097\
11974115130908020492080028688069191959563929193098060930437015554097578894091\
76816763323037021821877500210879443407439332045979580286851634967823845006518\
80662196936949583385645066283867741131121901017059218775394795313803981839052\
10193340909205209734748034293106661274312544553675584850981084278729807727365\
67598672484331654072243387783649020097854146403614854202418221057358529475956\
44309849970111521480590263045559912866376277191908078949479665454474605989295\
2249206895256894313520623931496283369460049
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use feature 'state';
no warnings qw(experimental::signatures);
my $count = $ARGV[0] || 10;
sub padovan ($index) # [1]
{
state @padovan = (1, 1, 1);
while (@padovan <= $index)
{
push(@padovan, $padovan[-2] + $padovan[-3]);
}
return $padovan[$index];
}
my @ps = map { padovan($_) } (0 .. $count -1); # [2]
say join(", ", @ps);
[1] Here we have a procedure with an internal cache (set up as a state variable), that gives us the Padovan number with the specified index. The procedure will compute (and cache) the sequence up to that number, if not done already.
[2] Get the requested number of values, with «map» as a wrapper around the procedure call (instead of a loop).
Running it:
$ ./padovan-seq-perl
1, 1, 1, 2, 2, 3, 4, 5, 7, 9
$ ./padovan-seq-perl 12
1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16
Why keep track of the indices you may think. Why indeed. This version of the program has a procedure that works as a sequence, by giving the next value each time it is called. (This will make the final program easier to program.)
File: padovan-seq2-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use feature 'state';
no warnings qw(experimental::signatures);
my $count = $ARGV[0] || 10;
sub next_padovan
{
state @padovan = (1, 1, 1);
state $index = 0; # [1]
while (@padovan <= $index)
{
push(@padovan, $padovan[-2] + $padovan[-3]);
}
return $padovan[$index++];
}
my @ps; push(@ps, next_padovan($_)) for 1..$count; # [2]
say join(", ", @ps);
[1] We have to keep track of the index this time.
[2] The assignment does not need to bother with the indices this time. I rewrote it as a loop, but «map» can be used here as well.
Note that we cache the computed part of the sequence, even though we have no way of retrieving old values. This is generally not a good idea, and we should fix this. (And I will, later on.)
Then the final program:
File: padovan-prime-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use feature 'state';
use Math::Prime::Util 'is_prime';
no warnings qw(experimental::signatures);
my $count = $ARGV[0] || 10;
sub next_padovan
{
state @padovan = (1, 1, 1);
state $index = 0;
while (@padovan <= $index)
{
push(@padovan, $padovan[-2] + $padovan[-3]);
}
return $padovan[$index++];
}
my @pp;
while (@pp < $count)
{
my $next = next_padovan;
next if @pp && $next eq $pp[-1]; # [1]
next unless is_prime($next);
push(@pp, $next);
}
say join(", ", @pp);
[1] Skip duplicates, if any. This will not work with an empty list (which we have initially), thus the first part of the test «if @pp».
Running it:
$ ./padovan-prime-perl
2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057
$ ./padovan-prime-perl 12
Parameter '1.88901913855479e+19' must be a positive integer \
at ./padovan-prime-perl line 33.
Oops. Perl does not support large integers out of the box. But «use bigint» fixes that:
File: padovan-prime-bigint-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use feature 'state';
use bigint;
use Math::Prime::Util 'is_prime';
no warnings qw(experimental::signatures);
my $count = $ARGV[0] || 10;
sub next_padovan
{
state @padovan = (); # [1]
if (@padovan < 2) # [2]
{
push(@padovan, 1); # [2a]
}
else # [3]
{
push(@padovan, $padovan[-2] + $padovan[-3]); # [3a]
}
shift @padovan if @padovan == 4; # [4]
return $padovan[-1]; # [5]
}
my @pp;
while (@pp < $count)
{
my $next = next_padovan;
next if @pp && $next eq $pp[-1]; # [1]
next unless is_prime($next);
push(@pp, $next);
}
say join(", ", @pp);
[1] We have to keep track of the three previous values.
[2] Fill up with 1, 1 and 1 initially, until we have three of them.
[3] Then we use the rule to add a new value.
[4] Get rid of the first value in the array, as we do not need it anymore.
[5] Return the current (newest) value.
Running it:
$ ./padovan-prime-bigint-perl
2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057
$ ./padovan-prime-bigint-perl 12
2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057, \
1363005552434666078217421284621279933627102780881053358473, \
1558877695141608507751098941899265975115403618621811951868598809164180630185566719
And that's it.