Merge pull request #5972 from jacoby/master

Challenge 161 - Dave's Solution

3 files changed, 136 insertions, 0 deletions

diff --git a/challenge-161/dave-jacoby/blog.txt b/challenge-161/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..ab3bd23e3a
--- /dev/null
+++ b/challenge-161/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2022/04/18/the-lazy-dog-had-it-coming-weekly-challege-161.html
diff --git a/challenge-161/dave-jacoby/perl/ch-1.pl b/challenge-161/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..6827195778
--- /dev/null
+++ b/challenge-161/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+# Accept chintz effort
+
+my @dict = get_dict();
+say join "\n", sort { length $b <=> length $a }
+    grep { is_abecedarian($_) } @dict;
+
+sub is_abecedarian ( $word ) {
+    my $dorw = join '', sort { lc $a cmp lc $b } split //, $word;
+    return $dorw eq $word ? 1 : 0;
+}
+
+sub get_dict() {
+    if ( open my $fh, '<', 'dictionary.txt' ) {
+        my @output;
+        while ( my $word = <$fh> ) {
+            chomp $word;
+            push @output, $word;
+        }
+        return @output;
+    }
+    exit;
+}
+
diff --git a/challenge-161/dave-jacoby/perl/ch-2.pl b/challenge-161/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..04269c8c08
--- /dev/null
+++ b/challenge-161/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Compare;
+use List::Util qw{ uniq };
+
+my @dict = get_dict();
+
+# maybe flag to enable this filter?
+@dict = grep { is_abecedarian($_) } @dict;
+
+sub is_abecedarian ( $word ) {
+    my $dorw = join '', sort { lc $a cmp lc $b } split //, $word;
+    return $dorw eq $word ? 1 : 0;
+}
+
+my $pangram = get_pangram( \@dict );
+say $pangram;
+
+sub get_pangram ( $wordlist, $gram = '' ) {
+    $gram =~ s/^\s//mix;
+    my $test = join '', ' ', 'a' .. 'z';
+    my %letters;
+    for my $l ( split //, lc $gram ) { $letters{$l} = 1; }
+    my $sheet = join '', sort keys %letters;
+    return $gram if $test eq join '', sort keys %letters;
+
+    my @gram = split //, $gram;
+
+    ## wrecker yard of abandoned sorts
+    # for my $next ( sort { rand 1 <=> rand 1 } $wordlist->@* ) {
+    # for my $next ( sort { length $a <=> length $b } $wordlist->@* ) {
+    # sort { ronly_size( $gram, $a ) <=> ronly_size( $gram, $b ) }
+    # sort { lonly_size( $gram, $b ) <=> lonly_size( $gram, $a ) }
+    # sort { length $a <=> length $b }
+    # sort {
+    #     ronly_minus_lonly( $gram, $a ) <=> ronly_minus_lonly( $gram, $b )
+    # }
+    # sort { rand 1 <=> rand 1 }
+
+    # prefering short words to long
+    for my $next ( sort { length $a <=> length $b } $wordlist->@* ) {
+
+    # for my $next (
+    #     sort {
+    #         ronly_minus_lonly( $gram, $a ) <=> ronly_minus_lonly( $gram, $b )
+    #     } $wordlist->@*
+    #     )
+    # {
+        my @next = split //, $next;
+        my $lc   = List::Compare->new( \@gram, \@next );
+        my @comp = $lc->get_Ronly; 
+        if ( scalar @comp ) {
+            return get_pangram( $wordlist, join ' ', $gram, $next );
+        }
+    }
+
+    # Sir, the impossible scenario we never planned for?
+    # Well, we better come up with a plan.
+    return 'SHOULD NEVER RETURN';
+}
+
+# functions for size of left_only, size of right_only, and a 
+# difference that should prioritize new words
+
+sub ronly_minus_lonly ( $w1, $w2 ) {
+    my $lonly = lonly_size( $w1, $w2 );
+    my $ronly = ronly_size( $w1, $w2 );
+    return $ronly - $lonly;
+}
+
+sub lonly_size ( $w1, $w2 ) {
+    my @w1 = uniq sort split //, lc $w1;
+    my @w2 = uniq sort split //, lc $w2;
+    my $lc = List::Compare->new( \@w1, \@w2 );
+    return scalar $lc->get_Lonly;
+}
+
+# in usage, w1 is the attempted pangram and w2 is the word
+# being considered. List::Compare takes two lists (duh)
+# and gives many tools to compare them. Ronly is right-only,
+# so, given arrays of letters, this returns the count of letters
+# that only exist in the right one, so we would prefer to add 
+# words with a high Ronly count.
+sub ronly_size ( $w1, $w2 ) {
+    my @w1 = uniq sort split //, lc $w1;
+    my @w2 = uniq sort split //, lc $w2;
+    my $lc = List::Compare->new( \@w1, \@w2 );
+    return scalar $lc->get_Ronly;
+}
+
+sub get_dict() {
+    if ( open my $fh, '<', 'dictionary.txt' ) {
+        my @output;
+        while ( my $word = <$fh> ) {
+            chomp $word;
+            push @output, $word;
+        }
+        return @output;
+    }
+    exit;
+}
+