- Added solutions by Dave Jacoby.

4 files changed, 123 insertions, 0 deletions

diff --git a/challenge-007/dave-jacoby/blog.txt b/challenge-007/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..c74d2b8d26
--- /dev/null
+++ b/challenge-007/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io//2019/05/06/niven-numbers-in-perl-and-javascript.html
diff --git a/challenge-007/dave-jacoby/blog1.txt b/challenge-007/dave-jacoby/blog1.txt
new file mode 100644
index 0000000000..846290d6b7
--- /dev/null
+++ b/challenge-007/dave-jacoby/blog1.txt
@@ -0,0 +1 @@
+https://jacoby.github.io//2019/05/06/rethinking-my-ladder-puzzle-code.html
diff --git a/challenge-007/dave-jacoby/perl5/ch-1.pl b/challenge-007/dave-jacoby/perl5/ch-1.pl
new file mode 100644
index 0000000000..4d38d9c307
--- /dev/null
+++ b/challenge-007/dave-jacoby/perl5/ch-1.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+
+use feature qw{ say };
+use strict;
+use warnings;
+
+use List::Util qw{sum};
+
+for my $i ( 1 .. 50 ) {
+    my @j = split //, $i; # split the number into characters
+    my $k = sum @j;       # Perl doesn't overload operators,
+                          # but overloads types, so if you do
+                          # a math operation on a scalar, it
+                          # finds the most number-like
+                          # interpretation of that scalar
+
+    my $l = $i % $k == 0; # true if it divides evenly.
+    say $i if $l;         # say if true
+                          # we COULD combine these two
+}
+
diff --git a/challenge-007/dave-jacoby/perl5/ch-2.pl b/challenge-007/dave-jacoby/perl5/ch-2.pl
new file mode 100644
index 0000000000..2952130a94
--- /dev/null
+++ b/challenge-007/dave-jacoby/perl5/ch-2.pl
@@ -0,0 +1,100 @@
+#!/usr/bin/env perl
+
+use feature qw{say} ;
+use strict ;
+use warnings ;
+
+use Carp ;
+use Data::Dumper ;
+use Graph ;
+use List::Util qw{min} ;
+use Storable ;
+
+my ( $first, $second ) = map { s/\W//gmix ; $_ }
+    map { uc $_ } @ARGV ;
+my $l = length $first ;
+
+my $g = get_word_graph($l) ;
+croak 'Words have different lengths' if length $first != length $second ;
+croak "'$first' not in graph" unless $g->has_vertex($first);
+croak "'$second' not in graph" unless $g->has_vertex($second);
+
+my $r = dijkstra( $g, $first, $second ) ;
+my @s = retrieve_solution( $r, $first, $second ) ;
+
+say join ' > ', @s ;
+say '' ;
+
+exit ;
+
+# -------------------------------------------------------------------
+# context-specific perl implementation of Dijkstra's Algorithm for
+# shortest-path
+sub dijkstra {
+    my ( $graph, $source, $target, ) = @_ ;
+    my @q ;
+    my %dist ;
+    my %prev ;
+    for my $v ( $graph->unique_vertices ) {
+        $dist{$v} = 1_000_000_000 ;    # per Wikipeia, infinity
+        push @q, $v ;
+        }
+    $dist{$source} = 0 ;
+LOOP: while (@q) {
+        @q = sort { $dist{$a} <=> $dist{$b} } @q ;
+        my $u = shift @q ;
+
+        # say STDERR join "\t", $u, $dist{$u} ;
+        last LOOP if $u eq $target ;
+        for my $e (
+            grep {
+                my @a = @$_ ;
+                grep {/^${u}$/} @a
+            } $graph->unique_edges
+            ) {
+            my ($v) = grep { $_ ne $u } @$e ;
+            my $w   = 1 ;
+            my $alt = $dist{$u} + $w ;
+            if ( $alt < $dist{$v} ) {
+                $dist{$v} = $alt ;
+                $prev{$v} = $u ;
+                }
+            }
+        }
+    my @nodes = $graph->unique_vertices ;
+    my @edges = $graph->unique_edges ;
+    return {
+        distances => \%dist,
+        previous  => \%prev,
+        nodes     => \@nodes,
+        edges     => \@edges,
+        } ;
+    }
+
+# -------------------------------------------------------------------
+sub retrieve_solution {
+    my $r     = shift ;
+    my $start = shift ;
+    my $end   = shift ;
+    my %prev  = %{ $r->{previous} } ;
+
+    my @words ;
+    push @words, $end ;
+    my $next = $end ;
+    while ( $next ne $start ) {
+        $next = $prev{$next} ;
+        push @words, $next ;
+        }
+    return wantarray ? @words : \@words ;
+    }
+
+# -------------------------------------------------------------------
+sub get_word_graph {
+    my $length = shift ;
+    # this is SLIGHTLY more localized
+    my $file   = $ENV{HOME} ."/.word_$length.store" ;
+    croak 'File not available' unless -f $file ;
+    my $g = retrieve($file) ;
+    return $g ;
+    }
+