Solutions to challenge 091

2 files changed, 108 insertions, 0 deletions

diff --git a/challenge-091/jo-37/perl/ch-1.pl b/challenge-091/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..da66d5f8a8
--- /dev/null
+++ b/challenge-091/jo-37/perl/ch-1.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use 5.012;
+use PDL;
+use Test2::V0 '!float';
+
+sub count_number {
+	# Split the given number into decimal digits and store them in a
+	# byte piddle.
+	my $n = byte split //, shift;
+
+	# Create a run length encoding for $n.  The piddles $r and $s become
+	# filled with the run lengths and the single numbers respectively.
+	# The results have the same length as the input piddle and are zero
+	# padded.
+	$n->rle(my $r = null, my $s = null);
+
+	# Select positive run lengths and the corresponding single numbers,
+	# combine these to a matrix (consisting of two lists), transpose it
+	# to a list of pairs, flatten the piddle and join the individual
+	# elements.
+	join '', cat(where $r, $s, $r > 0)->xchg(0, 1)->list;
+}
+
+is count_number(1122234), 21321314, 'Example 1';
+is count_number(2333445), 12332415, 'Example 2';
+is count_number(12345), 1112131415, 'Example 3';
+is count_number('2' x 1111),   11112, '"1111" 2';
+is count_number(111111111112), 11112, 'eleven 1 one 2';
+is count_number(122222222222), 11112, 'one 1 eleven 2';
+is count_number('3' x 11121),         111213, '"11121" 3';
+is count_number('1' . '3' x 121),     111213, 'one 1 "121" 3';
+is count_number('1' x 11 . '3' x 21), 111213, 'eleven 1 twenty-one 3';
+is count_number('2' x 111 . '3'),     111213, '"111" 2, one 3';
+is count_number(123),                 111213, 'one 1 one 2 one 3';
+
+done_testing;
diff --git a/challenge-091/jo-37/perl/ch-2.pl b/challenge-091/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..a1a56cc1f0
--- /dev/null
+++ b/challenge-091/jo-37/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use 5.012;
+use Test2::V0;
+
+# Enable trace output:
+my $verbose = 1;
+
+our $level;
+sub trace {
+	say '    ' x $level, @_ if $verbose;
+}
+
+# The task states: "[the] value at each index determines how far you are
+# allowed to jump further".  So I'll regard shorter jumps as valid.
+# There wouldn't be much fun otherwise - and it's called a game!
+
+# Recursive jump game.  Try jumps from the maximum allowed length
+# referenced by $maxjump[0] down to 1.  On failure, set the value to a
+# negative value preventing subsequent jumps to this position.
+sub jump_game;
+sub jump_game {
+	my @maxjump = @_;
+
+	# Convert the given numbers into references to them.  This enables
+	# modificating the original values through array slices.  Transform
+	# only once.
+	@maxjump = map \$_, @maxjump unless ref $maxjump[0];
+
+	local $level = ($level // -1) + 1;
+	trace "at (@{[map $$_, @maxjump]})";
+
+	# Jump length from max down to 1.
+	for my $jump (reverse 1 .. ${$maxjump[0]}) {
+		# If we can jump beyond the end, we can hit it as well.
+		if ($jump > $#maxjump) {
+			$jump = $#maxjump
+		}
+		# Don't ride a dead horse.
+		elsif (${$maxjump[$jump]} <= 0) {
+			trace "avoid jump $jump";
+			next;
+		}
+
+		trace "jump $jump:";
+		trace('hit the end'), return 1 if $jump == $#maxjump;
+
+		# Recurse into the remaining numbers from the jump target
+		# onwards.
+		return 1 if jump_game @maxjump[$jump .. $#maxjump];
+	}
+	trace 'failed';
+
+	# Record current failure by setting max to a negative value.  Any
+	# value <= 0 would do, but this visibly preserves the structure of
+	# the data when the trace is enabled.
+	${$maxjump[0]} *=  -1;
+	0;
+}
+
+ok   jump_game(1, 2, 1, 2), 'Example 1';
+ok ! jump_game(2, 1, 1, 0, 2), 'Example 2';
+
+# No solution without short jumps:
+ok jump_game(2, 2, 0, 2, 9, 3, 0, 0, 0, 1), 'step back and jump precise';
+
+ok ! jump_game(6, 5, 4, 3, 0, 0, 0, 1), 'track failures';
+ok   jump_game(2, 8, 2, 0, 1, 0, 5, 2, 0, 1, 0, 1), 'jump game!'; 
+ok ! jump_game(2, 8, 2, 0, 1, 0, 4, 2, 0, 1, 0, 1), 'too short'; 
+
+done_testing;