Merge pull request #5910 from dcw803/master

2 nice tasks this week, took 1h15m for both basic solutions - then another 10 minutes to add a bonus feature..

5 files changed, 372 insertions, 18 deletions

diff --git a/challenge-159/duncan-c-white/README b/challenge-159/duncan-c-white/README
index becee387dc..c512a02d69 100644
--- a/challenge-159/duncan-c-white/README
+++ b/challenge-159/duncan-c-white/README
@@ -1,30 +1,58 @@
-TASK #1 - Additive Primes
+TASK #1 - Farey Sequence
 
-Write a script to find out all Additive Primes <= 100.
+You are given a positive number, $n.
 
-Additive primes are prime numbers for which the sum of their decimal
-digits are also primes.
+Write a script to compute the Farey Sequence of the order $n, defined as:
+is the sequence of completely reduced fractions, between 0 and 1,
+which have numerators and denominators less than or equal to n,
+arranged in order of increasing size).
 
-Output
+Example 1:
 
-	2, 3, 5, 7, 11, 23, 29, 41, 43, 47, 61, 67, 83, 89
+	Input: $n = 5
+	Output: 0/1, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1/1.
 
-MY NOTES: ok.  Pretty easy.  Reuse my MakePrimes module, and code up
-isprime(n) and isprime(sum_digits(n))
+Example 2:
 
+	Input: $n = 7
+	Output: 0/1, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 2/5, 3/7, 1/2, 4/7,
+	        3/5, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 1/1.
 
-TASK #2 - First Series Cuban Primes
+Example 3:
 
-Write a script to compute first series Cuban Primes <= 1000. Please
-refer to https://en.wikipedia.org/wiki/Cuban_prime
-for more information.
+	Input: $n = 4
+	Output: 0/1, 1/4, 1/3, 1/2, 2/3, 3/4, 1/1.
 
-[That says: p = (y+1)**3 - y**3 for y>0, or p = 3y**2 + 3y + 1 for y>0]
+MY NOTES: ok.  Pretty easy.  Will need a way to reduce fractions, and a way of
+storing that reduced fraction in a set (storing "Num/Denom" should do it).
 
-Output
 
-	7, 19, 37, 61, 127, 271, 331, 397, 547, 631, 919.
+TASK #2 - Moebius Number
 
-MY NOTES: ok.  Not quite clear from Wikipedia page whether 3y**2 + 3y + 1
-for all y>0 is prime, I assume that's not true, so that we have to check
-isprime(3y**2 + 3y + 1)
+You are given a positive number $n.
+
+Write a script to generate the Moebius Number for the given number,
+definition: For any positive integer n, define moeb(n) as:
+
+    moeb(n) = +1 if n is a square-free positive integer with an even
+    	         number of prime factors.
+    moeb(n) = 1 if n is a square-free positive integer with an odd
+    	         number of prime factors.
+    moeb(n) = 0 if n has a squared prime factor.
+
+Example 1:
+
+	Input: $n = 5
+	Output: -1
+
+Example 2:
+
+	Input: $n = 10
+	Output: 1
+
+Example 3:
+
+	Input: $n = 20
+	Output: 0
+
+MY NOTES: ok.  Slightly tricky.
diff --git a/challenge-159/duncan-c-white/perl/MakePrimes.pm b/challenge-159/duncan-c-white/perl/MakePrimes.pm
new file mode 100644
index 0000000000..7261977c57
--- /dev/null
+++ b/challenge-159/duncan-c-white/perl/MakePrimes.pm
@@ -0,0 +1,91 @@
+#
+#	mkprimes module (converted from mkprimes.c)
+#
+
+use strict;
+use warnings;
+use Function::Parameters;
+
+
+my $debug = 0;
+my @foundprimes;	# remember all primes we've found..
+
+
+#
+# my @primes = primes_upto( $n );
+#	Find all primes up to N; return a list of all such primes
+#	(note that 1 is not usually considered a prime)
+#
+fun primes_upto( $n )
+{
+	my @isprime;
+
+	for( my $i=1; $i<=$n; $i++ )
+	{
+		$isprime[$i] = 1;		# initially
+	}
+
+	# now sieve the non-primes out..
+	my $upper = int(sqrt($n));
+	printf( "debug: n=%d, upper=%d\n", $n, $upper ) if $debug;
+	for( my $i=2; $i<=$upper; $i++ )
+	{
+		if( $isprime[$i] )
+		{
+			#printf( "debug: crossing out multiples of %d\n", $i );
+			for( my $j=$i*$i; $j<=$n; $j+=$i )
+			{
+				$isprime[$j] = 0;
+			}
+		}
+	}
+
+	# after sieving, extract the primes
+	my @primes = grep { $isprime[$_] } 2..$n;
+
+	# remember them
+	@foundprimes = @primes;
+
+	return @primes;
+}
+
+
+#
+# my @moreprimes = more_primes( $n, $m );
+#	Need more primes!  Have @foundprimes up to $n, but need
+#	to sieve primes from $n+1..$m, so re-sieve, return
+#	a list of all new primes (in the range $n+1..$m) that we find.
+#
+fun more_primes( $n, $m )
+{
+	my %isprime;
+
+	print "finding more primes from ", $n+1, "..$m\n";
+
+	for( my $i=$n+1; $i<=$m; $i++ )
+	{
+		$isprime{$i} = 1;	# pre-sieving
+	}
+
+	# now sieve the non-primes out..
+	foreach my $prime (@foundprimes)
+	{
+		# find first multiple of $prime > $n
+		my $mult = $prime * (int($n/$prime)+1);
+
+		#print "debug: xo multiples of $prime from $mult to $m\n";
+
+		for( my $j=$mult; $j<=$m; $j+=$prime )
+		{
+			delete $isprime{$j};
+		}
+	}
+
+	# after sieving, extract the primes
+	my @primes = grep { $isprime{$_} } $n+1..$m;
+	push @foundprimes, @primes;
+	return @primes;
+}
+
+
+1;
diff --git a/challenge-159/duncan-c-white/perl/PrimeFactors.pm b/challenge-159/duncan-c-white/perl/PrimeFactors.pm
new file mode 100644
index 0000000000..b2c00e6353
--- /dev/null
+++ b/challenge-159/duncan-c-white/perl/PrimeFactors.pm
@@ -0,0 +1,36 @@
+#
+# Prime factors:
+# 	compute the prime factors of a number.
+#
+
+use v5.10;	# to get "say"
+use strict;
+use warnings;
+use Function::Parameters;
+#use Data::Dumper;
+
+#
+# my @factors = prime_factors( $n, @primes );
+#	Break $n>1 apart into it's PRIME FACTORS (excluding 1),
+#	using @primes as a list of all the prime numbers <= n
+#	Return the list of prime factors, smallest first.
+#	eg. prime_factors( 228 ) = 2,2,3,19
+#
+fun prime_factors( $n, @primes )
+{
+	die "prime_factors: n ($n) must be >1\n" if $n<=1;
+	my @result;
+	foreach my $p (@primes)
+	{
+		while( $n>1 && $n % $p == 0 )
+		{
+			push @result, $p;
+			$n /= $p;
+		}
+		last if $n==1;
+	}
+	return @result;
+}
+
+
+1;
diff --git a/challenge-159/duncan-c-white/perl/ch-1.pl b/challenge-159/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..061c606cf1
--- /dev/null
+++ b/challenge-159/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+# 
+# TASK #1 - Farey Sequence
+# 
+# You are given a positive number, $n.
+# 
+# Write a script to compute the Farey Sequence of the order $n, defined as:
+# is the sequence of completely reduced fractions, between 0 and 1,
+# which have numerators and denominators less than or equal to n,
+# arranged in order of increasing size).
+# 
+# Example 1:
+# 
+# 	Input: $n = 5
+# 	Output: 0/1, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1/1.
+# 
+# Example 2:
+# 
+# 	Input: $n = 7
+# 	Output: 0/1, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 2/5, 3/7, 1/2, 4/7,
+# 	        3/5, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 1/1.
+# 
+# Example 3:
+# 
+# 	Input: $n = 4
+# 	Output: 0/1, 1/4, 1/3, 1/2, 2/3, 3/4, 1/1.
+# 
+# MY NOTES: ok.  Pretty easy.  Will need a way to reduce fractions,
+# and a way of storing that reduced fraction in a set (storing "Num/Denom"
+# should do it).
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use List::Util qw(sum0);
+#use Data::Dumper;
+
+#
+# my( $redn, $redd ) = reduce_fraction( $num, $denom );
+#	Reduce the fraction $num/$denom to it's reduced fractional
+#	form, eg reduce_fraction(9,12) == (3,4).
+#
+sub reduce_fraction ($$)
+{
+	my( $num, $denom ) = @_;
+	foreach my $i (2..$denom)
+	{
+		while( $num % $i == 0 && $denom % $i == 0 )
+		{
+			$num /= $i;
+			$denom /= $i;
+		}
+	}
+	return( $num, $denom );
+}
+
+
+
+my $debug=0;
+die "Usage: farey-sequence [--debug] [N] (default 3)\n"
+	unless GetOptions( "debug"=>\$debug ) && @ARGV<2;
+
+my $n = shift // 3;
+
+my @seq = ("0/1");
+my %seen;		# which "numer/denom" fractions have we already seen?
+
+for( my $denom=$n; $denom>=1; $denom-- )
+{
+	foreach my $num (1..$denom)
+	{
+		my( $redn, $redd ) = reduce_fraction( $num, $denom );
+		say "$num/$denom: reduces to $redn/$redd" if $debug;
+		my $f = "$redn/$redd";
+		push @seq, $f unless $seen{$f};
+		$seen{$f}++;
+	}
+}
+
+@seq = sort {
+	my($an,$ad)=split(m|/|,$a);
+	my($bn,$bd)=split(m|/|,$b);
+	$an/$ad <=> $bn/$bd
+	} @seq;
+
+say join(', ', @seq );
diff --git a/challenge-159/duncan-c-white/perl/ch-2.pl b/challenge-159/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..ae80d2a6df
--- /dev/null
+++ b/challenge-159/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,111 @@
+#!/usr/bin/perl
+# 
+# TASK #2 - Moebius Number
+# 
+# You are given a positive number $n.
+# 
+# Write a script to generate the Moebius Number for the given number,
+# definition: For any positive integer n, define moeb(n) as:
+# 
+#     moeb(n) = +1 if n is a square-free positive integer with an even
+#     	         number of prime factors.
+#     moeb(n) = 1 if n is a square-free positive integer with an odd
+#     	         number of prime factors.
+#     moeb(n) = 0 if n has a squared prime factor.
+# 
+# Example 1:
+# 
+# 	Input: $n = 5
+# 	Output: -1
+# 
+# Example 2:
+# 
+# 	Input: $n = 10
+# 	Output: 1
+# 
+# Example 3:
+# 
+# 	Input: $n = 20
+# 	Output: 0
+# 
+# MY NOTES: ok.  Easy enough.  Reuse MakePrimes and PrimeFactors modules.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Function::Parameters;
+#use Data::Dumper;
+
+use lib qw(.);
+use MakePrimes;
+use PrimeFactors;
+
+my $debug=0;
+my $tabulate=0;
+die "Usage: moebius [--debug] [--tabulate] [N] (default 5)\n"
+	unless GetOptions( "debug"=>\$debug, "tabulate"=>\$tabulate )
+	    && @ARGV<2;
+
+my $n = shift // 5;
+
+
+#
+# my $m = moeb( $n );
+#	Return the Moebius number of $n, as described above.
+#
+fun moeb( $n )
+{
+	my @primes = primes_upto( $n );
+
+	my @factors;
+	@factors = prime_factors( $n, @primes ) if $n>1;
+	@factors = () if $n==1;
+
+	my %factorbag;
+	$factorbag{$_}++ for @factors;
+
+	say "moeb($n): prime factor bag: ",
+		join(', ', map { "$_:$factorbag{$_}" } sort keys %factorbag )
+		if $debug;
+
+	foreach my $f (keys %factorbag)
+	{
+		if( $factorbag{$f}>1 )	# contains a square
+		{
+			say "moeb($n): contains a square: $f, so 0" if $debug;
+			return 0;
+		}
+	}
+
+	my $nfactors = @factors;
+	print "moeb($n); has $nfactors factors: " if $debug;
+	if( $nfactors % 2 == 0 )
+	{
+		say "even, so 1" if $debug;
+		return 1;
+	}
+	say "odd, so -1" if $debug;
+	return -1;
+}
+
+if( $tabulate )
+{
+	my @lines;
+	my $line = '';
+	foreach my $i (1..$n)
+	{
+		$line .= sprintf( "%2d: %2d", $i, moeb($i) );
+		$line .= ', ';
+		if( $i % 10 == 0 )
+		{
+			push @lines, $line;
+			$line = '';
+		}
+	}
+	say for @lines;
+} else
+{
+	say moeb( $n );
+}