Merge pull request #5743 from mattneleigh/pwc154

	new file:   challenge-154/mattneleigh/perl/ch-1.pl

2 files changed, 210 insertions, 0 deletions

diff --git a/challenge-154/mattneleigh/perl/ch-1.pl b/challenge-154/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..4f3c3d9453
--- /dev/null
+++ b/challenge-154/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,107 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my $string = "PERL";
+my @given_permutations = qw(
+    PELR PREL PERL PRLE PLER PLRE EPRL EPLR ERPL
+    ERLP ELPR ELRP RPEL RPLE REPL RELP RLPE RLEP
+    LPER LPRE LEPR LRPE LREP
+);
+
+printf(
+    "\nGiven permutations: %s\n",
+    join(", ", sort(@given_permutations))
+);
+printf(
+    "Permutations not found in the list: %s\n\n",
+    join(", ", find_missing_permutations($string, \@given_permutations)),
+);
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+################################################################################
+# Determine which possible sequences may be missing from a set of permutations
+# of characters
+# Takes two arguments:
+# * A (hopefully short...) string of characters from which the permutations
+#   will be constructed (e.g. "PERL")
+# * A ref to a list of preexisting permutations, which must consist of strings
+#   made up of EXACTLY the characters found in the first argument (e.g.
+#   [ "PERL", "PREL", "ERPL", "PLER" ... ] )
+# Returns:
+# * A list of possible permutations of the characters in the first argument
+#   that were NOT found in the array pointed to by the second argument; If
+#   there are none, this list will be empty
+# NOTE: Permutation sequence derived from the QuickPerm algorithm as found at:
+# https://www.baeldung.com/cs/array-generate-all-permutations
+# https://www.quickperm.org/01example.php
+################################################################################
+sub find_missing_permutations{
+    my $chars_joined = shift();
+    my $given_list = shift();
+
+    my %given_table;
+    my @chars = split('', $chars_joined);
+    my @p = (0 .. scalar(@chars));
+    my @missing_list;
+    my $i;
+    my $j;
+
+    # Build a lookup table for the given list
+    # of known permutations
+    foreach(@{$given_list}){
+        $given_table{$ARG} = 1;
+    }
+
+    # See if the initial arrangement is in
+    # the given list
+    push(@missing_list, $chars_joined)
+        unless($given_table{$chars_joined});
+
+    # Generate permutations...
+    $i = 1;
+    while($i < scalar(@chars)){
+        $p[$i]--;
+        if($i % 2){
+            # $i is odd
+            $j = $p[$i];
+        } else{
+            # $i is even
+            $j = 0;
+        }
+
+        # Swap the characters at $i and $j
+        ($chars[$j], $chars[$i]) = ($chars[$i], $chars[$j]);
+
+        # See if this permutation wasn't in the
+        # given list
+        $chars_joined = join("", @chars);
+        push(@missing_list, $chars_joined)
+            unless($given_table{$chars_joined});
+
+        $i = 1;
+        while($p[$i] == 0){
+            $p[$i] = $i;
+            $i++;
+        }
+    }
+
+    # Hand the caller a sorted list of
+    # missing permutations
+    return(sort(@missing_list));
+
+}
+
+
+
diff --git a/challenge-154/mattneleigh/perl/ch-2.pl b/challenge-154/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..82f021f322
--- /dev/null
+++ b/challenge-154/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my %padovan_primes;
+my $n = 10;
+
+while(scalar(keys(%padovan_primes)) < $n){
+    my $padovan = next_padovan();
+
+    $padovan_primes{$padovan} = 1
+        if(!$padovan_primes{$padovan} && is_prime($padovan));
+}
+
+printf(
+    "\nThe first %d Padovan primes are:\n    %s\n\n",
+    $n,
+    join(", ", sort({ $a <=> $b } keys(%padovan_primes)))
+);
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+################################################################################
+# Calculate the next number in the Padovan sequence- starting with P(0) (or 1)
+# when the function is first called.  There is no way to reset the sequence
+# once it has begun.
+# Takes no arguments.
+# Returns:
+# * The next number in the Padovan sequence, after the one returned in the
+#   previous call to this function, if any; P(0), which has a value of 1, is
+#   returned upon the first call to this function
+################################################################################
+sub next_padovan{
+    use v5.10;
+
+    state @sequence;
+    state $calls = 0;
+
+    unless(@sequence){
+        # This only happens the first time this
+        # function is called
+        @sequence = (1, 1, 1);
+    }
+
+    if($calls < 3){
+        $calls++;
+        return(1);
+    }
+    
+    # Calculate a new number in the sequence,
+    # and delete an old one
+    push(@sequence, $sequence[1] + $sequence[0]);
+    shift(@sequence);
+
+    return($sequence[2]);
+
+}
+
+
+
+################################################################################
+# Determine whether a given integer N is prime
+# Takes one argument:
+# * The integer N
+# Returns on success:
+# * 1 if N is prime
+# * 0 if N is not prime
+# NOTE: If N is less than zero, it will always be considered nonprime
+################################################################################
+sub is_prime{
+    my $n = int(shift());
+
+    my $i;
+
+    # Take care of a few easy cases
+    return(1)
+        if(($n == 2) || ($n == 3));
+    return(0)
+        if(($n <= 1) || !($n % 2) || !($n % 3));
+
+    # See if certain factors divide evenly
+    for($i = 5; $i * $i <= $n; $i += 6){
+        if(!($n % $i) || !($n % ($i + 2))){
+            return(0);
+        }
+    }
+
+    return(1);
+
+}
+
+
+