Merge pull request #2195 from jo-37/contrib

Solutions to challenge 076

3 files changed, 224 insertions, 0 deletions

diff --git a/challenge-076/jo-37/perl/ch-1.pl b/challenge-076/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..4897dd70c3
--- /dev/null
+++ b/challenge-076/jo-37/perl/ch-1.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+use Test2::V0;
+use Math::Prime::XS 'is_prime';
+use bigint;
+
+# The task states:
+#	"find the minimum number of prime numbers required, whose summation
+# 	gives you $N".
+# This does not imply finding specific summands, IMHO.
+#
+# According to Goldbach's conjecture, every even number greater than two
+# can be expressed as the sum of two primes.  As there is no exception to
+# this rule for $n <= 4e18, it may be considered as valid for this task.
+sub num_prime_summands {
+	my ($n) = @_;					# keep @_
+	$_[1] = 2;						# provide default retcode
+
+	return 0 if $n < 2;				# not a sum of primes
+	return 1 if $n == 2;			# 2 is prime
+	goto &assure if $n % 2 == 0;	# Goldbach's conjecture
+	return 1 if is_prime $n;		# $n is prime
+	return 2 if is_prime $n - 2;	# $n - 2 is prime
+
+	$_[1]++; goto &assure;			# Else: $n minus any odd prime is even,
+									# where Goldbach's conjecture is
+									# applied again.
+}
+
+# Warn about results that cannot be assured.
+sub assure {
+	my ($n, $r) = @_;
+	warn "The result is not assured!\n" if $n > 4e18;
+
+	$r;
+}
+
+
+is num_prime_summands($_->[0]), $_->[1]
+	foreach [1, 0], [2, 1], [3, 1], [4, 2], [5, 1], [6, 2], [7, 1],
+		[8, 2], [9, 2], [10, 2], [11, 1], [12, 2], [13, 1], [14, 2],
+		[15, 2], [16, 2], [17, 1], [18, 2], [19, 1], [20, 2], [21, 2],
+		[22, 2], [23, 1], [24, 2], [25, 2], [26, 2], [27, 3], [28, 2];
+
+done_testing;
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