RabbitFarm

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