- Added solutions by Colin Crain.

2 files changed, 340 insertions, 0 deletions

diff --git a/challenge-039/colin-crain/perl5/ch-1.pl b/challenge-039/colin-crain/perl5/ch-1.pl
new file mode 100644
index 0000000000..38380f69fa
--- /dev/null
+++ b/challenge-039/colin-crain/perl5/ch-1.pl
@@ -0,0 +1,150 @@
+#! /opt/local/bin/perl
+#
+#       ch-1.pl
+#
+#       PWC 39 - TASK #1
+#       A guest house had a policy that the light remain ON as long as the at
+#           least one guest is in the house. There is guest book which tracks
+#           all guest in/out time. Write a script to find out how long in
+#           minutes the light were ON.
+#               Guest Book
+#               1) Alex    IN: 09:10 OUT: 09:45
+#               2) Arnold  IN: 09:15 OUT: 09:33
+#               3) Bob     IN: 09:22 OUT: 09:55
+#               4) Charlie IN: 09:25 OUT: 10:05
+#               5) Steve   IN: 09:33 OUT: 10:01
+#               6) Roger   IN: 09:44 OUT: 10:12
+#               7) David   IN: 09:57 OUT: 10:23
+#               8) Neil    IN: 10:01 OUT: 10:19
+#               9) Chris   IN: 10:10 OUT: 11:00
+
+#
+#       method: given the dataset we have, it's fairly obvious the house is
+#           continuously occupied from the moment the first person enters, 9:10,
+#           until the time the last person leaves, at 11.00. Roger, the 6th
+#           person, makes the bridge. However we should design our software to
+#           be more generally robust in counting, and have the possiblity that
+#           all should leave before another arrives and the light should be
+#           turned temporarily off then back on.
+#
+#           A few posits will need to be made before we start:
+#               1. a guestbook is a series of entries, where each line is
+#                   entered successively after the previous. Thus we can
+#                   assume the first entry IN will be the earliest time
+#                   recorded. Any time that numerically appears to be earlier
+#                   is in fact rolled over midnight and after that time. The
+#                   same logic applies to IN and OUT times, one must be after
+#                   the other, even if numerically it seems otherwise.
+#               2. that time is on a 24 hour clock, so midnight+30 would be
+#                   written as 00:30. This isn't strictly necessary, but no
+#                   am/pm notation is included in the times above, so if this
+#                   were not true we could only count elapsed times within a
+#                   12 hour block. Again, this doesn't occur in the data, and
+#                   alternately adjusting the conventional notation 12:30 to
+#                   mean 0 hours is straightforward, but it does seem better to
+#                   either do this or add am/pm to the records. As is, if
+#                   someone goes to ground for more than 12 hours in their
+#                   room the system falls apart and maybe the lights go out
+#                   on them. Sitting in the dark is to be avoided for
+#                   reclusive shut-ins, leading to under-stimulation,
+#                   oversleeping, depression and worse, so for the greater
+#                   good 24 hour time it is.
+#
+#           When we look at the first person to come IN, then log the time that
+#           person went OUT, we know the light was on throughout that time and
+#           establish a basic window. We can then incrementally look through the
+#           guestbook entries: if the guest entered before, and left after, the
+#           end of the window we move the end time of the window up accordingly.
+#           If the guest enters after the window endtime we calculate the elapsed
+#           minute total for the window to that point, add it to the accumulator
+#           and reset the window parameters from that guest's IN and OUT. After
+#           each guest entry is processed we proceed to the next guestbook entry
+#           until there are no more.
+#
+#           To make things a little more interesting instead of pasting and
+#           reading from a __DATA__ section at the end of the script, we'll just
+#           read and parse this script itself to find the above specification in
+#           the challenge and config directly from that. You know, because reasons
+#           or something. As is becoming usual, we will then store everything in a
+#           data structure and access it from there. In this case it will be an
+#           array of hashes, each containing the data for one guestbook line, with
+#           keys for name, IN time, and OUT time. We don't actually use the name,
+#           but it's nice to remember these are real fictional people we are
+#           logging the movements of here, with names, faces, loved ones and real
+#           imaginary lives. Although what they are doing ducking in a guesthouse
+#           for 17 minutes is anyone's guess.
+#
+#           Given the constraints that no span between IN and OUT, nor span
+#           between the last guest OUT and the next guest IN is greater than one
+#           day, or really 23:59, the log entries can span days indefinitely. Add
+#           some new entries above and you will see for yourself.
+#
+#
+#       2019 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## CONFIG
+## times in hh:mm notation are normalized to the number of minutes from the start of the day
+open (my $fh, "<", $0) or die "can't open this script thats running this code to read: $0 : $!";
+my @book;
+while ( my $line = <$fh> ) {
+    if ($line =~ /^[)#\s\d]+(\w+)\s+IN: (\d\d:\d\d) OUT: (\d\d:\d\d)/) {
+        push @book, { name => $1, IN => minutes($2), OUT => minutes($3) };
+    }
+}
+
+## ## ## ## ## MAIN
+
+## start_time establishes our initial reference window. Any timestamp less than
+## start_time will in reality represent the following day and so will have 1440
+## added to it.
+my $start_time = $book[0]->{IN};
+my $end_time   = $book[0]->{OUT};
+
+my $accumulated_minutes;
+
+while (scalar @book) {
+    ## we shift through the guestbook entries processing them one by one
+
+    ## correct for clock midnight rollovers. Every vertical guestbook entry
+    ## succeeds the previous, and every OUT time succeeds that entry's IN time. We correct by adding one day in minutes.
+    if ($book[0]->{IN} < $start_time) {
+        @{$book[0]}{'IN', 'OUT'} = map { $_ + 1440 } @{$book[0]}{'IN', 'OUT'};
+    }
+    $book[0]->{OUT} += 1440 if $book[0]->{OUT} < $book[0]->{IN};
+
+    ## log the minutes and restart if this entry is outside the current window
+    if ($book[0]->{IN} > $end_time) {
+        $accumulated_minutes += $end_time - $start_time;
+        $start_time = $book[0]->{IN};
+        $end_time   = $book[0]->{OUT};
+        shift @book;
+        next;
+    }
+
+    ## increase the window as required
+    $end_time = $book[0]->{OUT} if $book[0]->{OUT} > $end_time;
+
+    ## remove the processed entry
+    shift @book;
+}
+
+## flush the current time window one last time
+$accumulated_minutes += $end_time - $start_time;
+
+say "the light was on for $accumulated_minutes minutes";
+
+## ## ## ## ## SUBS
+
+sub minutes {
+## convert hh:mm time into minutes from 00:00
+    my $time = shift;
+    $time =~ s/(\d+):(\d+)/($1 * 60) + $2/e;
+    return $time;
+}
diff --git a/challenge-039/colin-crain/perl5/ch-2.pl b/challenge-039/colin-crain/perl5/ch-2.pl
new file mode 100644
index 0000000000..15143f7f98
--- /dev/null
+++ b/challenge-039/colin-crain/perl5/ch-2.pl
@@ -0,0 +1,190 @@
+#! /opt/local/bin/perl
+#
+#       ch-2.pl
+#
+#       PWC 39 - TASK #2
+#       Write a script to demonstrate Reverse Polish notation(RPN). Checkout
+#           the wiki page for more information about RPN.
+#
+#       method: the cited wiki article provides two algorithms, one reading the
+#           expression left to right the other right to left. I implemented them
+#           both, but found the former more attractive and extensible. The right
+#           to left version is included for examination as a subroutine at the
+#           end. The operations themselves harken back to PWC #34, and here
+#           again we use a dispatch table of subroutine references to choose the
+#           different courses of action.
+#
+#           The first algorithm as written handles only binary operations, but
+#           is easily expanded to include unitary postfix operators, and so I
+#           did and added a few of those to the dispatch table. In the spirit of
+#           keeping the specific operator data, code and attributes, together,
+#           an additional level of indirection is added to the table entries as
+#           a hash, specifying the number of operands the operator requires in
+#           addition to the original code reference. This in turn led me to
+#           considering including operators that don't take any operands at all,
+#           which is one way to think about constants. Adding pi and e did
+#           require a slight patch to the splice code, as handing splice 0
+#           offset removes the the whole stack and delivers it to the dispatched
+#           function, which is certainly not what we want, rather than removing
+#           0 items from the stack. Oh well. It's rather pathological to bring
+#           up a function and then ask it to do nothing so this behavior does
+#           make sense, it's just not what we want. Simply not splicing on 0
+#           fixes this nicely. Constants are probably best substituted out
+#           before we start anyway, like macros, instead of being bits of
+#           operator code that returns only one thing no matter what, but we're
+#           getting further afield from the implementation of Reverse Polish
+#           Notation so we'll just stop here.
+#
+#           running bash here so the factorial ! needs an escape on the
+#           command line, so we match that as well as the unescaped version.
+#           It seems easier than making social cases for the shell, which doesn't
+#           have much to do with demonstrating RPN either.
+#
+#       2019 colin crain
+## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+
+
+
+use warnings;
+use strict;
+use feature ":5.26";
+
+## ## ## ## ## MAIN
+#
+# for each token in the postfix expression:
+#     if token is an operator:
+#         operand_2 ← pop from the stack
+#         operand_1 ← pop from the stack
+#         result ← evaluate token with operand_1 and operand_2
+#         push result back onto the stack
+#     else if token is an operand:
+#         push token onto the stack
+# result ← pop from the stack
+
+my $expression = shift @ARGV //      "2 7 2 3 4 + * ^ -";
+my @exp = split /\s+/, $expression;
+
+my @stack;
+
+my $dispatch = {
+    '+'     => { ops  => 2,
+                 code => sub { $_[0] + $_[1] } },
+    '-'     => { ops  => 2,
+                 code => sub { $_[0] - $_[1] } },
+    '*'     => { ops  => 2,
+                 code => sub { $_[0] * $_[1] } },
+    '/'     => { ops  => 2,
+                 code => sub { $_[0] / $_[1] } },
+    '^'     => { ops  => 2,
+                 code => sub { $_[0] ** $_[1] } },
+    'sin'   => { ops  => 1,
+                 code => sub { sin($_[0]) } },
+    'cos'   => { ops  => 1,
+                 code => sub { cos($_[0]) } },
+    'tan'   => { ops  => 1,
+                 code => sub { sin($_[0]) / cos($_[0]) } },
+    'sqrt'  => { ops  => 1,
+                 code => sub { sqrt($_[0]) } },
+    '\!'    => { ops  => 1,
+                 code => \&factorial },
+    'pi'    => { ops  => 0,
+                 code => sub { 3.14159265359 } },
+    'e'     => { ops  => 0,
+                 code => sub { 2.71828182846 } },
+};
+
+while (scalar @exp) {
+    my $token = shift @exp;
+
+    ## token is operand
+    if ($token =~ /^[\d.]+$/) {
+        push @stack, $token;
+    }
+    ## is operator
+    elsif ( exists $dispatch->{$token} ) {
+        my @operands = $dispatch->{$token}->{ops} ? splice @stack, -( $dispatch->{$token}->{ops} ) : ();
+        push @stack, $dispatch->{$token}->{code}->(@operands);
+    }
+    ## is unrecognized
+    else {
+        say "ERROR: operator $token not recognized.";
+        exit;
+    }
+}
+
+say "$expression = $stack[0]\n\n";
+
+## uncomment to see the other algorithm
+#
+#
+# r2l_rpn( $expression );
+
+
+## ## ## ## ## SUBS
+
+sub factorial {
+    my $num = shift;
+    return undef if $num < 0;
+    return 1 if $num <= 1;
+    my $out = $num;
+    while ( --$num > 1) {
+        $out *= $num;
+    }
+    return $out;
+}
+
+sub r2l_rpn {
+## implementation of a different algoritm that read the expression
+## right-to-left, or really prefix Polish Notation read left-to-right on a
+## reversal of the input token array
+##
+## This algorithm has not been extended to accept unitary operators and constants
+
+# for each token in the reversed postfix expression:
+#     if token is an operator:
+#         push token onto the operator stack
+#         pending_operand ← False
+#     else if token is an operand:
+#         operand ← token
+#         if pending_operand is True:
+#             while the operand stack is not empty:
+#                 operand_1 ← pop from the operand stack
+#                 operator ← pop from the operator stack
+#                 operand ← evaluate operator with operand_1 and operand
+#         push operand onto the operand stack
+#         pending_operand ← True
+# result ← pop from the operand stack
+
+    my $expression = shift;
+    my @exp = reverse( split /\s+/, $expression);
+
+    my @operators       = ();
+    my @stack           = ();
+    my $pending_operand = 0;
+
+    while (scalar @exp) {
+        my $token = shift @exp;
+        my ($op1, $op2);
+
+        if ( $token =~ /^[+\-*\/^]$/) {     ## token is operator
+            push @operators, $token;
+            $pending_operand = 0;
+        }
+        elsif ($token =~ /^[\d.]+$/) {      ## token is operand
+            $op1 = $token;
+            if ($pending_operand) {
+                while (scalar @stack) {
+                    $op2 = pop @stack;
+                    my $operator  = pop @operators;
+                    $op1  = $dispatch->{$operator}->{code}->($op1, $op2);
+                }
+            }
+            push @stack, $op1;
+            $pending_operand = 1;
+
+        }
+    }
+
+    say "output from right-to-left algorithm: $expression = ", pop @stack;
+
+}