RabbitFarm

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

Challenge 154

Padovan Sequence

The Power of Prolog: YouTube Channel

The Power of Prolog

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

Challenge 154

Padovan Sequence