Merge pull request #1156 from jacoby/master

Challenge 44

3 files changed, 219 insertions, 0 deletions

diff --git a/challenge-044/dave-jacoby/perl/ch-1.pl b/challenge-044/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..3d0fd3cc83
--- /dev/null
+++ b/challenge-044/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,91 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures };
+no warnings qw{ experimental::signatures };
+
+my $instructions =<<'END';
+
+You are given a string “123456789”. Write a script that would 
+insert ”+” or ”-” in between digits so that when you evaluate, 
+the result should be 100.
+
+END
+
+# given that this is the only string and the only result,
+# we are given leave to hard-code things that, with easier
+# coding but harder thinking, would be more general. this
+# is a custom-to-the-task solution.
+
+# clearly, adding one + or - to a central position is not
+# going to work so between any two numbers there will be
+# inserted either a '+', a '-' or a '', and we eval each 
+# time. I dislike eval but here we go.
+
+# for a more general solution, I might make it recursive
+# passing string, values, total, index and current state,
+# and only evaluating when index is highter than the length
+# of string. but I have a list of solutions, so not tonight.
+
+my @vals = ('',' + ',' - ');
+for my $i (@vals) {
+	for my $j (@vals) {
+		for my $k (@vals) {
+			for my $l (@vals) {
+				for my $m (@vals) {
+					for my $n (@vals) {
+						for my $o (@vals) {
+							for my $p (@vals) {
+								for my $q (@vals) {
+									my $string = join '','1',$i,'2',$j,'3',$l,'4',$m,'5',$n,'6',$o,'7',$p,'8',$q,'9';
+									my $resp = eval $string;
+									next unless $resp == 100;
+									say qq{$resp = $string};
+								}
+							}
+						}
+					}
+				}
+			}
+		}
+	}
+}
+
+__DATA__
+
+The correct solutions
+
+100 = 123 + 45 - 67 + 8 - 9
+100 = 123 + 4 - 5 + 67 - 89
+100 = 123 - 45 - 67 + 89
+100 = 123 - 4 - 5 - 6 - 7 + 8 - 9
+100 = 123 + 45 - 67 + 8 - 9
+100 = 123 + 4 - 5 + 67 - 89
+100 = 123 - 45 - 67 + 89
+100 = 123 - 4 - 5 - 6 - 7 + 8 - 9
+100 = 123 + 45 - 67 + 8 - 9
+100 = 123 + 4 - 5 + 67 - 89
+100 = 123 - 45 - 67 + 89
+100 = 123 - 4 - 5 - 6 - 7 + 8 - 9
+100 = 12 + 3 + 4 + 5 - 6 - 7 + 89
+100 = 12 + 3 - 4 + 5 + 67 + 8 + 9
+100 = 12 + 3 + 4 + 5 - 6 - 7 + 89
+100 = 12 + 3 - 4 + 5 + 67 + 8 + 9
+100 = 12 + 3 + 4 + 5 - 6 - 7 + 89
+100 = 12 + 3 - 4 + 5 + 67 + 8 + 9
+100 = 12 - 3 - 4 + 5 - 6 + 7 + 89
+100 = 12 - 3 - 4 + 5 - 6 + 7 + 89
+100 = 12 - 3 - 4 + 5 - 6 + 7 + 89
+100 = 1 + 23 - 4 + 56 + 7 + 8 + 9
+100 = 1 + 23 - 4 + 5 + 6 + 78 - 9
+100 = 1 + 23 - 4 + 56 + 7 + 8 + 9
+100 = 1 + 23 - 4 + 5 + 6 + 78 - 9
+100 = 1 + 23 - 4 + 56 + 7 + 8 + 9
+100 = 1 + 23 - 4 + 5 + 6 + 78 - 9
+100 = 1 + 2 + 34 - 5 + 67 - 8 + 9
+100 = 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9
+100 = 1 + 2 + 34 - 5 + 67 - 8 + 9
+100 = 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9
+100 = 1 + 2 + 34 - 5 + 67 - 8 + 9
+100 = 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9
\ No newline at end of file
diff --git a/challenge-044/dave-jacoby/perl/ch-1a.pl b/challenge-044/dave-jacoby/perl/ch-1a.pl
new file mode 100644
index 0000000000..a6c92a216a
--- /dev/null
+++ b/challenge-044/dave-jacoby/perl/ch-1a.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures };
+no warnings
+  qw{ experimental::postderef experimental::signatures };
+
+my $vals->@* = ( ' + ', ' - ', '' );
+my $source->@* = ( 1, '', 2, '', 3, '', 4, '', 5, '', 6, '', 7, '', 8, '', 9 );
+
+challenge( $source, $vals, 1 );
+
+sub challenge ( $source, $vals, $index ) {
+
+    # check to see if this is correct
+    if ( $index >= scalar $source->@* ) {
+        my $string = join '', $source->@*;
+        my $result = eval $string;
+        say qq{  $result = $string } if $result == 100;
+        return;
+    }
+
+    # recursively add to the array
+    my $next->@* = map { $_ } $source->@*;
+    for my $v ( $vals->@* ) {
+        $next->[$index] = $v;
+        challenge( $next, $vals, $index + 2 );
+    }
+    return;
+}
+exit;
diff --git a/challenge-044/dave-jacoby/perl/ch-2.pl b/challenge-044/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..a63fc98a1e
--- /dev/null
+++ b/challenge-044/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental::signatures };
+
+my $instructions = <<'END';
+
+	You have only $1 left at the start of the week. 
+	You have been given an opportunity to make it $200. 
+	The rule is simple with every move you can either 
+	double what you have or add another $1. 
+	
+	Write a script to help you get $200 with the 
+	smallest number of moves.
+
+END
+
+my @x;
+push @x, '1';
+
+# We're looking for "smallest number of moves" so what we're
+# conceptually thinking of is "breadth-first" and/or
+# Dijkstra's Shortest-Path Algorithm.
+
+# https://en.wikipedia.org/wiki/Dijkstra%27s_algorithm
+
+# So, we're going with the simplest possible representation of
+# the tree, where we start with 1 and each node being
+# 	- 'p', representing "plus 1"
+#   - 'd', representing "double"
+
+# we therefore make an array that looks like
+
+# 1
+# 1p
+# 1d
+# 1pp
+# 1pd
+# 1dp
+# 1dd
+# 1ppp
+# 1ppd
+# 1pdp
+#...
+
+# except we pop the string we're looking at it and shift
+# that string with both "d" and "p" added.
+
+# we have the function that returns what the string means,
+# stop when we've hit 200 and don't shift anything when
+# we've overshot.
+
+my @array = (1);
+for my $i (@array) {
+	my $check = decode($i);
+	if ( $check == 200 ) {
+		say join "\t", $check, $i, scalar @array;
+		exit;
+	}
+
+	if ( $check > 200 ) {
+		next;
+	}
+	push @array, $i . 'p';
+	push @array, $i . 'd';
+}
+
+exit;
+
+
+sub decode ( $sample ) {
+	my ( $i, @list ) = split m//, $sample;
+	for my $l (@list) {
+		$i += 1 if $l eq 'p';
+		$i *= 2 if $l eq 'd';
+	}
+	return $i;
+}
+
+__DATA__
+
+200     1ppdddpddd      1251
+
+1		1
+	+1 	2
+	+1	3
+	*2	6
+	*2	12
+	*2	24
+	+1  25
+	*2	50
+	*2	100
+	*2  200
\ No newline at end of file