# 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