Merge pull request #2625 from dcw803/master

imported my solutions, slightly late, only started at 11:40pm:-)

3 files changed, 177 insertions, 60 deletions

diff --git a/challenge-083/duncan-c-white/README b/challenge-083/duncan-c-white/README
index 2892de7da3..fd29cd1f34 100644
--- a/challenge-083/duncan-c-white/README
+++ b/challenge-083/duncan-c-white/README
@@ -1,82 +1,54 @@
-Task 1: "Common Factors
+Task 1: "Words Length
 
-You are given 2 positive numbers $M and $N.
+You are given a string $S with 3 or more words.
 
-Write a script to list all common factors of the given numbers.
+Write a script to find the length of the string except the first and last words ignoring whitespace.
 
 Example 1:
-
-Input:
-    $M = 12
-    $N = 18
-
-Output:
-    (1, 2, 3, 6)
-
-Explanation:
-    Factors of 12: 1, 2, 3, 4, 6
-    Factors of 18: 1, 2, 3, 6, 9
+	Input: $S = "The Weekly Challenge"
+	Output: 6
 
 Example 2:
+	Input: $S = "The purpose of our lives is to be happy"
+ 	Output: 23
+	ME: WRONG! length(purpose of our lives is to be)==29
 
-Input:
-    $M = 18
-    $N = 23
-
-Output:
-    (1)
-
-Explanation:
-    Factors of 18: 1, 2, 3, 6, 9
-    Factors of 23: 1
-
+My notes: simple, clearly defined: use the power of regexes.
 
-My notes: simple, find factors and then intersect.
 
+Task 2: "Flip Array
 
-Task 2: "Interleave String
+You are given an array @A of positive numbers.
 
-You are given 3 strings; $A, $B and $C.
+Write a script to flip the sign of some members of the given array so
+that the sum of the all members is minimum non-negative.
 
-Write a script to check if $C is created by interleave $A and $B.
+Given an array of positive elements, you have to flip the sign of some
+of its elements such that the resultant sum of the elements of array
+should be minimum non-negative(as close to zero as possible). Return
+the minimum no. of elements whose sign needs to be flipped such that
+the resultant sum is minimum non-negative.
 
-Print 1 if check is success otherwise 0.
 Example 1:
+	Input: @A = (3, 10, 8)
+	Output: 1
 
-Input:
-    $A = "XY"
-    $B = "X"
-    $C = "XXY"
-
-Output: 1
-
-EXPLANATION
+Explanation:
 
-"X" (from $B) + "XY" (from $A) = $C
+Flipping the sign of just one element 10 gives the result 1 i.e. (3) +
+(-10) + (8) = 1
 
 Example 2:
+	Input: @A = (12, 2, 10)
+	Output: 1
 
-Input:
-    $A = "XXY"
-    $B = "XXZ"
-    $C = "XXXXZY"
-
-Output: 1
-
-EXPLANATION
-
-"XX" (from $A) + "XXZ" (from $B) + "Y" (from $A) = $C
-
-Example 3:
+Explanation:
 
-Input:
-    $A = "YX"
-    $B = "X"
-    $C = "XXY"
+Flipping the sign of just one element 12 gives the result 0 i.e. (-12) +
+(2) + (10) = 0
 
-Output: 0
 
-My notes: It's not quite clear what "interleaving" means here, but I'm
-going to assume that it means "take a PREFIX of any length from one string,
-followed by a PREFIX of any length from the other string, then continue
-with the parts of the strings not yet consumed".  Relatively easy.
+My notes: clearly defined, but how to go about this one? several
+possible approaches.  brute force: each element may either be
+negated or not; try all combinations:-)  not very elegant, but does
+the job..
diff --git a/challenge-083/duncan-c-white/perl/ch-1.pl b/challenge-083/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..d5a482fa17
--- /dev/null
+++ b/challenge-083/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+#
+# Task 1: "Words Length
+#
+# You are given a string $S with 3 or more words.
+# 
+# Write a script to find the length of the string except the first and
+# last words ignoring whitespace.
+# 
+# Example 1:
+# 	Input: $S = "The Weekly Challenge"
+# 	Output: 6
+# 
+# Example 2:
+# 	Input: $S = "The purpose of our lives is to be happy"
+# 	Output: 23
+#	ME: WRONG! length(purpose of our lives is to be)==29
+# 
+# My notes: simple, clearly defined: use the power of regexes.
+#
+
+use strict;
+use warnings;
+use feature 'say';
+use Data::Dumper;
+
+die "Usage: words-length s\n" unless @ARGV;
+my $s = join( ' ', @ARGV );
+
+my $orig = $s;
+
+$s =~ s/^\S+\s+//;	# remove first word
+$s =~ s/\s+\S+$//;	# remove last word
+
+say "orig:$orig, s:$s:", length($s);
diff --git a/challenge-083/duncan-c-white/perl/ch-2.pl b/challenge-083/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..9b912f43a6
--- /dev/null
+++ b/challenge-083/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,110 @@
+#!/usr/bin/perl
+#
+# Task 2: "Flip Array
+#
+# You are given an array @A of positive numbers.
+# 
+# Write a script to flip the sign of some members of the given array so
+# that the sum of the all members is minimum non-negative.
+# 
+# Given an array of positive elements, you have to flip the sign of some
+# of its elements such that the resultant sum of the elements of array
+# should be minimum non-negative(as close to zero as possible). Return
+# the minimum no. of elements whose sign needs to be flipped such that
+# the resultant sum is minimum non-negative.
+# 
+# Example 1:
+# 	Input: @A = (3, 10, 8)
+# 	Output: 1
+# 
+# Explanation:
+# 
+# Flipping the sign of just one element 10 gives the result 1 i.e. (3) +
+# (-10) + (8) = 1
+# 
+# Example 2:
+# 	Input: @A = (12, 2, 10)
+# 	Output: 1
+# 
+# Explanation:
+# 
+# Flipping the sign of just one element 12 gives the result 0 i.e. (-12) +
+# (2) + (10) = 0
+# 
+# My notes: clearly defined, but how to go about this one? several
+# possible approaches.  brute force: each element may either be
+# negated or not; try all combinations:-)  not very elegant, but does
+# the job..
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+use List::Util 'sum';
+use Data::Dumper;
+
+die "Usage: negate-array-elements list_of_numbers\n" unless @ARGV;
+my @a = @ARGV;
+
+#
+# my( $minsum, $minswaps ) = tryall( @a );
+#	Try summing all elements of @a, with each element
+#	as is or negated.  For each combination, sum the elements,
+#	count the number of negations, and keep track of $minsum -
+#	the minimum sum - and $minswaps - the minimum number of negations.
+#	Return the final pair ($minsum, $minswaps).
+#
+fun tryall( @a )
+{
+	# first pass: build @sum, @swaps and find min sum
+	my $n = @a;
+	my $limit = 2**$n;
+	my @swaps;
+	my @sum;
+	my $minsum = sum(@a);
+	foreach my $i (0..$limit-1)
+	{
+		my $binary = sprintf( "%0${n}b", $i );
+		#say "binary=$binary";
+
+		my $sum = 0;
+		my $swaps = 0;
+		foreach my $pos (0..$n-1)
+		{
+			my $x = $a[$pos];
+			if( substr($binary,$pos,1) eq '1' )
+			{
+				$x = -$x;
+				$swaps++;
+			}
+			$sum += $x;
+		}
+		push @sum, $sum;
+		push @swaps, $swaps;
+		#say "sum=$sum";
+		next if $sum < 0;
+		if( $sum <= $minsum )
+		{
+			$minsum = $sum;
+		}
+	}
+
+	#say "minsum: $minsum";
+
+	# second pass: find minswaps giving EXACTLY minsum
+	my $minswaps = @a+1;
+
+	foreach my $i (0..$limit-1)
+	{
+		next unless $sum[$i] == $minsum;
+		my $swaps = $swaps[$i];
+		$minswaps = $swaps if $swaps < $minswaps;
+	}
+
+	return ($minsum, $minswaps);
+}
+
+
+my( $minsum, $minswaps ) = tryall( @a );
+say "minsum=$minsum, minswaps=$minswaps";