Merge pull request #5390 from dcw803/master

imported my solutions for this week's tasks

3 files changed, 310 insertions, 23 deletions

diff --git a/challenge-143/duncan-c-white/README b/challenge-143/duncan-c-white/README
index 5a433917be..917ee497cb 100644
--- a/challenge-143/duncan-c-white/README
+++ b/challenge-143/duncan-c-white/README
@@ -1,41 +1,63 @@
-TASK #1 - Divisor Last Digit
+TASK #1 - Calculator
 
-You are given positive integers, $m and $n.
+You are given a string, $s, containing mathematical expression.
 
-Write a script to find total count of divisors of $m having last digit $n.
+Write a script to print the result of the mathematical expression. To
+keep it simple, please only accept + - * ().
 
 Example 1:
 
-	Input: $m = 24, $n = 2
-	Output: 2
+    Input: $s = "10 + 20 - 5"
+    Output: 25
 
-	The divisors of 24 are 1, 2, 3, 4, 6, 8 and 12.
-	There are only 2 divisors having last digit 2 are 2 and 12.
+Example 2:
 
+    Input: $s = "(10 + 20 - 5) * 2"
+    Output: 50
 
-Example 2:
+MY NOTES: Ok, so a mini parser of a string in one or more command
+   line arguments.   What's the easiest way?
+   - use Parse::RecDescent?
+   - hand write a recursive descent parser?
+   - convert to RPN and evaluate RPN?
+
+
+TASK #2 - Stealthy Number
+
+You are given a positive number, $n.
+
+Write a script to find out if the given number is Stealthy Number.
+
+A positive integer N is stealthy, if there exist positive integers
+a, b, c, d such that a * b = c * d = N and a + b = c + d + 1.
+
+Example 1
+
+	Input: $n = 36
+	Output: 1
 
-	Input: $m = 30, $n = 5
-	Output: 2
+	Since 36 = 4 (a) * 9 (b) = 6 (c) * 6 (d) and
+	4 (a) + 9 (b) = 6 (c) + 6 (d) + 1.
 
-	The divisors of 30 are 1, 2, 3, 5, 6, 10 and 15.
-	There are only 2 divisors having last digit 5 are 5 and 15.
+Example 2
 
-MY NOTES: Very easy.
+	Input: $n = 12
+	Output: 1
 
+	Since 2 * 6 = 3 * 4 and 2 + 6 = 3 + 4 + 1
 
-TASK #2 - Sleep Sort
+Example 3
 
-Another joke sort similar to JortSort suggested by champion Adam Russell.
+	Input: $n = 6
+	Output: 0
 
-You are given a list of numbers.
+	Since 2 * 3 = 1 * 6 but 2 + 3 != 1 + 6 + 1
 
-Write a script to implement Sleep Sort. For more information:
 
-for n in array
-	create a new thread and make it sleep for array[n] milliseconds
-	print array[n]
-end
-wait for all processes to finish
+MY NOTES: hmm..  need some kind of brute force search, presumably.
+what are the limits of a..d?  first thought: each <= $n,
+hang on, (a,b) must be a factor pair of n (where a is a factor of n
+<= sqrt(n) and b is n/a), and (c,d) must also be a factor pair of n.
 
-MY NOTES: threaded sorting? weird.  not sure I can be bothered..
+As a bonus, I've also implemented the --firstn flag which makes it
+find and display the first $n stealthy numbers.
diff --git a/challenge-143/duncan-c-white/perl/ch-1.pl b/challenge-143/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..0b98aaebc3
--- /dev/null
+++ b/challenge-143/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/perl
+# 
+# TASK #1 - Calculator
+# 
+# You are given a string, $s, containing mathematical expression.
+# 
+# Write a script to print the result of the mathematical expression. To
+# keep it simple, please only accept + - * ().
+# 
+# Example 1:
+# 
+#     Input: $s = "10 + 20 - 5"
+#     Output: 25
+# 
+# Example 2:
+# 
+#     Input: $s = "(10 + 20 - 5) * 2"
+#     Output: 50
+# 
+# MY NOTES: Ok, so a mini parser of a string in one or more command
+#    line arguments.   What's the easiest way?
+#    - use Parse::RecDescent?
+#    - hand write a recursive descent parser?
+#    - convert to RPN and evaluate RPN?
+#   Let's try handwriting a RD parser..
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Data::Dumper;
+use feature 'say';
+
+
+#
+# my $val = factor( $inputref );
+#	Parse the input string $$inputref, an integer expression factor,
+#	removing text from $$inputref as we consume it, calculating and
+#	returning the result as we go.
+#
+sub factor
+{
+	my( $inputref ) = @_;
+	my $orig = $$inputref;
+	if( $$inputref =~ s/^\(// )
+	{
+		$orig = $$inputref;
+		my $val = expr( $inputref );
+		die "factor: bad nested expression $orig\n" unless defined $val;
+		die "factor: ')' expected in $$inputref after expr\n"
+			unless $$inputref =~ s/\)//;
+		return $val;
+	}
+	return -$1 if $$inputref =~ s/^-(\d+)//;
+	return $1  if $$inputref =~ s/^(\d+)//;
+	die "factor: '(' or -n or n expected at $$inputref\n";
+}
+
+
+#
+# my $val = term( $inputref );
+#	Parse the input string $$inputref, an integer expression term, removing
+# 	text from $$inputref as we consume it, and calculate and return the
+#	result.
+#
+sub term
+{
+	my( $inputref ) = @_;
+	my $val = factor( $inputref );
+	while( $$inputref =~ m|^[*/]| )
+	{
+		if( $$inputref =~ s/^\*// )
+		{
+			my $v2 = factor( $inputref );
+			$val *= $v2;
+		}
+		elsif( $$inputref =~ s|^/|| )
+		{
+			my $v2 = factor( $inputref );
+			die "term: can't divide by 0\n" if $v2==0;
+			$val = int($val/$v2);
+		}
+	}
+	return $val;
+}
+
+
+#
+# my $val = expr( $inputref );
+#	Parse the input string $$inputref, an integer expression, removing
+# 	text from $$inputref as we consume it, and calculate and return the
+#	result.
+sub expr
+{
+	my( $inputref ) = @_;
+	my $val = term( $inputref );
+	while( $$inputref =~ /^[+-]/ )
+	{
+		if( $$inputref =~ s/^\+// )
+		{
+			my $v2 = term( $inputref );
+			$val += $v2;
+		}
+		elsif( $$inputref =~ s/^-// )
+		{
+			my $v2 = term( $inputref );
+			$val -= $v2;
+		}
+	}
+	return $val;
+}
+
+
+#
+# my $val = parseexpr( $input );
+#	Parse the input string $input, an integer expression, and calculate
+#	and return the result - or die with an error message.
+#
+sub parseexpr
+{
+	my( $input ) = @_;
+
+	$input =~ s/\s+//g;	# remove all whitespace
+
+	my $val = expr( \$input );
+	die "leftover input $input after expr\n" unless $input eq '';
+	return $val;
+}
+
+
+my $debug=0;
+die "Usage: calculator [--debug] expr\n" unless
+	GetOptions( "debug"=>\$debug ) && @ARGV>0;
+
+my $expr = join( ' ', @ARGV );
+
+my $val = parseexpr( $expr );
+say $val;
diff --git a/challenge-143/duncan-c-white/perl/ch-2.pl b/challenge-143/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..289e6cea65
--- /dev/null
+++ b/challenge-143/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+# 
+# TASK #2 - Stealthy Number
+# 
+# You are given a positive number, $n.
+# 
+# Write a script to find out if the given number is Stealthy Number.
+# 
+# A positive integer N is stealthy, if there exist positive integers
+# a, b, c, d such that a * b = c * d = N and a + b = c + d + 1.
+# 
+# Example 1
+# 
+# 	Input: $n = 36
+# 	Output: 1
+# 
+# 	Since 36 = 4 (a) * 9 (b) = 6 (c) * 6 (d) and
+# 	4 (a) + 9 (b) = 6 (c) + 6 (d) + 1.
+# 
+# Example 2
+# 
+# 	Input: $n = 12
+# 	Output: 1
+# 
+# 	Since 2 * 6 = 3 * 4 and 2 + 6 = 3 + 4 + 1
+# 
+# Example 3
+# 
+# 	Input: $n = 6
+# 	Output: 0
+# 
+# 	Since 2 * 3 = 1 * 6 but 2 + 3 != 1 + 6 + 1
+# 
+# 
+# MY NOTES: hmm..  need some kind of brute force search, presumably.
+# what are the limits of a..d?  first thought: each <= $n,
+# hang on, (a,b) must be a factor pair of n (where a is a factor of n
+# <= sqrt(n) and b is n/a), and (c,d) must also be a factor pair of n.
+#
+# As a bonus, I've also implemented the --firstn flag which makes it
+# find and display the first $n stealthy numbers.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Data::Dumper;
+
+#
+# my @fact = factorpairs( $n );
+#	Find and return all the factor pairs ($x,$y) of $n
+#	where $x is a factor of $n from 1..sqrt(n), and
+#	$y is $n/$x
+#
+sub factorpairs
+{
+	my( $n ) = @_;
+	my @f = ( [1,$n] );
+	my $sqrtn = int(sqrt($n));
+	for( my $i=2; $i<=$sqrtn; $i++ )
+	{
+		push @f, [ $i, $n/$i ] if $n%$i==0;
+	}
+	return @f;
+}
+
+
+#
+# my( $isstealthy, $a, $b, $c, $d ) = stealthy( $n );
+#	Determine whether or not $n is stealthy.  If not, return (0).
+#	If it is, return (1, a, b, c, d) where a, b, c and d are one
+#	possible stealthy set of numbers.
+#
+sub stealthy
+{
+	my( $n ) = @_;
+
+	my @fp = factorpairs( $n );
+	#say Dumper \@fp;
+
+	foreach my $ab (@fp)
+	{
+		my( $a, $b ) = @$ab;
+		foreach my $cd (@fp)
+		{
+			my( $c, $d ) = @$cd;
+			# check whether a + b = c + d + 1.
+			return (1, $a, $b, $c, $d) if
+				$a + $b == $c + $d + 1;
+		}
+	}
+
+	return (0);
+}
+
+
+my $debug=0;
+my $firstn = 0;
+die "Usage: steathy-number [--debug] [--firstn] N\n" unless
+	GetOptions( "debug"=>\$debug, "firstn"=>\$firstn ) && @ARGV==1;
+my( $n ) = @ARGV;
+
+if( $firstn )
+{
+	my $found=0;
+	for( my $i=0; $found<$n; $i++ )
+	{
+		my( $isstealthy, $a, $b, $c, $d ) = stealthy( $i );
+		if( $isstealthy )
+		{
+			say "$i: stealthy: $a, $b, $c, $d";
+			$found++;
+		}
+	}
+} else
+{
+	my( $isstealthy, $a, $b, $c, $d ) = stealthy( $n );
+	if( $isstealthy )
+	{
+		say "1: $a, $b, $c, $d";
+	} else
+	{
+		say "0";
+	}
+}