Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

3 files changed, 102 insertions, 8 deletions

diff --git a/challenge-004/duncan-c-white/README b/challenge-004/duncan-c-white/README
index d6a6cb2f04..c5628c24dd 100644
--- a/challenge-004/duncan-c-white/README
+++ b/challenge-004/duncan-c-white/README
@@ -1,8 +1,24 @@
-I have investigated Challenge 1 (the Regular numbers) reasonably thoroughly,
-building and comparing 4 iterative solutions to generate them.  I also
-investigated a Lazy List version, storing the tail of the list as a promise -
-a function to call when you wanted the next head item, and the returned tail
-is another promise - to generate the next item later when needed.  However,
-I couldn't get that to work so abandoned it:-)
-
-Challenge 2 (Pascal's Triangle) by contrast is pretty basic and simple-minded.
+Challenge 1: "Write a script to output the same number of PI digits
+as the size of your script. Say, if your script size is 10, it should
+print 3.141592653."
+
+Note that it DOESN'T SAY "calculate the same number of PI digits..." so
+I took the liberty to grab them over the internet (via a bitly link I set
+up to shorten the URL and hence the program) rather than generate them
+on the fly, because generating Pi is so dull.
+
+Note that ch-1.pl takes an optional single command line argument to tell
+how many digits to print, if absent the default is to use the size of
+the script as the question wanted.  I built two cut down versions of the
+script, but didn't include them here.
+
+
+Challenge 2: "You are given a file containing a list of words (case
+insensitive 1 word per line) and a list of letters. Print each word from
+the file than can be made using only letters from the list. You can use
+each letter only once (though there can be duplicates and you can use
+each of them once), you don't have to use all the letters."
+
+This is a natural "bag of words" question, essentially we need to build
+a "bag subset" operation.  See ch-2.pl for the solution, simple and obvious
+(I love Perl's hashes especially for their idiomatic set and bag uses).
diff --git a/challenge-004/duncan-c-white/perl5/ch-1.pl b/challenge-004/duncan-c-white/perl5/ch-1.pl
new file mode 100755
index 0000000000..8e00dfd020
--- /dev/null
+++ b/challenge-004/duncan-c-white/perl5/ch-1.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+# Display Pi to N places, where N is the size of this file, to the byte.
+# The spec didn't say "Calculate Pi..." so stuff that, grab the digits
+# we need off the internet:-)
+
+use strict;
+use warnings;
+use Data::Dumper;
+use LWP::Simple;
+
+my $size = shift // -s $0;
+$size++;
+
+my $url = "http://bit.ly/2GnSY4L";
+my $f = "/tmp/pi1m";
+unless(-f $f)
+{
+	getstore($url,$f) || die "can't retrieve $url\n";
+}
+open(my $infh, '<', $f) || die "can't open $f\n";
+sysread($infh, my $content, $size);
+
+print "$content\n";
diff --git a/challenge-004/duncan-c-white/perl5/ch-2.pl b/challenge-004/duncan-c-white/perl5/ch-2.pl
new file mode 100755
index 0000000000..e351986a94
--- /dev/null
+++ b/challenge-004/duncan-c-white/perl5/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+#
+#	wordbag question:
+#
+#	You are given a file containing a list of words (case insensitive 1 word
+#	per line) and a list of letters. Print each word from the file than can
+#	be made using only letters from the list. You can use each letter only
+#	once (though there can be duplicates and you can use each of them once),
+#	you don't have to use all the letters. (Disclaimer: The challenge was
+#	proposed by Scimon Proctor)
+#
+#	This is a natural "bag of words" question, essentially we need to build
+#	a "bag subset" operation.
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+die "Usage: ch-2pl letters < wordlist\n" unless @ARGV;
+
+my %letterbag;		# letter -> frequency of that letter
+map { $letterbag{$_}++ } map { split(//,lc($_)) } @ARGV;
+
+
+#
+# my $ok = word_ok( $word, %letterbag );
+#	Return 1 iff every letter in $word is present in %letterbag,
+#	and not present more times in $word than in %letterbag.
+#
+sub word_ok
+{
+	my( $word, %letterbag ) = @_;
+
+	# build a bag of the letters in the word, lowercased
+	my %bag2;
+	map { $bag2{$_}++ } split( //, lc($word) );
+
+	# reject word if any letter in bag2 is not present at all in
+	# letterbag, or is present more times in bag2 than in letterbag
+	while( my( $letter, $bag2_freq ) = each %bag2 )
+	{
+		my $letterbag_freq = $letterbag{$letter} // 0;
+		return 0 if $bag2_freq > $letterbag_freq;
+	}
+	return 1;
+}
+
+
+# for every word on stdin, print it out if it's an answer
+while( <STDIN> )
+{
+	chomp;
+	print "$_\n" if word_ok( $_, %letterbag );
+}