Merge pull request #583 from dcw803/master

hi manwar, early solutions - including the api question this time

7 files changed, 360 insertions, 42 deletions

diff --git a/challenge-022/duncan-c-white/perl5/LZW.pm b/challenge-022/duncan-c-white/perl5/LZW.pm
index 5dac1ca36e..b2ff41a4e0 100644
--- a/challenge-022/duncan-c-white/perl5/LZW.pm
+++ b/challenge-022/duncan-c-white/perl5/LZW.pm
@@ -180,11 +180,9 @@ fun lzw_decode( $binstr )
 	my $ndict = @newdict;
 	print "decoding first $b, pos=$pos, ndict=$ndict\n" if $debug;
 
-
 	die "LZW_decode: first bin $b (pos $pos) not in dict, $ndict entries\n" unless $pos<$ndict;
 
 	my $prevf = $newdict[$pos];	# previous text fragment
-
 	my $result = $prevf;
 
 	while( $binstr )
@@ -199,30 +197,22 @@ fun lzw_decode( $binstr )
 
 		my $ndict = @newdict;
 
-		my $f;		# current decoded text fragment
+		die "decode: bad pos $pos (dictionary has $ndict ".
+		    "entries) result=$result, b=$b, ".
+		    "binstr=$binstr)\n" if $pos > $ndict;
 
-		# if pos in dict?
-		if( $pos < $ndict )
-		{
-			$f = $newdict[$pos];
-		} elsif( $pos == $ndict )
-		{
-			$f = $prevf . substr($prevf,0,1);
-		} else
-		{
-			die "decode: bad pos $pos (dictionary has $ndict ".
-			    "entries) result=$result, b=$b, ".
-			    "binstr=$binstr)\n";
-		}
+		my $f = $pos < $ndict ?    # current decoded text fragment
+				$newdict[$pos] :
+				$prevf . substr($prevf,0,1);
 
-		# ok, so $b represents text frag $f
+		# ok, so encoded $b represents decoded text frag $f
 		print "b $b, pos=$pos, prevf=$prevf, f=$f\n" if $debug;
 
 		$result .= $f;
 
-		# the next entry in the dictionary must be the WHOLE of
-		# the previous fragment plus the FIRST letter of the
-		# current fragment $f
+		# the next entry in the dictionary is the WHOLE of
+		# the previous fragment $prevf, plus the FIRST letter
+		# of the current fragment $f
 		my $new = $prevf . substr($f,0,1);
 
 		$pos = @newdict;
diff --git a/challenge-022/duncan-c-white/perl5/testlzw.pl b/challenge-022/duncan-c-white/perl5/testlzw.pl
index efb86814fc..ad80a147bf 100755
--- a/challenge-022/duncan-c-white/perl5/testlzw.pl
+++ b/challenge-022/duncan-c-white/perl5/testlzw.pl
@@ -50,11 +50,11 @@ foreach (1..$n)
 	my $text = make_random_string( $len );
 	my $binstr = lzw_encode( $text );
 	$text .= '#';
-	print "\ntext: $text\n";
+	print "text: $text\n";
 	#print "  encodes to: $binstr\n";
 	my $text2 = lzw_decode( $binstr );
 	#print "  which decodes to: $text2\n";
-	print "  encodes+decodes to: $text2\n" if 0;
+	#print "  encodes+decodes to: $text2\n";
 	die "text $text -> encodes to $binstr -> decodes to $text2\n"
 		unless $text eq $text2;
 }
diff --git a/challenge-023/duncan-c-white/README b/challenge-023/duncan-c-white/README
index 9abc0d15e2..4cd2bbfe01 100644
--- a/challenge-023/duncan-c-white/README
+++ b/challenge-023/duncan-c-white/README
@@ -1,20 +1,36 @@
-Challenge 1: "Write a script to print first 10 Sexy Prime Pairs. Sexy
-primes are prime numbers that differ from each other by 6. For example,
-the numbers 5 and 11 are both sexy primes, because 11 - 5 = 6. The term
-"sexy prime" is a pun stemming from the Latin word for six: sex."
-
-My notes: Clearly defined, yet another prime-based task, sounds very
-easy - let's have a go..
-
-
-Challenge 2: "Write a script to implement Lempel-Ziv-Welch (LZW)
-compression algorithm. The script should have method to encode/decode
-algorithm. The wiki page
-https://en.wikipedia.org/wiki/Lempel%E2%80%93Ziv%E2%80%93Welch
-explains the compression algorithm very nicely."
-
-My notes: I read the wiki page, perhaps without concentrating enough.
-Looks complicated, especially the decoding part.  Also, what's not
-quite clear is what initial alphabet both encoding and decoding should
-use?  but let's have a go, hopefully building an encoder will clarify
-most things?
+Challenge 1: "Create a script that prints nth order forward difference
+series. You should be a able to pass the list of numbers and order number
+as command line parameters. Let me show you with an example:
+
+Suppose we have list (X) of numbers: 5, 9, 2, 8, 1, 6 and we would like
+to create 1st order forward difference series (Y). So using the formula
+Y(i) = X(i+1) - X(i), we get the following numbers: (9-5), (2-9), (8-2),
+(1-8), (6-1), ie 4, -7, 6, -7, 5.
+If you noticed, it has one less number than the original series.
+Similarly you can generate the 2nd order forward difference series like:
+(-7-4), (6+7), (-7-6), (5+7) => -11, 13, -13, 12.
+
+My notes: Clearly defined, very easy - let's have a go..
+
+
+Challenge 2: "Create a script that prints Prime Decomposition of a
+given number. The prime decomposition of a number is defined as a list
+of prime numbers which when all multiplied together, are equal to that
+number. For example, the Prime decomposition of 228 is 2,2,3,19 as 228 =
+2 * 2 * 3 * 19."
+
+My notes: So, prime factors then.  Very easy again.  In fact, haven't I
+already solved this in one of the other prime-based questions?
+
+
+Challenge 3: "Write a script to use Random Poems API:
+https://www.poemist.com/api/v1/randompoems
+This is the easiset API, I have come across so far. You don't need API
+key for this. They have only route to work with (GET). The API task is
+optional but we would love to see your solution."
+
+My notes: ok, even I can't argue that obtaining an API key for an API
+I will literally never use again is too much hassle - when I don't need
+an API key, and the whole program appears to be an LWP::Simple get..
+
+update: well, apart from the Unicode in the response, complicating life.
diff --git a/challenge-023/duncan-c-white/perl5/MakePrimes.pm b/challenge-023/duncan-c-white/perl5/MakePrimes.pm
new file mode 100644
index 0000000000..7261977c57
--- /dev/null
+++ b/challenge-023/duncan-c-white/perl5/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-023/duncan-c-white/perl5/ch-1.pl b/challenge-023/duncan-c-white/perl5/ch-1.pl
new file mode 100755
index 0000000000..c47e7cc0d8
--- /dev/null
+++ b/challenge-023/duncan-c-white/perl5/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+#
+# Challenge 1: "Create a script that prints nth order forward difference
+# series. You should be a able to pass the list of numbers and order number
+# as command line parameters. Let me show you with an example:
+# 
+# Suppose we have list (X) of numbers: 5, 9, 2, 8, 1, 6 and we would like
+# to create 1st order forward difference series (Y). So using the formula
+# Y(i) = X(i+1) - X(i), we get the following numbers: (9-5), (2-9), (8-2),
+# (1-8), (6-1), ie 4, -7, 6, -7, 5.
+# If you noticed, it has one less number than the original series.
+# Similarly you can generate the 2nd order forward difference series like:
+# (-7-4), (6+7), (-7-6), (5+7) => -11, 13, -13, 12.
+# 
+# My notes: Clearly defined, very easy - let's have a go..
+#
+# Example runs:
+#
+# ./ch-1.pl 1 5 9 2 8 1 6
+# 4,-7,6,-7,5
+#
+# ./ch-1.pl 2 5 9 2 8 1 6
+# -11,13,-13,12
+#
+# ./ch-1.pl 3 5 9 2 8 1 6
+# 24,-26,25
+# 
+
+use v5.10;	# to get "say"
+use strict;
+use warnings;
+use Function::Parameters;
+#use Data::Dumper;
+
+die "Usage: ch-1.pl N SEQ\n" if @ARGV<2;
+my $n = shift;
+die "ch-1.pl: N ($n) must be >0\n" if $n<=0;
+my @seq = @ARGV;
+my $nseq = @seq;
+die "ch-1.pl: sequence (@seq) must be at least $n long\n" if $nseq < $n;
+
+foreach (1..$n)
+{
+	@seq = find_diffs( @seq );
+}
+say join(',',@seq);
+
+#
+# my @diff = find_diffs( @seq );
+#	Find the 1st order differences between every element in @seq,
+#	i.e. return a 1 element shorter list seq[1]-seq[0], seq[2]-seq[1]...
+#
+fun find_diffs( @seq )
+{
+	die "find_diffs: empty sequence given\n" if @seq==0;
+
+	# nb: for every position EXCEPT THE LAST
+	my @result = map { $seq[$_+1]-$seq[$_]; } 0..$#seq-1;
+
+	return @result;
+}
diff --git a/challenge-023/duncan-c-white/perl5/ch-2.pl b/challenge-023/duncan-c-white/perl5/ch-2.pl
new file mode 100755
index 0000000000..32dc922612
--- /dev/null
+++ b/challenge-023/duncan-c-white/perl5/ch-2.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+#
+# Challenge 2: "Create a script that prints Prime Decomposition of a
+# given number. The prime decomposition of a number is defined as a list
+# of prime numbers which when all multiplied together, are equal to that
+# number. For example, the Prime decomposition of 228 is 2,2,3,19 as 228 =
+# 2 * 2 * 3 * 19."
+# 
+# My notes: So, prime factors then.  Very easy again.  In fact, haven't I
+# already solved this in one of the other prime-based questions?
+# 
+
+use v5.10;	# for "say"
+use strict;
+use warnings;
+use Function::Parameters;
+#use Data::Dumper;
+
+use lib qw(.);	# I hate this!
+use MakePrimes;
+
+die "Usage: ch-2.pl N\n" unless @ARGV == 1;
+my $n = shift;
+
+my @primes = primes_upto( $n );
+my @factors = factorise( $n, @primes );
+say "prime factors of $n are: ", join(',',@factors);
+
+
+#
+# my @factors = factorise( $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. factorise( 228 ) = 2,2,3,19
+#
+fun factorise( $n, @primes )
+{
+	die "factorise: 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;
+}
diff --git a/challenge-023/duncan-c-white/perl5/ch-3.pl b/challenge-023/duncan-c-white/perl5/ch-3.pl
new file mode 100755
index 0000000000..107e504623
--- /dev/null
+++ b/challenge-023/duncan-c-white/perl5/ch-3.pl
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+#
+# Challenge 3: "Write a script to use Random Poems API:
+# https://www.poemist.com/api/v1/randompoems
+# This is the easiset API, I have come across so far. You don't need API
+# key for this. They have only route to work with (GET). The API task is
+# optional but we would love to see your solution."
+# 
+# My notes: ok, even I can't argue that obtaining an API key for an API
+# I will literally never use again is too much hassle - when I don't need
+# an API key, and the whole program appears to be an LWP::Simple get, and
+# a bit of JSON decoding magic.
+#
+# Once I had the array of random poems decoded (an array of hashes), I
+# wondered what to do with them all, so I decided to show you a list of
+# title, poet, and content length for each poem, and let you choose which
+# poem to see (or quit).
+#
+# However, a few of the poems seem to be in Unicode and utterly screw up my
+# terminal, and I'm not sure how to handle Unicode.  As a quick hack I've run
+# the whole content through Encode's decode('UTF-8'..) first.  That didn't
+# remove all the weird high-bytes that screw up my terminal, so I wrote a
+# sanitize() routine to delete all high-bytes.  For some random Chinese
+# poem, there's basically nothing left, but at least my terminal survives.
+# 
+
+use v5.10;	# to get "say"
+use strict;
+use warnings;
+use LWP::Simple;
+use JSON;
+use Encode;
+use Function::Parameters;
+#use Data::Dumper;
+
+
+die "Usage: ch-3.pl\n" unless @ARGV==0;
+my $content = decode( 'UTF-8',
+	get( "https://www.poemist.com/api/v1/randompoems" ) );
+my $list = decode_json( $content );
+
+my @poems = map { sanitize($_->{content}); } (@$list);
+
+listpoems( $list );
+
+my $n = @poems;
+while(1)
+{
+	print "\nShow poem 1..$n (or list, or quit)? ";
+	my $input = <STDIN>;
+	chomp $input;
+
+last if $input =~ /^q/i;
+
+	if( $input =~ /^l/i )
+	{
+		listpoems( $list );
+		next;
+	}
+	if( $input >= 1 && $input <= @poems )
+	{
+		my $content = $poems[$input-1];
+		say "\n$content\n";
+	} else
+	{
+		print "bad poem number $input\n";
+	}
+}
+
+
+#
+# listpoems( $list );
+#	List all the titles of the poems
+#
+fun listpoems( $list )
+{
+	my $n = 1;
+	foreach my $poem (@$list)
+	{
+		my $url = $poem->{url};
+		my $poet = $poem->{poet}->{name};
+		my $poeturl = $poem->{poet}->{url};
+		my $title = sanitize( $poem->{title} );
+		my $content = sanitize( $poem->{content} );
+
+		# count the number of lines in the content..
+		my $nlines = ($content =~ tr/\n//) + 1;
+
+		print "\n$n: $title ($url) by $poet ($poeturl) - length $nlines\n";
+		$n++;
+	}
+}
+
+#
+# my $str = sanitize( $input );
+#	In a desperate attempt to avoid displaying Unicode messages
+#	screwing up my terminal, let's simply: delete all bytes > 127
+#
+fun sanitize( $input )
+{
+	my $result = "";
+	foreach my $ch (split(//,$input))
+	{
+		$result .= $ch if ord($ch)<128;
+	}
+	return $result;
+}
+
+