Challenge 67

2 files changed, 139 insertions, 0 deletions

diff --git a/challenge-067/dave-jacoby/perl/ch-1.pl b/challenge-067/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..0a67daafa6
--- /dev/null
+++ b/challenge-067/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+use Getopt::Long;
+use JSON;
+
+my $json = JSON->new;
+
+my ( $m, $n ) = ( 5, 2 );
+GetOptions(
+    'm=i' => \$m,
+    'n=i' => \$n,
+);
+
+my $output = number_combos( $m, $n );
+
+say $json->encode($output);
+
+exit;
+
+# I use default values in subroutine signaturs
+# so that I can call without arguments and get
+# the results in the description
+sub number_combos ( $m = 5, $n = 2 ) {
+
+    # whenever I find a language where ranges are
+    # difficult, I miss Perl's ..
+    my @array = 1 .. $m;
+    my @output = _number_combos( $n, '', \@array );
+
+    # I *could* just return _number_combos(), but I
+    # like being able to output to an array or arrayref
+    # depending on what I'm doing. wantarray is your friend.
+    return wantarray ? @output : \@output;
+}
+
+# I did some testing where $m > 9, and then, you're 
+# adding two-digit numbers to the array, which means
+# you could have a conceptual two-digit number that's
+# really a three-digit number. '9,10' becomes 910, and 
+# we're tossing that out
+sub _number_combos ( $length, $string, $m_arr ) {
+    my @output;
+    if ( length $string > $length )  { return }
+    if ( length $string == $length ) { return $string }
+
+    # for as many times as we have elements in the array,
+    #   we shift the first digit
+    #   concatenate it to the string and recall _number_combos
+    #   push the output into array
+    #   push that first digit onto the end of the array
+    # and go again
+    for ( 1 .. scalar $m_arr->@* ) {
+        my $l = shift $m_arr->@*;
+        push @output, _number_combos( $length, $string . $l, $m_arr );
+        push $m_arr->@*, $l;
+    }
+    return wantarray ? @output : \@output;
+}
diff --git a/challenge-067/dave-jacoby/perl/ch-2.pl b/challenge-067/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..86916f2f2d
--- /dev/null
+++ b/challenge-067/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+use Carp;
+use Getopt::Long;
+use JSON;
+use List::Util qw{ uniq };
+
+my $json = JSON->new->pretty->canonical;
+
+my $phone = '35'; 
+GetOptions( 'phone=i' => \$phone )
+  or croak 'bad number';
+
+my $ref = letter_phone($phone);
+say $json->encode($ref);
+exit;
+
+# this one DOESN'T look like a job for recursion!
+# well, maybe it does. I could easily have done 
+# something similar to the other task, but I didn't
+sub letter_phone ( $number ) {
+    state $numbers = get_numbers();
+
+    # we add an empty string so that something exists
+    # for the $s loop to work on
+    my @ref;
+    push @ref, '';
+
+    for my $i ( 0 .. -1 + length $number ) {
+
+        # $i is a position in the string
+        # $n is the digit in place $i
+        # @arr is the list of letters corresponding 
+        #   to that digit
+        # @new is the array we fill with the 
+        #   results of concatenation
+        my $n   = substr( $number, $i, 1 );
+        my @arr = $numbers->{$n}->@*;
+        my @new;
+        for my $s (@ref) {
+            for my $t (@arr) {
+                push @new, $s . $t;
+            }
+        }
+        @ref = @new;
+    }
+    return wantarray ? @ref : \@ref;
+}
+
+# this is separated from letter_phone so that 
+# we don't have this big thing taking up space 
+# in that function.
+# and we're promised numbers, so I am not going
+# to add # nd * to the hash.
+sub get_numbers() {
+    my $ref = {};
+    no warnings;
+    push $ref->{0}->@*, q{};
+    push $ref->{1}->@*, qw{ _ , @ };
+    push $ref->{2}->@*, qw{ A B C };
+    push $ref->{3}->@*, qw{ D E F };
+    push $ref->{4}->@*, qw{ G H I };
+    push $ref->{5}->@*, qw{ J K L };
+    push $ref->{6}->@*, qw{ M N O };
+    push $ref->{7}->@*, qw{ P Q R S };
+    push $ref->{8}->@*, qw{ T U V };
+    push $ref->{9}->@*, qw{ W X Y Z };
+    return $ref;
+}