This week

3 files changed, 184 insertions, 0 deletions

diff --git a/challenge-076/dave-jacoby/perl/ch-1.pl b/challenge-076/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..9b2e4cef89
--- /dev/null
+++ b/challenge-076/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ sum sum0 max };
+use Getopt::Long;
+
+my $n = 9;
+GetOptions( 'n=i' => \$n, );
+
+use JSON;
+my $json = JSON->new->space_after->canonical;
+
+my @primes = reverse grep { is_prime($_) } 2 .. $n;
+my @output = prime_sum( $n, \@primes );
+
+map { say $json->encode($_) } @output;
+say '';
+say $json->encode( $output[0] );
+
+sub prime_sum ( $n, $primes, $list = [], $depth = 1 ) {
+    my @output;
+    my %join;
+
+    my @list = ( [] );
+
+OUTER: while (@list) {
+        my $e = shift @list;
+        for my $p ( $primes->@* ) {
+            my $new->@* = reverse sort $e->@*, $p;
+            my $sum = sum $new->@*;
+            my $join = join ' ', $new->@*;
+            next if $join{$join}++;
+            push @list,   $new if $sum < $n;
+            push @output, $new if $sum == $n;
+            last OUTER if $sum == $n;
+        }
+    }
+    return @output;
+}
+
+sub is_prime ( $n ) {
+    my @factors = factor($n);
+    return scalar @factors == 1 ? 1 : 0;
+}
+
+sub factor ( $n ) {
+    my @factors;
+    for my $i ( 1 .. $n - 1 ) {
+        push @factors, $i if $n % $i == 0;
+    }
+    return @factors;
+}
diff --git a/challenge-076/dave-jacoby/perl/ch-2.pl b/challenge-076/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..7a36c770da
--- /dev/null
+++ b/challenge-076/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,109 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use Getopt::Long;
+
+my $word_grid  = 'word_grid.txt';
+my $dictionary = '/usr/share/dict/words';
+my $output     = {};
+
+GetOptions(
+    'dictionary=s' => \$dictionary,
+    'wordsearch=s' => \$word_grid,
+);
+
+my $words       = get_words($dictionary);
+my $word_search = get_word_search($word_grid);
+
+do_word_search( $word_search, $words );
+
+my $wc = scalar keys $output->%*;
+say join "\n\t", "There were $wc unique words in this word search",
+    sort keys $output->%*;
+
+sub do_word_search ( $graph, $dictionary ) {
+    my $xp = scalar $graph->@* - 1;
+    my $yp = scalar $graph->[0]->@* - 1;
+
+    for my $x ( 0 .. $xp ) {
+        for my $y ( 0 .. $yp ) {
+            my $l = $graph->[$x][$y];
+            find_word_vertical( $x + 1, $y, [$l], $graph, $dictionary );
+            find_word_horizontal( $x, $y + 1, [$l], $graph, $dictionary );
+            find_word_diagonal( $x + 1, $y + 1, [$l], $graph, $dictionary );
+            find_word_diagonal2( $x + 1, $y - 1, [$l], $graph, $dictionary );
+        }
+    }
+}
+
+sub find_word_vertical ( $x, $y, $strp, $graph, $dictionary ) {
+    my $l = $graph->[$x][$y];
+    return unless defined $l;
+    push $strp->@*, $l;
+    my $w1 = join '', $strp->@*;
+    my $w2 = join '', reverse $strp->@*;
+    $output->{$w1}++ if $dictionary->{$w1};
+    $output->{$w2}++ if $dictionary->{$w2};
+    find_word_vertical( $x + 1, $y, $strp, $graph, $dictionary );
+}
+
+sub find_word_horizontal ( $x, $y, $strp, $graph, $dictionary ) {
+    my $l = $graph->[$x][$y];
+    return unless defined $l;
+    push $strp->@*, $l;
+    my $w1 = join '', $strp->@*;
+    my $w2 = join '', reverse $strp->@*;
+    $output->{$w1}++ if $dictionary->{$w1};
+    $output->{$w2}++ if $dictionary->{$w2};
+    find_word_horizontal( $x, $y + 1, $strp, $graph, $dictionary );
+}
+
+sub find_word_diagonal ( $x, $y, $strp, $graph, $dictionary ) {
+    my $l = $graph->[$x][$y];
+    return unless defined $l;
+    push $strp->@*, $l;
+    my $w1 = join '', $strp->@*;
+    my $w2 = join '', reverse $strp->@*;
+    $output->{$w1}++ if $dictionary->{$w1};
+    $output->{$w2}++ if $dictionary->{$w2};
+    find_word_diagonal( $x + 1, $y + 1, $strp, $graph, $dictionary );
+}
+
+sub find_word_diagonal2 ( $x, $y, $strp, $graph, $dictionary ) {
+    my $l = $graph->[$x][$y];
+    return unless defined $l;
+    push $strp->@*, $l;
+    my $w1 = join '', $strp->@*;
+    my $w2 = join '', reverse $strp->@*;
+    $output->{$w1}++ if $dictionary->{$w1};
+    $output->{$w2}++ if $dictionary->{$w2};
+    find_word_diagonal( $x + 1, $y - 1, $strp, $graph, $dictionary );
+}
+
+sub get_word_search( $file ) {
+    my $ws = [];
+    if ( -f $file && open my $fh, '<', $file ) {
+        while ( my $line = <$fh> ) {
+            my @line = map { uc $_ } split /\W/, $line;
+            push $ws->@*, [@line];
+        }
+    }
+    return wantarray ? $ws->@* : $ws;
+}
+
+sub get_words ($file) {
+    my %words;
+    if ( -f $file && open my $fh, '<', $file ) {
+        while ( my $word = <$fh> ) {
+            chomp $word;
+            $word = uc $word;
+            next if $word =~ /\W/;
+            $words{$word} = 1;
+        }
+    }
+    return wantarray ? %words : \%words;
+}
diff --git a/challenge-076/dave-jacoby/perl/word_grid.txt b/challenge-076/dave-jacoby/perl/word_grid.txt
new file mode 100644
index 0000000000..c5766eae93
--- /dev/null
+++ b/challenge-076/dave-jacoby/perl/word_grid.txt
@@ -0,0 +1,19 @@
+B I D E M I A T S U C C O R S T
+L D E G G I W Q H O D E E H D P
+U S E I R U B U T E A S L A G U
+N G N I Z I L A I C O S C N U D
+T G M I D S T S A R A R E I F G
+S R E N M D C H A S I V E E L I
+S C S H A E U E B R O A D M T E
+H W O V L P E D D L A I U L S S
+R Y O N L A S F C S T A O G O T
+I G U S S R R U G O V A R Y O C
+N R G P A T N A N G I L A M O O
+E I H A C E I V I R U S E S E D
+S E T S U D T T G A R L I C N H
+H V R M X L W I U M S N S O T B
+A E A O F I L C H T O D C A E U
+Z S C D F E C A A I I R L N R F
+A R I I A N Y U T O O O U T P F
+R S E C I S N A B O S C N E R A
+D R S M P C U U N E L T E S I L
\ No newline at end of file