Merge pull request #1051 from rjt-pl/rjt_039

rjt's Week 39 solutions and blog

5 files changed, 248 insertions, 0 deletions

diff --git a/challenge-039/ryan-thompson/blog.txt b/challenge-039/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..de1921695d
--- /dev/null
+++ b/challenge-039/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2019/12/reverse-polish-notation/
diff --git a/challenge-039/ryan-thompson/perl5/ch-1.pl b/challenge-039/ryan-thompson/perl5/ch-1.pl
new file mode 100755
index 0000000000..3f1198ab28
--- /dev/null
+++ b/challenge-039/ryan-thompson/perl5/ch-1.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Light tracker
+#
+# Ryan Thompson <rjt@cpan.org>
+#
+# Assumption: All times are in the same 00:00 - 23:59 day
+
+use 5.010;
+use warnings;
+use strict;
+
+my %on; # Minutes during which the lights were definitely on
+
+for (<DATA>) {
+    # I'll demonstrate a full parse, here, but you could also
+    # do with a much simpler regex or even split in this case.
+    /^\s*
+        \d+\)\s+                             # Line number
+        (?<who>    \w+)\s+                   # Guest's name
+        IN: \s+
+        (?<in_hh>  \d\d):(?<in_mm>  \d\d)\s+ # Time in
+        OUT:\s+
+        (?<out_hh> \d\d):(?<out_mm> \d\d)\s* # Time out
+    $/x or die "Invalid input format: $_";
+
+    my $in_min  = $+{in_hh}  * 60 + $+{in_mm};
+    my $out_min = $+{out_hh} * 60 + $+{out_mm};
+
+    $on{$_}++ for $in_min .. $out_min;
+}
+
+say scalar keys %on;
+
+__DATA__
+0) Ryan    IN: 03:25 OUT: 04:20
+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
diff --git a/challenge-039/ryan-thompson/perl5/ch-2.pl b/challenge-039/ryan-thompson/perl5/ch-2.pl
new file mode 100755
index 0000000000..1acaf85e30
--- /dev/null
+++ b/challenge-039/ryan-thompson/perl5/ch-2.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Extensible RPN calculator
+#
+# Usage: ch-2.pl '5 r= 2 r ^ 4 ×' # Calculate area of circle with r=5
+#        ch-2.pl 'π cos'          # Calculate cos(π)
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+use Scalar::Util 'looks_like_number'; # Core
+
+# Support UTF8 on output, input (@ARGV), and within the source itself
+binmode STDOUT,    ':utf8';
+binmode STDERR,    ':utf8';
+use Encode   'decode_utf8';
+@ARGV = map { decode_utf8($_, 1) } @ARGV;
+use utf8;
+
+my @stack;  # RPN stack
+my %op;     # Operators dispatch
+my %vars;   # User-defined namespace
+
+# Convenience subs to install operations with commonly desired arity
+sub nullary(&$) { my ($code, $op) = @_; op_install($code, $op, 0) }
+sub   unary(&$) { my ($code, $op) = @_; op_install($code, $op, 1) }
+sub  binary(&$) { my ($code, $op) = @_; op_install($code, $op, 2) }
+
+# Install binary and unary operators.
+# Easy to add more.
+binary { $_[0] + $_[1] } '+';
+binary { $_[0] - $_[1] } '-';
+binary { $_[0] * $_[1] } '*';
+binary { $_[0] / $_[1] } '/';
+binary { $_[0] **$_[1] } '^';
+binary { $_[0] % $_[1] } '%';
+unary  { }               'pop';
+
+unary  { my $n = 1; $n *= $_ for 1..pop; $n } '!';
+unary  { sin($_[0]) / cos($_[0]) } 'tan';
+unary \&CORE::sin, 'sin';
+unary \&CORE::cos, 'cos';
+unary \&CORE::abs, 'abs';
+unary { 1 / pop }  'inv';
+unary { - pop   }  'neg';
+
+# Constants are effectively nullary operators
+nullary { 3.14159265359 } 'π';
+
+# OK, now we're just showing off... 5 x= assigns the value 5 to variable x
+for my $var ('a'..'z') {
+    unary   { $vars{$var} = $_[0]; return () } "$var=";
+    nullary { $vars{$var} }              $var;
+}
+
+# Aliases are trivially supported
+$op{'×'} = $op{'*'};
+$op{'÷'} = $op{'/'};
+$op{'−'} = $op{'-'};
+$op{mod} = $op{'%'}; # Whatever you like.
+$op{Pi}  = $op{'π'};
+
+die "Usage: $0 'atom ...'\nOperators: @{[ sort keys %op ]}\n" unless @ARGV;
+
+# The main loop is just a lookup in our dispatch table
+for ( map { split } @ARGV ) {
+    push @stack, looks_like_number($_) ? $_
+               :        exists $op{$_} ? $op{$_}->()
+               : die "Unknown operator: `$_'\n";
+}
+
+die "Too many values left on stack: <" . join(',',@stack) .">" if @stack > 1;
+say @stack;
+
+# A generic installer that supports any arity. Called by nullary(),
+# unary(), and binary(), but can be used on its own if need be.
+sub op_install {
+    my ($code, $op, $arity) = @_;
+    $op{$op} = sub {
+        die "Stack: @{[ 0+@stack ]} < $arity" if @stack < $arity;
+        my @operands;
+        push @operands, pop @stack for 1..$arity;
+        $code->(@operands);
+    }
+}
diff --git a/challenge-039/ryan-thompson/perl6/ch-1.p6 b/challenge-039/ryan-thompson/perl6/ch-1.p6
new file mode 100644
index 0000000000..832aac5f83
--- /dev/null
+++ b/challenge-039/ryan-thompson/perl6/ch-1.p6
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl6
+
+# ch-1.p6 - Light tracker, with grammars because why not
+#
+# Ryan Thompson <rjt@cpan.org>
+
+#| Grammar for one of the data-lines()
+grammar TimeData {
+    rule  TOP   { <num> ")" <who> "IN:" <time> "OUT:" <time> }
+    token num   { \d+   }
+    token who   { \w+   }
+    token hh    { 0\d | 1 <[012]> }
+    token mm    { <[0..5]> \d     }
+    token time  { <hh> ":" <mm>   }
+}
+
+sub MAIN() {
+    my %on is SetHash; # Minutes when the light was on
+
+    for (DATA().lines) {
+        my $parse = TimeData.parse($_) or next;
+        my ($in, $out) = $parse<time>.list;
+
+        %on{ minutes($in) .. minutes($out) }»++;
+    }
+
+    say %on.elems;
+}
+
+#| Convert $time<hh mm> hash to minutes since midnight
+sub minutes( TimeData $time ) { $time<hh> * 60 + $time<mm> }
+
+#| Input data
+sub DATA() {
+    q:to/END_RAW/,
+        0) Ryan    IN: 03:25 OUT: 04:20
+        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
+        END_RAW
+}
diff --git a/challenge-039/ryan-thompson/perl6/ch-2.p6 b/challenge-039/ryan-thompson/perl6/ch-2.p6
new file mode 100644
index 0000000000..6992d1de5f
--- /dev/null
+++ b/challenge-039/ryan-thompson/perl6/ch-2.p6
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl6
+
+# ch-2.p6 - Raku-flavoured RPN calculator
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use v6.d;
+
+my @stack;                #| RPN stack
+my %op = gen-op-dispatch; #| Operators dispatch table
+my %var;                  #| User variables a..z
+
+#| Simple main loop lets %op do all the heavy lifting
+sub MAIN( Str $rpn-expr ) {
+    for $rpn-expr.words -> $tok {
+        if $tok.Numeric { @stack.push( $tok ) }
+        else {
+            die "Unknown operator ｢$tok｣" if %op{$tok}:!exists;
+            %op{$tok}.()
+        }
+    }
+
+    say |@stack;
+}
+
+#| Generate the complete operator dispatch table. Easy to extend!
+#  I'll show a few ways to specify operators.
+sub gen-op-dispatch( --> Hash ) {
+    my Code %op = (
+       '+'  => op-gen( { $^a + $^b } ); # Binary
+       '-'  => op-gen( { $^a - $^b } );
+       '/'  => op-gen( { $^a / $^b } );
+       '*'  => op-gen( { $^a * $^b } );
+      'abs' => op-gen( { $^a.abs   } );
+
+       '!'  => op-gen( {[*] 1..$^a } ); # Unary
+      'pop' => op-gen( sub ($x) {()} );
+
+      'Pi'  => op-gen( { 3.1415926 } ); # Nullary
+    );
+
+    %op<π>  = %op<Pi>;                  # Aliases
+    %op<×>  = %op<*>;
+    %op<÷>  = %op</>;
+    %op<−>  = %op<->;
+
+    # v6.d supports the use of junctions as hash keys, so this works, too:
+    %op{"^"|"**"}  = op-gen( { $^a ** $^b } );
+    %op{"%"|"mod"} = op-gen( { $^a %  $^b } );
+
+    # We can support user variables with two lines of code:
+    %op{"$_="}     = op-gen( { %var{$_} = $^a; () } ) for 'a'..'z';
+    %op{ $_  }     = op-gen( { %var{$_}           } ) for 'a'..'z';
+
+    return %op;
+}
+
+#| Generate an operator and return a Code object that can be added to %op
+#  We introspect &code.arity to know how many @operands to pop off the @stack
+sub op-gen( &code --> Code ) {
+    sub () {
+        die "Stack: {@stack.elems} < {&code.arity}" if @stack < &code.arity;
+        my @operands;
+        @operands.push: @stack.pop for 1..&code.arity;
+        @stack.push: |code( |@operands );
+    }
+}