Merge pull request #2247 from boblied/master

Solution to 076 Task 2, Word Search

7 files changed, 329 insertions, 63 deletions

diff --git a/challenge-076/bob-lied/perl/ch-2.pl b/challenge-076/bob-lied/perl/ch-2.pl
index 6a1a88fe38..3f9acd09bd 100755
--- a/challenge-076/bob-lied/perl/ch-2.pl
+++ b/challenge-076/bob-lied/perl/ch-2.pl
@@ -5,27 +5,52 @@
 #=============================================================================
 # Copyright (c) 2020, Bob Lied
 #=============================================================================
-# Perl Weekly Challenge 000 Task #2 > xxx
+# Perl Weekly Challenge 076 Task #2 > Word Search
+# Write a script that takes two file names.  The first file would contain word
+# search grid as shown below.  The second file contains list of words, one
+# word per line.  You could even use local dictionary file.
+#
+# Print out a list of all words seen on the grid, looking both orthogonally
+# and diagonally, backwards as well as forwards.
 #=============================================================================
 
 use strict;
 use warnings;
 use v5.30;
 
-us feature qw/ signatures /;
+use feature qw/ signatures /;
 no warnings qw/ experimental::signatures /;
 
+use Getopt::Long;
+
 use lib "lib";
-use Task2;
+use WordSearch;
+
+sub Usage { "Usage: $0 [-l min-length] grid-file wordlist-file" };
+
+my $MinLength = 5;
+my $Verbose = 0;
+GetOptions('length=i' => \$MinLength, "verbose!" => \$Verbose);
+
+my $gridFile = shift;
+my $wordlistFile = shift;
+
+die Usage() unless $gridFile && $wordlistFile;
+die ( Usage(). " $!" ) unless -r $gridFile;
+die ( Usage(). " $!" ) unless -r $wordlistFile;
 
-sub Usage { "Usage: $0 args" };
+die Usage() unless ( $MinLength > 0 && $MinLength < 50 );
 
-my $arg = shift;
-my @list = @ARGV;
+my $wordsearch = WordSearch->new();
+$wordsearch->loadGrid($gridFile);
+$wordsearch->loadWordlist($wordlistFile, $MinLength);
 
-die Usage() unless $arg;
-die Usage() unless @list;
+my $result = $wordsearch->run();
 
-my $task = Task2->new();
-my $result = task->run();
-say $result;
+my $count = $wordsearch->numFound();
+my $foundList = $wordsearch->foundList();
+say "Found $count words of length $MinLength or longer";
+if ( $Verbose )
+{
+    say "[" . ($_+1) ."] $foundList->[$_]" for 0 .. $count-1;
+}
diff --git a/challenge-076/bob-lied/perl/lib/Task2.pm b/challenge-076/bob-lied/perl/lib/Task2.pm
deleted file mode 100644
index e210edb216..0000000000
--- a/challenge-076/bob-lied/perl/lib/Task2.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
-#=============================================================================
-# Task2.pm
-#=============================================================================
-# Copyright (c) 2020, Bob Lied
-#=============================================================================
-# Description:
-#=============================================================================
-
-package Task2;
-
-use strict;
-use warnings;
-
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw();
-our @EXPORT_OK = qw();
-
-sub new
-{
-    my $class = shift;
-    $class = ref($class) || $class;
-    my $self = {
-        _name1 => $_[0],
-    };
-    bless $self, $class;
-    return $self;
-}
-
-sub run
-{
-    my $self = shift;
-    return undef;
-}
-
-1;
-
diff --git a/challenge-076/bob-lied/perl/lib/WordSearch.pm b/challenge-076/bob-lied/perl/lib/WordSearch.pm
new file mode 100644
index 0000000000..7d03abdfca
--- /dev/null
+++ b/challenge-076/bob-lied/perl/lib/WordSearch.pm
@@ -0,0 +1,191 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# WordSearch.pm
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Description:
+#=============================================================================
+
+package WordSearch;
+
+use strict;
+use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use File::Slurper qw / read_lines /;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw();
+our @EXPORT_OK = qw();
+
+sub new($class)
+{
+    $class = ref($class) || $class;
+    my $self = {
+        _grid => [],
+        _wordlist => [],
+        _lastRow => 0,
+        _lastCol => 0,
+
+        _numFound => 0,
+        _foundList => [],
+    };
+    bless $self, $class;
+    return $self;
+}
+
+sub loadGrid($self, $gridFile)
+{
+    my @g = read_lines($gridFile);
+    for my $row ( 0 .. $#g )
+    {
+        (my @chars) = split(" ", $g[$row]);
+        for my $col ( 0 .. $#chars )
+        {
+            $self->{_grid}->[$row][$col] = lc($chars[$col]);
+        }
+    }
+    $self->{_lastRow} = scalar( @{$self->{_grid}} ) - 1;
+    $self->{_lastCol} = scalar( @{$self->{_grid}->[0]} ) - 1;
+    return $self;
+}
+
+sub loadWordlist($self, $wordlistFile, $minLength)
+{
+    my @wl = map { lc } grep { length($_) >= $minLength } read_lines($wordlistFile);
+    $self->{_wordlist} = \@wl;
+    return $self;
+}
+
+sub numFound($self)
+{
+    return $self->{_numFound};
+}
+
+sub foundList($self)
+{
+    return $self->{_foundList}
+}
+
+sub _horizontal($self)
+{
+    my @list;
+    my $g = $self->{_grid};
+
+    for my $row ( 0 .. $self->{_lastRow} )
+    {
+        my $s = join('', @{$g->[$row]});
+        push @list, $s, scalar(reverse($s));
+    }
+    return \@list;
+}
+
+sub _vertical($self)
+{
+    my @list;
+    my $g = $self->{_grid};
+
+    for my $col ( 0 .. $self->{_lastCol} )
+    {
+        my @column = map { $g->[$_][$col] } 0 .. $self->{_lastRow};
+        my $s = join('', @column);
+        push @list, $s, scalar(reverse($s));
+    }
+    return \@list;
+}
+
+sub _diagonal($self)
+{
+    my @list;
+    my $g = $self->{_grid};
+    my $lastRow = $self->{_lastRow};
+    my $lastCol = $self->{_lastCol};
+
+    # Top left to bottom right along the left edge
+    for my $row ( 0 .. $lastRow )
+    {
+        my $s;
+        my ($r, $c);
+        for ( $r = $row, $c = 0; $r <= $lastRow && $c <= $lastCol ; $r++, $c++ )
+        {
+            $s .= $g->[$r][$c];
+        }
+        push @list, $s, scalar(reverse($s));
+    }
+
+    # Top left to bottom right along the top edge
+    for my $col ( 1 .. $self->{_lastCol} ) #
+    {
+        my $s;
+        my ($r, $c);
+        for ( $r = 0, $c = $col; $r <= $lastRow && $c <= $lastCol ; $r++, $c++ )
+        {
+            $s .= $g->[$r][$c];
+        }
+        push @list, $s, scalar(reverse($s));
+    }
+
+    # Bottom left to top right along left edge
+    for ( my $row = $lastRow; $row >= 0; $row-- )
+    {
+        my $s;
+        my ($r, $c);
+        for ( $r = $row, $c = 0; $r >= 0 && $c <= $lastCol; $r--, $c++ )
+        {
+            $s .= $g->[$r][$c];
+        }
+        push @list, $s, scalar(reverse($s));
+    }
+
+    # Bottom left to top right along the bottom edge
+    for my $col ( 1 .. $lastCol )
+    {
+        my $s;
+        my ($r, $c);
+        for ( $r = $lastRow, $c = $col; $r >= 0 && $c <= $lastCol ; $r--, $c++ )
+        {
+            $s .= $g->[$r][$c];
+        }
+        push @list, $s, scalar(reverse($s));
+    }
+    return \@list;
+}
+
+sub _find($self, $str)
+{
+    my $count = 0;
+    my @found;
+    for my $word ( @{$self->{_wordlist}} )
+    {
+        # Is RE faster than index?
+        if ( index($str, $word) != -1 )
+        {
+            $count++;
+            push @found, $word;
+        }
+    }
+    $self->{_foundList} = \@found;
+
+    return $self->{_numFound} = $count;
+}
+
+
+sub run($self)
+{
+    my $h = $self->_horizontal();
+    my $v = $self->_vertical();
+    my $d = $self->_diagonal();
+
+    # Combine all the strings with a non-word character to separate
+    # them so that we need only one search per word.
+    my $all = join('.', @$h, @$v, @$d);
+    return $self->_find($all);
+}
+
+1;
+
diff --git a/challenge-076/bob-lied/perl/t/Task2.t b/challenge-076/bob-lied/perl/t/Task2.t
deleted file mode 100644
index ffb1db7c8d..0000000000
--- a/challenge-076/bob-lied/perl/t/Task2.t
+++ /dev/null
@@ -1,14 +0,0 @@
-# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
-#
-#===============================================================================
-# FILE: Task2.t
-# DESCRIPTION: Unit test for Task2
-#===============================================================================
-
-use strict;
-use warnings;
-use v5.30;
-
-use Test2::V0;
-
-done_testing();
diff --git a/challenge-076/bob-lied/perl/t/WordSearch.t b/challenge-076/bob-lied/perl/t/WordSearch.t
new file mode 100644
index 0000000000..7e1320a7ae
--- /dev/null
+++ b/challenge-076/bob-lied/perl/t/WordSearch.t
@@ -0,0 +1,29 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#
+#===============================================================================
+# FILE: WordSearch.t
+# DESCRIPTION: Unit test for WordSearch
+#===============================================================================
+
+use strict;
+use warnings;
+use v5.30;
+
+use Test2::V0;
+
+use WordSearch;
+
+my $ws = WordSearch->new();
+isa_ok($ws, "WordSearch");
+
+$ws->loadWordlist("t/wordlist.txt", 5);
+is( scalar(@{$ws->{_wordlist}}), 54, "loadWordlist size");
+is($ws->{_wordlist}->[0], "aimed",   "loadWordlist first word");
+is($ws->{_wordlist}->[53], "wigged", "loadWordlist last word");
+
+$ws->loadGrid("t/searchgrid.txt");
+my $g = $ws->{_grid};
+is ( scalar(@$g), 19,                "loadGrid rows");
+is ( scalar(@{$g->[0]}), 16,         "loadGrid cols");
+
+done_testing();
diff --git a/challenge-076/bob-lied/perl/t/searchgrid.txt b/challenge-076/bob-lied/perl/t/searchgrid.txt
new file mode 100644
index 0000000000..31cf2e0fd8
--- /dev/null
+++ b/challenge-076/bob-lied/perl/t/searchgrid.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
diff --git a/challenge-076/bob-lied/perl/t/wordlist.txt b/challenge-076/bob-lied/perl/t/wordlist.txt
new file mode 100644
index 0000000000..e3209b2265
--- /dev/null
+++ b/challenge-076/bob-lied/perl/t/wordlist.txt
@@ -0,0 +1,54 @@
+aimed
+align
+antes
+argos
+arose
+ashed
+blunt
+blunts
+broad
+buries
+clove
+cloven
+constitution
+constitutions
+croon
+depart
+departed
+enter
+filch
+garlic
+goats
+grieve
+grieves
+hazard
+liens
+malign
+malignant
+malls
+margo
+midst
+ought
+ovary
+parted
+patna
+pudgiest
+quash
+quashed
+raped
+ruses
+shrine
+shrines
+social
+socializing
+spasm
+spasmodic
+succor
+succors
+theorem
+theorems
+traci
+tracie
+virus
+viruses
+wigged