RabbitFarm
2022-03-06
The Weekly Challenge 154 (Prolog Solutions)
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
Write a script to compute the first 10 distinct Padovan Primes.
Solution
:-initialization(main).
make_lists([], []).
make_lists([Word|Words], [List|Rest]):-
atom_chars(Word, List),
make_lists(Words, Rest).
missing_permutation(Word, Permutations, Missing):-
atom_chars(Word, Chars),
permutation(Chars, Permutation),
\+ member(Permutation, Permutations),
atom_chars(Missing, Permutation).
main:-
make_lists(['PELR', 'PREL', 'PERL', 'PRLE', 'PLER', 'PLRE', 'EPRL', 'EPLR', 'ERPL',
'ERLP', 'ELPR', 'ELRP', 'RPEL', 'RPLE', 'REPL', 'RELP', 'RLPE', 'RLEP',
'LPER', 'LPRE', 'LEPR', 'LRPE', 'LREP'], Permutations),
missing_permutation('PERL', Permutations, Missing),
write(Missing), nl,
halt.
Sample Run
$ gprolog --consult-file prolog/ch-1.p
LERP
Notes
This is a nice place where Prolog really shines compared to the Perl solution
to the same problem. That approach requires a good deal of care to properly generalize.
The Prolog solution is completely general without any extra work! Here we need only split
the starting word into characters and then backtrack through any possible missing
permutations with permutation/2
and member/2
. Elegant!
Part 2
Write a script to compute the first 10 distinct Padovan Primes.
Solution
padovan_primes(Size, Primes, PrimesAccum, A, B, C) --> {D is B + A, fd_not_prime(D)}, [A], padovan_primes(Size, Primes, PrimesAccum, B, C, D).
padovan_primes(Size, Primes, PrimesAccum, A, B, C) --> {D is B + A, fd_prime(D), append(PrimesAccum, [D], NewPrimesAccum), length(NewPrimesAccum, L), L < Size}, [A], padovan_primes(Size, Primes, NewPrimesAccum, B, C, D).
padovan_primes(Size, Primes, PrimesAccum, A, B, _) --> {D is B + A, fd_prime(D), append(PrimesAccum, [D], NewPrimesAccum), length(NewPrimesAccum, L), L >= Size, Primes = NewPrimesAccum}, [D].
n_padovan_primes(N, Primes):-
succ(N, X),
phrase(padovan_primes(X, PadovanPrimes, [], 1, 1, 1), _),
[_|Primes] = PadovanPrimes.
Sample Run
$ gprolog --consult-file prolog/ch-2.p
| ?- n_padovan_primes(7, Primes).
Primes = [2,3,5,7,37,151,3329] ?
(113 ms) yes
| ?-
Notes
If you watch any of the videos on The Power of Prolog YouTube channel you'll learn
from Markus Triska that a DCG is the preferable way to handle this sort of problem.
Not just because DCGs are a convenient way to process a list in Prolog, but because they
can be used to both generate and test solutions. Excellent advice! This code above shows
this for a somewhat complicated problem. We must generate the sequence and also determine
which of the sequence terms are prime. Primality testing is performed by GNU Prolog's
fd_prime/1
and fd_not_prime/1
. As the primes are found they are added, along with the
most recently computed three sequence terms, as extra arguments.
This solution is very similar to a previous bit of code for Fibonacci Strings.
References
posted at: 19:25 by: Adam Russell | path: /prolog | permanent link to this entry
Padovan Prime Directive: Find the Missing Permutations
The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.
Part 1
You are given possible permutations of the string "PERL". Write a script to find any permutations missing from the list.
Solution
use strict;
use warnings;
use Algorithm::Loops q/NestedLoops/;
sub factorial{
my($n) = @_;
return 1 if $n == 1;
$n * factorial($n - 1);
}
sub missing_permutations{
my($permutations, $s) = @_;
my @missing;
##
# remove any duplicates
##
my %permutations;
map {$permutations{$_}=undef} @{$permutations};
$permutations = [keys %permutations];
##
# get the letters missing in each slot
##
my @missing_letters;
for my $i (0 .. length($s) - 1){
my %slot_counts;
my @ith_letters = map {my @a = split(//, $_); $a[$i]} @{$permutations};
map{$slot_counts{$_}++} @ith_letters;
$missing_letters[$i] = [grep {$slot_counts{$_} != factorial(length($s) - 1)} keys %slot_counts];
}
##
# determine which missing letters form missing permutations
##
my $nested = NestedLoops(\@missing_letters);
while (my @set = $nested->()){
my $candidate = join("", @set);
my @matched = grep {$candidate eq $_} @{$permutations};
push @missing, $candidate if !@matched;
}
return @missing;
}
MAIN:{
my @missing = missing_permutations(
["PELR", "PREL", "PERL", "PRLE", "PLER", "PLRE", "EPRL", "EPLR", "ERPL",
"ERLP", "ELPR", "ELRP", "RPEL", "RPLE", "REPL", "RELP", "RLPE", "RLEP",
"LPER", "LPRE", "LEPR", "LRPE", "LREP"], "PERL"
);
print join(", ", @missing) . "\n";
}
Sample Run
$ perl perl/ch-1.pl
LERP
Notes
Here I tried to write as general a solution as possible. This code should handle any number of missing permutations, provided that there are no duplicate letters within the starting word.
The approach is to first consider each position in the starting word as a "slot" and then check which letters are missing from each slot. In the code above we assume that each letter from the starting word appears in each slot at least once.
Once we know the missing letters we form new permutations with them and see which ones are missing from the initial list. To cut down on the tedious bookkeeping involved I used the Algorithm::Loops module to generate the candidate permutations from the known missing letters.
An even more general solution would not only catch any number of missing permutations but also allow for duplicate letters in the starting word and an input containing permutations which so not have at least one occurrence of each letter per slot.
Part 2
Write a script to compute the first 10 distinct Padovan Primes.
Solution
use strict;
use warnings;
use Math::Primality qw/is_prime/;
sub first_n_padovan_primes{
my($n) = @_;
my @padovan_primes;
my @padovans = (1, 1, 1);
{
push @padovans, $padovans[@padovans - 2] + $padovans[@padovans - 3];
push @padovan_primes, $padovans[@padovans - 1] if is_prime($padovans[@padovans - 1]);
redo if @padovan_primes <= $n;
}
return @padovan_primes[1..@padovan_primes - 1];
}
MAIN:{
print join(", ", first_n_padovan_primes(10)) . "\n";
}
Sample Run
$ perl perl/ch-2.pl
2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057
Notes
Before really looking at the sample solutions for this problem I decided that my approach would be generat e giant list of primes and then check against that list to determine if a new sequence element was prime or not. Nice idea, but it doesn't scale that well for this problem! Yes, it worked for a smaller number of Padovan Primes but to catch the first ten would require generating an enormous list of prime numbers. Better in this case to use something like Math::Primality to check each candidate.
References
posted at: 18:43 by: Adam Russell | path: /perl | permanent link to this entry