- Added solutions by Colin Crain.

2 files changed, 323 insertions, 0 deletions

diff --git a/challenge-034/colin-crain/perl5/ch-1.pl b/challenge-034/colin-crain/perl5/ch-1.pl
new file mode 100644
index 0000000000..e20da1a037
--- /dev/null
+++ b/challenge-034/colin-crain/perl5/ch-1.pl
@@ -0,0 +1,193 @@
+#! /opt/local/bin/perl
+#
+#       deli_slicer.pl
+#
+#       PWC 34 - Task #1
+#       Write a program that demonstrates using hash slices and/or array
+#       slices.
+#
+#       In Perl, from the beginning, it has always been noted that "there is
+#       more than one way to do it". As such, I have seen through the years
+#       how programmers have a tendency to find their personal style -- tools
+#       and idioms that work for them -- and then apply them again and again
+#       to solve the specific problem of the moment. This is all well and
+#       good, but the fact of the matter is that whatever one is doing,
+#       there's probably a different way to go about it to get the job done.
+#
+#       Hash slices allow accessing the values of subsets of keys for a hash,
+#       returning lists of results. As of 5.20 lists of alternating key value
+#       pairs can be returned, should you want that. In this mass translation
+#       of list data they much resemble the map function. Now I like lists,
+#       and working with list data operators like map and grep, so I can see
+#       the use of this. However one most interesting case I have found is using
+#       slices as lvalues, allowing bulk assignment to a hash in a nice
+#       succinct manner. For generated hashes this can be very quick, powerful
+#       and clean.
+#
+#       So lets make a toy program. Say we want a to make a cypher, or a puzzle
+#       perhaps, based on assignment of numbers to letters. To make things
+#       interesting we'll assign a list of primes to letters, then we can take
+#       groups of letters and multiply them to produce a new number. After
+#       the fact we can reconstruct the letters that made up the original word
+#       by prime factorization. It's a toy, so we won't worry too much about
+#       why we might want to do such a thing, but it's neat. What we need is a
+#       hash, with letters of the alphabet mapped to sequential primes.
+#
+#       From a previous challenge we constructed a prime number generator that
+#       produces a requested number of primes starting at 2. We'll take this
+#       subroutine and transplant it whole; it returns a list of primes on the
+#       stack. For our toy decoder, we will borrow two more prime-related
+#       subroutines: decompose(), which reduces a number into its prime
+#       factors, and its dependency make_primes().
+#
+#       We can now generate the required hash in one simple line:
+#
+#           @hash{ ( 'a'..'z' ) } = make_primes(26);
+#
+#       which is rather ridiculously easy. As part of an encoding function, we
+#       use another slice:
+#
+#           @lookup{ split //, lc($word) }
+#
+#       which takes the input phrase, chops it up into a list of letters, and
+#       returns a list of looked-up prime values for those component letters.
+#       In the decoding function we use a third slice:
+#
+#           @reverse_lookup{ decompose($code_number) }
+#
+#       which takes the list of primes returned by decompose() and produces a
+#       list of the corresponding letter values.
+#
+#       So here we have three examples of the use of hash slices for list-wise
+#       data transformation, in this case each is fed not by a fixed list, but
+#       rather by a generated list returned by a function or subroutine; the
+#       slice syntax produces in turn a list of corresponding hash values.
+#       Displaying the transformation process shows the component letters of the
+#       words have lost their placement order but have been preserved. As the
+#       purpose here is to demonstrate the use of hash slices as list
+#       transformation tools, we'll leave it at that. Figuring out a way to save
+#       and reconstruct the letter order can be left as an exercise for the
+#       reader, or at least another time.
+#
+#
+#       2019 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+use warnings;
+use strict;
+use feature ":5.26";
+
+use List::Util qw(product);
+
+## ## ## ## ## MAIN
+
+my %lookup;
+
+## here we do bulk assignment to the hash from the list returned by a subroutine
+@lookup{ ( 'a'..'z' ) } = make_primes(26);
+
+## output to demonstrate the key/value pairs produced
+say "the generated lookup hash:\n";
+for (sort keys %lookup){
+    printf "\t%s => %-d\n", $_, $lookup{$_};
+}
+
+## create a reverse_lookup lookup hash. We know the values are unique, being prime and all
+my %reverse_lookup = reverse %lookup;
+
+
+## toy test
+my $phrase = 'The quick brown fox jumped over the lazy dog';
+
+## first we encode the letters into primes and multiply them, using the List::Util::product function
+my (@encoded, @decoded);
+for my $word ( split /\s/, $phrase ) {
+    push @encoded, product( @lookup{ split //, lc($word) } );
+}
+## then we decode the array of products back into their constituant letters
+for my $code_number ( @encoded ) {
+    push @decoded, join '', ( @reverse_lookup{ decompose($code_number) });
+}
+
+## display the process
+say '';
+printf " phrase:   %s\n", $phrase;
+printf "encoded:   %s\n", (join " ", @encoded);
+printf "decoded:   %s\n", (join " ", @decoded);
+
+
+
+## ## ## ## ## SUBS
+
+sub make_primes {
+## returns a list of as many primes as you ask it for
+    my $num_primes = shift;
+    my $count = 0;
+    my @output = (2);
+    my $is_prime;
+    for(  my $candidate = 3;  $count <= ($num_primes - 2);  $candidate += 2  ) {
+        my $sqrt_candidate = sqrt( $candidate );
+        $is_prime = 1;
+        for(  my $test = 3; ( $test <= $sqrt_candidate ) && ( $is_prime==1 ); $test += 2  ) {
+            if(  $candidate % $test == 0  ) {
+                $is_prime = 0;
+            }
+        }
+        if(  $is_prime == 1  ) {
+            push @output, $candidate;
+            $count++;
+        }
+    }
+    return @output;
+}
+
+sub decompose {
+## given a number,
+## returns an array list of prime decomposition factors of the number
+    my $num = shift;
+    my @decomp;
+    my $prime = 2;
+    my $primelist = [$prime];
+
+    while ( $prime <= $num ) {
+        while ($num % $prime == 0) {
+            $num = $num / $prime;
+            push @decomp, $prime;
+        }
+        $prime = get_next_prime($primelist);
+    }
+    return @decomp;
+
+}
+
+sub get_next_prime {
+    ## given a listref of all primes up until a certain point,
+    ## adds next prime to the list and returns the prime
+
+    my $primelist = shift;
+
+    ## assign the last prime recorded + 1 as the new candidate
+    my $candidate = $primelist->[scalar $primelist->@* - 1] + 1;
+
+    ## index through the prime list checking for divisability; if found augment and restart the test.
+    ## if the test value exceeds the squareroot of the candidate, the candidate
+    ## is prime. Put it on the list and return the candidate.
+    ## yes it's an infinite loop but there will always be another prime, right?
+    ## ...
+    ## right?
+    for (my $i = 0; my $test = $primelist->[$i]; $i++) {
+        my $root = int(sqrt($candidate));
+        if ($test > $root) {
+            push $primelist->@*, $candidate;
+            return $candidate;
+        }
+
+        if ($candidate % $test == 0) {
+            $i = -1;
+            $candidate++;
+            next;
+        }
+    }
+}
diff --git a/challenge-034/colin-crain/perl5/ch-2.pl b/challenge-034/colin-crain/perl5/ch-2.pl
new file mode 100644
index 0000000000..76c7875452
--- /dev/null
+++ b/challenge-034/colin-crain/perl5/ch-2.pl
@@ -0,0 +1,130 @@
+#! /opt/local/bin/perl
+#
+#       dispatches.pl
+#
+#       PWC 034 - Task #2
+#       Write a program that demonstrates a dispatch table.
+#
+#       in Perl, functions are first-class citizens, which means they can be
+#       indirectly referenced and those references assigned to variables just
+#       like any other data. These code references can be accessed using the
+#       arrow notation similarly to those employed with arrays and
+#       hashes, in this case giving the function a list of arguments:
+#
+#           $function_reference->($arg1, $arg2, ...)
+#
+#       In a dispatch table, the data is a collection of subroutine actions,
+#       gathered in another ubiqitous Perl data type, the hashtable. By
+#       looking up a given input against the keys of the the table, we obtain
+#       a selected action option as the value and can then execute the coderef.
+#
+#       In this, the table resembles a C switch statement, selecting an action
+#       for the program's execution. With this functionality we can allow input
+#       data to alter the the program flow, at least within the possibilities
+#       defined in the subroutines.
+#
+#       To demonstrate this, we'll build a little toy calculator. Inputting a
+#       string containing an expression, like
+#
+#           ./dispatches.pl "2 * 3 + 5 / 4"
+#
+#       evaluates the expression from left to right, switching the program
+#       execution and action on a running talley between mathematical operators
+#       as required. Each operator is defined by a subroutine keyed on the
+#       operator symbol, shifting its operands off an internal stack, held in
+#       the array reference $stack, and pushing the results back on as required.
+#
+#       The input is given as a string to the program, which is then parsed
+#       into lists of operators and operands. The program can handle a string
+#       of any number of operations, but as this is a demonstration of a dispatch
+#       table for action on the stack array, the standard rules of operator
+#       precedence are not implemented and evaluation is strictly left to right
+#       without parentheses.
+#
+#       As can be seen, the actual routines to process the mathematical
+#       operators are anonymous subroutines constructed within the hashtable
+#       definition itself. Note that division by zero is safe and does not
+#       crash the program, it simply returns 'NAN', for 'Not A Number'; the
+#       program then terminates without attempting to evaluate further.
+#
+#       Implementation of an additional action is as simple as adding another
+#       key/value pair to the hash, as long as the input is correctly passed through
+#       preprocessing to match a key in the dispatch table. In this case a new
+#       operator can be most any string of non-word characters (the shell and
+#       Perl may cause problems when using '!', '$', and '@' -- be warned, as
+#       constructs containing these can produce unexpected results). I have
+#       inserted a new 'square of the difference' operator to demonstrate this.
+#
+#       I have left in verbose code to examine the state of the program as it
+#       progresses; this makes it easy to see how the various operator actions
+#       change the stack, as the first elements are taken off and the result
+#       pushed back on as processing continues. A good example would be
+#
+#           ./dispatches.pl "20 ** 2 * 0 - 35 *-* 5 / 4"
+#
+#       which uses all of the possible operations, including the new "square of
+#       the difference" operator *-* that I just made up.
+#
+#       2109 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+#use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## MAIN
+
+## first let us establish our dispatch table, and a few arrays to handle our lists of operators and operands
+my $operator_dispatch = {
+    '*'     => sub {    my ($x, $y) = splice $_[0]->@*, 0, 2;               ## multiply
+                        unshift $_[0]->@*, ($x * $y)    },
+    '+'     => sub {    my ($x, $y) = splice $_[0]->@*, 0, 2;               ## add
+                        unshift $_[0]->@*, ($x + $y)    },
+    '-'     => sub {    my ($x, $y) = splice $_[0]->@*, 0, 2;               ## subtract
+                        unshift $_[0]->@*, ($x - $y)    },
+    '/'     => sub {    my ($x, $y, $result) = splice $_[0]->@*, 0, 2;             ## divide (safe version)
+                        eval {$result = $x/$y};
+                        ($@) and $result = 'NAN';
+                        unshift $_[0]->@*, $result},
+    '**'    => sub {    my ($x, $y) = splice $_[0]->@*, 0, 2;               ## power
+                        unshift $_[0]->@*, ($x ** $y)   },
+    '*-*'    => sub {   my ($x, $y) = splice $_[0]->@*, 0, 2;               ## 'square of the difference' new operator
+                        unshift $_[0]->@*, (($x - $y)** 2)  },
+};
+
+my $stack = [];
+my @operators;
+
+## fetch the input string and parse it
+my @args = split /\s/, shift @ARGV;
+say "   exp: ", , (join " ", @args);
+
+for my $arg ( @args ) {
+    $arg =~ /^\d+$/     &&  push $stack->@*, $arg;
+    $arg =~ /^\W+$/     &&  push @operators, $arg;
+}
+
+## iterate through the list of operators
+for my $op ( @operators ) {
+
+    ## we can chose to first check whether the key exists and do something if it doesn't
+    if (not exists $operator_dispatch->{$op}) {
+        exit { say "operator '$op' not recognized, cannot evaluate further" };
+    }
+
+    ## show us what's happening
+    say " stack: ", (join " ", $stack->@*);
+    say "    op: ", $op;
+
+    ## this one statement does all the heavy lifting for the calculator
+    $operator_dispatch->{$op}->($stack);
+
+    ## once we are outside mathematics there is no point to continuing
+    last if $stack->[0] eq 'NAN';
+}
+
+# The running result will always be the first item on the stack, so when we run
+# out of operators that's what we have left
+say  "result: $stack->[0]";