solution to task 2

2 files changed, 179 insertions, 0 deletions

diff --git a/challenge-076/jo-37/perl/ch-2.grid b/challenge-076/jo-37/perl/ch-2.grid
new file mode 100644
index 0000000000..31cf2e0fd8
--- /dev/null
+++ b/challenge-076/jo-37/perl/ch-2.grid
@@ -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/jo-37/perl/ch-2.pl b/challenge-076/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..3fa0946b0f
--- /dev/null
+++ b/challenge-076/jo-37/perl/ch-2.pl
@@ -0,0 +1,160 @@
+#!/usr/bin/perl
+
+# Usage: ch-2.pl [grid [words]]
+# Defaults: grid from challenge, local dictionary
+
+use v5.16;
+use warnings;
+use autodie;
+use utf8;
+
+use List::Util qw(min max);
+
+# Minimal word length to search for.
+use constant MIN => 5;
+
+# Read the letter grid.  The letters may be separated by whitespace.
+sub read_grid {
+	open my $fh, '<', shift;
+
+	map [split /\s*/], <$fh>;
+}
+
+# Read the dictionary and build a regex that matches all individual
+# words.  Inspired by https://perlmonks.org/?node_id=1179840.
+# Longer matching words take precedence over shorter ones.
+# Overlapping words are not searched for.
+sub read_dict {
+	open my $fh, '<', shift;
+
+	# Returns qr/(?:word1|word2|...|wordN)/i
+	sub {local $" = '|'; qr/(?:@_)/i}->(
+		map {quotemeta}
+		sort {length $b <=> length $a}
+		map {chomp; length >= MIN ? $_ : ()} <$fh>);
+}
+
+# Create index mappings for four directions.
+# Each mapping consists of a list of lists of index pairs that
+# specify the grid positions forming a string to be examined.
+# [0, 0] is top left, [$rows - 1, $cols - 1] is bottom right.
+# Returns an array of subs that create a specific indexing.
+sub indexing ($$) {
+	my ($rows, $cols) = @_;
+
+	# Helper to calculate the end index for the traversal of a diagonal:
+	# Starts at 0, grows to the plateau at min($rows, $cols) - 1
+	# and then decreases to 0.  The plateau degenerates to a peak
+	# if $rows == $cols.
+	my $diag_end = sub {
+		my $diag = shift;
+		min($diag, $rows - 1, $cols - 1, $rows + $cols - 2 - $diag);
+	};
+
+	(
+		# east
+		sub {
+			map {
+				my $row = $_;
+				# Strings run towards east.
+
+				[map [$row, $_], 0 .. $cols - 1];
+			} 0 .. $rows - 1;
+		},
+
+		# south
+		sub {
+			map {
+				my $col = $_;
+				# Strings run towards south.
+
+				[map [$_, $col], 0 .. $rows - 1];
+			} 0 .. $cols - 1;
+		},
+
+		# southeast
+		sub {
+			map {
+				my $diag = $_;
+				# Start of string moves from bottom left up to top left
+				# and then from top left to top right.  Strings run
+				# towards southeast.
+				my $row = max($rows - 1 - $diag, 0);
+				my $col = max($diag - $rows + 1, 0);
+
+				[map [$row + $_, $col + $_], 0 .. $diag_end->($diag)];
+			} 0 .. $rows + $cols - 2;
+		},
+
+		# northeast
+		sub {
+			map {
+				my $diag = $_;
+				# Start of string moves from top left down to bottom left
+				# and then from bottom left to bottom right.  Strings run
+				# towards northeast.
+				my $row = min($diag, $rows - 1);
+				my $col = max($diag - $rows + 1, 0);
+
+				[map [$row - $_, $col + $_], 0 .. $diag_end->($diag)];
+			} 0 .. $rows + $cols - 2;
+		}
+	);
+}
+
+#
+# main
+#
+
+my @grid = read_grid $ARGV[0] // 'ch-2.grid';
+my $needle = read_dict $ARGV[1] // '/usr/share/dict/words';
+
+local $\ = "\n";
+
+# Apply each indexing to the grid data and match the retrieved strings
+# forward and reversed against the dictionary.
+for my $index (indexing @grid, @{$grid[0]}) {
+		my @haystack =  map {join '', map $grid[$_->[0]][$_->[1]], @$_}
+			$index->();
+		print foreach map /($needle)/g,
+			@haystack, map {scalar reverse} @haystack;
+}
+
+# Result from running the example grid against the local English
+# dictionary:
+
+__DATA__
+SUCCORS
+MIDST
+BROAD
+OVARY
+PATNA
+VIRUSES
+GARLIC
+FILCH
+AIMED
+WIGGED
+BURIES
+SOCIALIZING
+GOATS
+MALIGNANT
+BLUNTS
+SHRINES
+HAZARD
+GRIEVES
+OUGHT
+SPASMODIC
+MALLS
+DEPARTED
+LIENS
+QUASHED
+ANTES
+ENTER
+PUDGIEST
+RAPED
+MARGO
+CONSTITUTIONS
+THEOREMS
+AROSE
+CLOVEN
+CROON