Excel Columns AND Variations

2 files changed, 119 insertions, 0 deletions

diff --git a/challenge-060/dave-jacoby/perl/ch-1.pl b/challenge-060/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..955bff5805
--- /dev/null
+++ b/challenge-060/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!/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 JSON;
+my $json = JSON->new->pretty->canonical;
+
+my $all = all_excel();
+my $lla->%* = reverse $all->%*;
+
+my %alpha = map { state $c = 0; $c++ => $_ } 'A' .. 'Z';
+my %ahpla = reverse %alpha;
+
+for my $i ( sort { $a <=> $b } 1 .. 40, 100, 1000, 10000 ) {
+    my $e   = to_excel_col1($i);
+    my $r   = from_excel_col1($e);
+    my $ch1 = $all->{$i};
+    my $ch2 = $lla->{$e};
+    say join "\t", '--', $i, $e, $r, '', $ch1, $ch2;
+}
+
+# first row is different, because instructions assume
+# we start with row 1, but things become so much easier
+# with a zero index
+sub to_excel_col1 ( $i, $f = 0 ) {
+    $i = int $i;
+    croak 'out of range' if $i < 0 || $i > 16384;
+    croak 'out of range' if $i == 0 && $f == 0;
+    $i -= 1 unless $f;
+
+    my $mod = $i % 26;
+    my $num = int $i / 26;
+    my $l   = $f ? $alpha{ $mod - 1 } : $alpha{$mod};
+
+    return join '', to_excel_col1( $num, 1 ), $l if $num > 0;
+    return $l;
+}
+
+sub from_excel_col1 ( $c, $f = 0 ) {
+    $c =~ s/\W//g;
+    $c = uc $c;
+    my @c = split //, $c;
+    my $o = 0;
+    my $l = pop @c;
+    my $v = $ahpla{$l};
+    !$f && $v++;
+    $o += $v;
+
+    if ( scalar @c ) {
+        my $d = join '', @c;
+        my $e = from_excel_col1( $d, 1 );
+        $o += 26 * ( 1 + $e );
+    }
+    return $o;
+}
+
+sub all_excel () {
+    my $done   = {};
+    my $output = {};
+    my $key    = 1;
+    for my $i ( '', 'A' .. 'Z' ) {
+        for my $j ( '', 'A' .. 'Z' ) {
+            for my $k ( 'A' .. 'Z' ) {
+                my $col = join '', $i, $j, $k;
+                next if $done->{$col}++;
+
+                # say join ' ', $col, $key;
+                $output->{$key} = $col;
+                $key++;
+            }
+        }
+    }
+
+    # exit;
+    return $output;
+}
diff --git a/challenge-060/dave-jacoby/perl/ch-2.pl b/challenge-060/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..d931926de8
--- /dev/null
+++ b/challenge-060/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+my ( $x, $y, @l ) = grep { $_ >= 0 } map { int $_ } @ARGV;
+$x //= 2;
+$y //= 21;
+@l = ( 0, 1, 2, 5 ) unless scalar @l;
+
+say qq{X: $x };
+say qq{Y: $y };
+say q{L: } . join ', ', @l;
+
+my @vars = get_variations( \@l, $x );
+say qq{All variations of length $x:\n\t} . join ", ", @vars;
+
+@vars = get_lt_variations( \@l, $x, $y );
+say qq{All variations of length $x that are < $y:\n\t} . join ", ", @vars;
+exit;
+
+sub get_lt_variations ( $arrayref, $x, $y ) {
+    return grep { $x == length $_ && $_ < $y } get_variations( $arrayref, $x );
+}
+
+sub get_variations ( $arrayref, $depth ) {
+    my $output = [];
+    return $arrayref->@* if $depth <= 1;
+    for my $i ( 0 .. -1 + scalar $arrayref->@* ) {
+        my $s = $arrayref->[$i];
+        push $output->@*,
+          map { int $s . $_ } get_variations( $arrayref, $depth - 1 );
+    }
+    return $output->@*;
+}