Merge pull request #5842 from dcw803/master

added and committed my solutions to this week's tasks.. two nice taks

3 files changed, 250 insertions, 30 deletions

diff --git a/challenge-157/duncan-c-white/README b/challenge-157/duncan-c-white/README
index 3ddc10f2b9..424d544222 100644
--- a/challenge-157/duncan-c-white/README
+++ b/challenge-157/duncan-c-white/README
@@ -1,52 +1,67 @@
-TASK #1 - Pernicious Numbers
+TASK #1 - Pythagorean Means
 
-Write a script to permute first 10 Pernicious Numbers.
+You are given a set of integers.
 
-A pernicious number is a positive integer which has prime number of ones
-in its binary representation.
+Write a script to compute all three Pythagorean Means i.e Arithmetic Mean,
+Geometric Mean and Harmonic Mean of the given set of integers. Please
+refer to wikipedia page for more informations.
 
-The first pernicious number is 3 since binary representation of 3 =
-(11) and 1 + 1 = 2, which is a prime.
+Example 1:
+
+	Input: @n = (1,3,5,6,9)
+	Output: AM = 4.8, GM = 3.9, HM = 2.8
+
+Example 2:
 
-Expected Output
+	Input: @n = (2,4,6,8,10)
+	Output: AM = 6.0, GM = 5.2, HM = 4.4
 
-3, 5, 6, 7, 9, 10, 11, 12, 13, 14
+Example 3:
 
-MY NOTES: ok.  Pretty easy.  pernicious(n) = isprime(countones(binary(n)))
+	Input: @n = (1,2,3,4,5)
+	Output: AM = 3.0, GM = 2.6, HM = 2.2
 
+MY NOTES: ok.  Pretty easy, although the geometric mean involves
+calculating the product of the numbers, which may get pretty huge.
+Tried bigrat, but it broke the nth-root calculation using **.
 
-TASK #2 - Weird Number
 
-You are given number, $n > 0.
+TASK #2 - Brazilian Number
 
-Write a script to find out if the given number is a Weird Number.
+You are given a number $n > 3.
 
-According to Wikipedia, it is defined as:
+Write a script to find out if the given number is a Brazilian Number.
+
+A positive integer number N has at least one natural number B where
+1 < B < N-1 where the representation of N in base B has same digits.
 
-The sum of the proper divisors (divisors including 1 but not itself) of
-the number is greater than the number, but no subset of those divisors
-sums to the number itself.
 
 Example 1:
 
-	Input: $n = 12
-	Output: 0
+Input: $n = 7
+Output: 1
 
-Since the proper divisors of 12 are 1, 2, 3, 4, and 6, which sum to 16;
-but 2 + 4 + 6 = 12.
+Since 7 in base 2 is 111.
 
 Example 2:
 
-	Input: $n = 70
-	Output: 1
+Input: $n = 6
+Output: 0
+
+Since 6 in base 2 is 110,
+      6 in base 3 is 20 and
+      6 in base 4 is 12.
+
+Example 3:
+
+Input: $n = 8
+Output: 1
 
-As the proper divisors of 70 are 1, 2, 5, 7, 10, 14, and 35; these sum
-to 74, but no subset of these sums to 70.
+Since 8 in base 3 is 22.
 
-MY NOTES: ok.  Handle "sum of subsets of these items" by noting that
-each item may be present or absent, so have a counting loop from 0..
-2**(nitems)-1 and compute the sum of just those items selected by the
-binary bits of the count that are 1.
 
-Bonus: I added a "tabulate" facility (eg. run with --tabulate 5 to
-see the first 5 Weird numbers).
+MY NOTES: ok, so "same digits" really means "the same base-b digit
+repeated throughout the entire string".  Sounds pretty easy.
+Added debugging mode to produce and display the "Since" messages,
+formatted nicely.  Then added tabulate mode to show the first N
+Brazilian numbers (this interoperates nicely with -d).
diff --git a/challenge-157/duncan-c-white/perl/ch-1.pl b/challenge-157/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..e37d05766f
--- /dev/null
+++ b/challenge-157/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+# 
+# TASK #1 - Pythagorean Means
+# 
+# You are given a set of integers.
+# 
+# Write a script to compute all three Pythagorean Means i.e Arithmetic Mean,
+# Geometric Mean and Harmonic Mean of the given set of integers. Please
+# refer to wikipedia page for more informations.
+# 
+# Example 1:
+# 
+# 	Input: @n = (1,3,5,6,9)
+# 	Output: AM = 4.8, GM = 3.9, HM = 2.8
+# 
+# Example 2:
+# 
+# 	Input: @n = (2,4,6,8,10)
+# 	Output: AM = 6.0, GM = 5.2, HM = 4.4
+# 
+# Example 3:
+# 
+# 	Input: @n = (1,2,3,4,5)
+# 	Output: AM = 3.0, GM = 2.6, HM = 2.2
+# 
+# MY NOTES: ok.  Pretty easy, although the geometric mean involves
+# calculating the product of the numbers, which may get pretty huge.
+# Tried bigrat, but it broke the nth-root calculation using **.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use List::Util qw(sum0 product);
+#use Data::Dumper;
+
+my $debug=0;
+die "Usage: pythogoran-means [--debug] number+\n"
+	unless GetOptions( "debug"=>\$debug ) && @ARGV>0;
+
+# allow any mixture of commas and spaces (separate arguments)
+my $str = join(',',@ARGV);
+$str =~ s/\s/,/g;
+
+my @x = split(/,/, $str);
+my $n = @x;
+
+my $total = sum0(@x);
+my $prod = abs(product(@x));
+my $recipsum = sum0( map { 1/$_ } @x );
+
+say "n=$n, total=$total, prod=$prod; recipsum=$recipsum";
+
+my $am = $total/$n;		# sum(@x)/$n
+my $gm = $prod ** (1/$n); 	# nth_root( $n, abs(product(@x)) )
+my $hm = $n /  $recipsum;	# n / sum( reciprocals(@x) )
+
+printf "AM = %.1f, GM = %.1f, HM = %.1f\n", $am, $gm, $hm;
diff --git a/challenge-157/duncan-c-white/perl/ch-2.pl b/challenge-157/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..11ae3be451
--- /dev/null
+++ b/challenge-157/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,146 @@
+#!/usr/bin/perl
+# 
+# TASK #2 - Brazilian Number
+# 
+# You are given a number $n > 3.
+# 
+# Write a script to find out if the given number is a Brazilian Number.
+# 
+# A positive integer number N has at least one natural number B where
+# 1 < B < N-1 where the representation of N in base B has same digits.
+# 
+# 
+# Example 1:
+# 
+# 	Input: $n = 7
+# 	Output: 1
+# 
+# 	Since 7 in base 2 is 111.
+# 
+# Example 2:
+# 
+# 	Input: $n = 6
+# 	Output: 0
+# 
+# Since 6 in base 2 is 110,
+#       6 in base 3 is 20 and
+#       6 in base 4 is 12.
+# 
+# Example 3:
+# 
+# 	Input: $n = 8
+# 	Output: 1
+# 
+# 	Since 8 in base 3 is 22.
+# 
+# MY NOTES: ok, so "same digits" really means "a single digit repeated
+# throughout the entire string".  Sounds pretty easy.
+# Added debugging mode to produce and display the "Since" messages,
+# formatted nicely.  Then added tabulate mode to show the first N
+# Brazilian numbers (this interoperates nicely with -d).
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Function::Parameters;
+#use Data::Dumper;
+
+my $debug=0;
+my $tabulate=0;
+die "Usage: is-brazilian-number [--debug] [--tabulate] N\n" unless
+	GetOptions( "debug" => \$debug, "tabulate" => \$tabulate ) && @ARGV==1;
+
+
+#
+# my $basestr = inbase($n,$b);
+#	Return the "in base $b" representation of $n, as a string of
+#	the form n1-n2-n3-....  Where n1 is the first base $b digit,
+#	n2 the second and so on.  This avoids having to convert base $b
+#	digits > 9 into a..z etc.
+#
+fun inbase( $n, $b )
+{
+	die "inbase($n,base $b): $b must be >1\n"
+		if $b<2;
+
+	my @x;
+	while( $n>0 )
+	{
+		push @x, $n % $b;
+		$n = int($n/$b);
+	}
+	return join('-',reverse @x);
+}
+
+
+
+#
+# my $isrepeated = repeated($dashstr);
+#	Return 1 if $dashstr is of the form x-x-x...x
+#	for some value of x.  Otherwise return 0.
+#
+fun repeated( $dashstr )
+{
+	my @x = split(/-/, $dashstr);
+	die "repeated: dashstr $dashstr has no '-'s\n"
+		if @x==0;
+	my $n = shift @x;
+	foreach my $v (@x)
+	{
+		return 0 if $v != $n;
+	}
+	return 1;
+}
+
+
+
+#
+# my( $isbraz, $sincemsg ) = isbrazilian( $n );
+#	Return ( 1, mesg ) iff $n is a brazilian number, as defined
+#	above.  Otherwise return ( 0, mesg ).  The message is the
+#	"Since" message shown above in the examples, nicely formatted.
+#
+fun isbrazilian( $n )
+{
+	my @out;
+	foreach my $b (2..$n-2)
+	{
+		my $basestr = inbase($n,$b);
+		my $msg = "$n in base $b is $basestr";
+		if( repeated($basestr) )
+		{
+			return (1, "Since $msg");
+		}
+		push @out, $msg;
+	}
+	my $wholemesg = "Since ". join(', ', @out). ".";
+	$wholemesg =~ s/, ([^,]+)$/ and $1/;
+	$wholemesg =~ s/,/\n     /g;
+	$wholemesg =~ s/ and / and\n      /g;
+	return (0, $wholemesg );
+}
+
+
+my $n = shift;
+die "brazilian-number: n ($n) must be > 3\n" unless $n>3;
+
+if( $tabulate )
+{
+	my $found=0;
+	for( my $i=4; $found<$n; $i++ )
+	{
+		my( $isbraz, $sincemesg ) = isbrazilian( $i );
+		next unless $isbraz;
+		say "$i is brazilian";
+		say "    $sincemesg" if $debug;
+		$found++;
+	}
+} else
+{
+	my( $isbraz, $sincemesg ) = isbrazilian( $n );
+	say "Input $n";
+	say "Output $isbraz";
+	say $sincemesg if $debug;
+}