Merge pull request #5801 from dcw803/master

imported my solutions to this week's tasks.. 2 nice ones

3 files changed, 242 insertions, 46 deletions

diff --git a/challenge-156/duncan-c-white/README b/challenge-156/duncan-c-white/README
index 5279605b40..3ddc10f2b9 100644
--- a/challenge-156/duncan-c-white/README
+++ b/challenge-156/duncan-c-white/README
@@ -1,66 +1,52 @@
-TASK #1 - Fortunate Numbers
+TASK #1 - Pernicious Numbers
 
-Write a script to produce first 8 Fortunate Numbers (unique and sorted).
+Write a script to permute first 10 Pernicious Numbers.
 
-According to Wikipedia
+A pernicious number is a positive integer which has prime number of ones
+in its binary representation.
 
-A Fortunate number, named after Reo Fortune, is the smallest integer m >
-1 such that, for a given positive integer n, pn# + m is a prime number,
-where the primorial pn# is the product of the first n prime numbers.
+The first pernicious number is 3 since binary representation of 3 =
+(11) and 1 + 1 = 2, which is a prime.
 
 Expected Output
 
-3, 5, 7, 13, 17, 19, 23, 37
+3, 5, 6, 7, 9, 10, 11, 12, 13, 14
 
-MY NOTES: ok.  Note that the Wikipedia article is not clear whether the
-Nth Fortunate number is the smallest integer m>1 s.t. pN# + m is prime,
-or whether that Nth value found is **A* Fortunate number, but the Fortunate
-numbers themselves are sorted and have duplicates removed - and the Nth
-Fortunate number is the Nth term of the sorted and deduped list.  I think
-we want the latter, because the unsorted Fortunate numbers corresponding to
-pn# for n=1..8 are 3, 5, 7, 13, 23, 17, 19, 23, i.e. they are not sorted and
-contain a duplicate of 23.
+MY NOTES: ok.  Pretty easy.  pernicious(n) = isprime(countones(binary(n)))
 
-Once you sort and dedup these, you get the desired sequence
-3, 5, 7, 13, 17, 19, 23, 37
 
-HOWEVER, it's not obvious how many unsorted Fortunate numbers we have
-to calculate to know that we've found the first N sorted ones.  Let's keep
-going until we have found N distinct Fortunate numbers and then sort them.
-Is it possible for a later unsorted Fortunate number to be smaller
-than one of the ones we've # found so far?  Yes, blast it:
-The output of this program for N=1 is 3,5,7,13,17,19,23,37,61,67,71
-and for N=12 is 3,5,7,13,17,19,23,37,47,61,67,71
-(showing that the 12th distinct value found is 47, smaller than the 9th..11th
-distinct value found)
+TASK #2 - Weird Number
 
-Also, this program won't work for N>12 because the primorial values get so
-enormous, like factorials.  I tried bigint but that slowed everything down
-so much that I couldn't find the answers in the time I had available.
+You are given number, $n > 0.
 
+Write a script to find out if the given number is a Weird Number.
 
-TASK #2 - Pisano Period
+According to Wikipedia, it is defined as:
 
-Write a script to find the period of the 3rd Pisano Period.
+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.
 
-In number theory, the nth Pisano period, written as pi(n), is the period
-with which the sequence of Fibonacci numbers taken modulo n repeats.
+Example 1:
 
-The Fibonacci numbers are the numbers in the integer sequence:
+	Input: $n = 12
+	Output: 0
 
-0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, ...
+Since the proper divisors of 12 are 1, 2, 3, 4, and 6, which sum to 16;
+but 2 + 4 + 6 = 12.
 
-For any integer n, the sequence of Fibonacci numbers F(i) taken modulo
-n is periodic. The Pisano period, denoted pi(n), is the value of the
-period of this sequence. For example, the sequence of Fibonacci numbers
-modulo 3 begins:
+Example 2:
 
-0, 1, 1, 2, 0, 2, 2, 1,
-0, 1, 1, 2, 0, 2, 2, 1,
-0, 1, 1, 2, 0, 2, 2, 1, ...
+	Input: $n = 70
+	Output: 1
 
-This sequence has period 8, so pi(3) = 8.
+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.
 
-MY NOTES: ok.  Once we've found a sequence of length L that immediately
-repeats, i.e. that the first 2L entries comprise the same length L sequence
-repeated twice, How do we know that this sequence repeats forever?
+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).
diff --git a/challenge-156/duncan-c-white/perl/ch-1.pl b/challenge-156/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..f13af703e1
--- /dev/null
+++ b/challenge-156/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+# 
+# TASK #1 - Pernicious Numbers
+# 
+# Write a script to permute first 10 Pernicious Numbers.
+# 
+# A pernicious number is a positive integer which has prime number of ones
+# in its binary representation.
+# 
+# The first pernicious number is 3 since binary representation of 3 =
+# (11) and 1 + 1 = 2, which is a prime.
+# 
+# Expected Output
+# 
+# 3, 5, 6, 7, 9, 10, 11, 12, 13, 14
+# 
+# MY NOTES: ok.  Pretty easy.  pernicious(n) = isprime(countones(binary(n)))
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+#use bigint;
+use Function::Parameters;
+use Getopt::Long;
+#use Data::Dumper;
+
+#use lib qw(.);
+#use MakePrimes;
+
+my $debug=0;
+die "Usage: first-n-pernicious [--debug] [N default 10]\n"
+	unless GetOptions( "debug"=>\$debug ) && @ARGV<2;
+my $n = shift // 10;
+
+
+my %isprime;		# values we've tested and found to be prime
+my %tested;		# values we've tested - whether or not they're prime
+
+$tested{1} = 1;
+$isprime{1} = 0;
+
+#
+# my $isprime = isprime( $x );
+#	Return 1 iff $x is prime.  Memoize the ones we know.
+#
+fun isprime( $x )
+{
+	return $isprime{$x} if $tested{$x};
+
+	$tested{$x}++;
+	$isprime{$x} = 0;
+	my $lim = int(sqrt($x));
+	for( my $i=2; $i<=$lim; $i++ )
+	{
+		return 0 if $x % $i == 0;
+	}
+	$isprime{$x} = 1;
+	return 1;
+}
+
+
+#
+# my $nones = num_ones_binary( $x );
+#	Convert $x to a binary string, count the number of "1" bits
+#	in that string, and return the total.  eg num_ones_binary(11) = 3
+#	(because binary(11) = 1011, containing 3 ones)
+#
+fun num_ones_binary( $x )
+{
+	my @x = split( //, sprintf( "%b", $x ) );
+	#say "n_o_b($x): ". join(',',@x);
+	my $n = grep { $_ == 1 } @x;
+	#say "n_o_b($x): result $n";
+	return $n;
+}
+
+
+my @pern;
+
+for( my $i = 3; @pern<$n; $i++ )
+{
+	my $nones = num_ones_binary($i);
+	push @pern, $i if isprime($nones);
+}
+
+say join(',', @pern);
diff --git a/challenge-156/duncan-c-white/perl/ch-2.pl b/challenge-156/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..8a489a5d6d
--- /dev/null
+++ b/challenge-156/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,123 @@
+#!/usr/bin/perl
+# 
+# TASK #2 - Weird Number
+# 
+# You are given number, $n > 0.
+# 
+# Write a script to find out if the given number is a Weird Number.
+# 
+# According to Wikipedia, it is defined as:
+# 
+# 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
+# 
+# Since the proper divisors of 12 are 1, 2, 3, 4, and 6, which sum to 16;
+# but 2 + 4 + 6 = 12.
+# 
+# Example 2:
+# 
+# 	Input: $n = 70
+# 	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.
+# 
+# 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).
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Function::Parameters;
+#use Data::Dumper;
+use List::Util qw(sum0);
+
+my $debug=0;
+my $tabulate=0;
+die "Usage: is-weird [--debug] [--tabulate] N\n" unless
+	GetOptions( "debug" => \$debug, "tabulate" => \$tabulate ) && @ARGV==1;
+
+
+#
+# my @divs = divisors_inc_1( $n );
+#	Return the array of perfect divisors (including 1). 
+#
+fun divisors_inc_1( $n )
+{
+	my @result;
+	my $limit = $n/2;
+	for( my $i=1; $i<=$limit; $i++ )
+	{
+		push @result, $i if $n%$i==0;
+	}
+	return @result;
+}
+
+
+#
+# my $isweird = weird( $n );
+#	Return 1 iff $n is weird; 0 otherwise
+#
+fun weird( $n )
+{
+	my @divs = divisors_inc_1( $n );
+	#say "w($n): divs: ", join(',',@divs);
+
+	my $sum = sum0(@divs);
+	#say "w($n): sum of divisors $sum";
+	return 0 if $sum < $n;
+
+	#say "w($n): sum=$sum";
+
+	my $nitems = @divs;
+
+	my $two2n = 2**$nitems;
+
+	for( my $i=0; $i<$two2n; $i++ )
+	{
+		my $b = sprintf("%0${nitems}b", $i );
+		my @select = split( //, $b );
+
+		my @chosen = map { $divs[$_] }
+			grep { $select[$_] } 0..$#divs;
+		$sum = sum0(@chosen);
+		say "w($n): b=$b, select=", join(',',@select),
+		    ", chosen=", join(',',@chosen),
+		    ", sum=$sum" if $debug;
+
+		return 0 if $sum == $n;
+	}
+
+	#say "$n is weird";
+	return 1;
+}
+
+my $n = shift;
+if( $tabulate )
+{
+	my $found=0;
+	for( my $i=2; $found<$n; $i++ )
+	{
+		my $isweird = weird( $i );
+		next unless $isweird;
+		say "$i: weird";
+		$found++;
+	}
+} else
+{
+	my $isweird = weird( $n );
+	say "$n: weird? $isweird";
+}