Merge pull request #234 from dcw803/master

hi Manwar, please find my solutions to this week's challenges, and belatedly by solutions to a couple of previous ones..

9 files changed, 585 insertions, 33 deletions

diff --git a/challenge-008/duncan-c-white/README b/challenge-008/duncan-c-white/README
index fb3a863c80..7adef4a715 100644
--- a/challenge-008/duncan-c-white/README
+++ b/challenge-008/duncan-c-white/README
@@ -1,14 +1,16 @@
-Challenge 1: "Create a script which takes a list of numbers from
-command line and print the same in the compact form. For example, if
-you pass 1,2,3,4,9,10,14,15,16 then it should print the compact form
-like 1-4,9,10,14-16.."
+Challenge 1: "Write a script that computes the first five perfect
+numbers. A perfect number is an integer that is the sum of its positive
+proper divisors (all divisors except itself). Please check Wiki for
+more information.  First 4 are 6, 28, 496 and 8128"
 
-Quite simple and dull problem. But ok, let's have a go.
+My notes: Cute little problem, let's have a go.
 
-Challenge 2: "Create a script to calculate Ramanujan's constant with at
-least 32 digits of precision."
 
-Never heard of this constant, seems to be e^(pi*sqrt(163)), which is
-"very nearly an integer", I don't particularly care about abtruse mathematical
-formulae.  But ok, Perl's built in module biggrat will let you do this anyway,
-specifying accuracy 32; see ch-2.sh for the oneliner.
+Challenge 2: "Write a function, center, whose argument is a list of
+strings, which will be lines of text. The function should insert spaces
+at the beginning of the lines of text so that if they were printed,
+the text would be centered, and return the modified lines."
+
+My notes:
+
+Another well-specified problem:-)
diff --git a/challenge-008/duncan-c-white/perl5/ch-1.pl b/challenge-008/duncan-c-white/perl5/ch-1.pl
new file mode 100755
index 0000000000..5dcc9cfc12
--- /dev/null
+++ b/challenge-008/duncan-c-white/perl5/ch-1.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+# Challenge 1: "Write a script that computes the first five perfect
+# numbers. A perfect number is an integer that is the sum of its positive
+# proper divisors (all divisors except itself). Please check Wiki for
+# more information.  First 4 are 6, 28, 496 and 8128"
+
+
+use strict;
+use warnings;
+use Function::Parameters;
+use Data::Dumper;
+
+die "Usage: ch-1.pl [N|5]]\n" if @ARGV > 1;
+
+
+#
+# my $isprime = is_prime( $x );
+#	Return true iff the integer $x is prime.
+fun is_prime( $x )
+{
+	my $limit = int(sqrt($x));
+	#print "is_prime($x): limit=$limit\n";
+	foreach my $i (2..$limit)
+	{
+		return 0 if $x % $i == 0;
+	}
+	return 1;
+}
+
+
+
+
+my $limit = shift // 5;
+
+for( my $p=2, my $found=0; $found<$limit; $p++ )
+{
+	if( is_prime( $p ) )
+	{
+		my $twop1 = 2**($p-1);
+		my $twop = 2*$twop1;
+		my $twopminus1 = $twop-1;
+		if( is_prime( $twopminus1 ) )
+		{
+			print "$p is prime and 2^$p-1 ($twopminus1) is prime\n";
+			my $perfect = ($twop-1) * $twop1;
+			print "  so $perfect (2^$p-1 * 2^(p-1) is perfect\n";
+			$found++;
+		}
+		else
+		{
+			print "$p is prime but 2^$p-1 ($twopminus1) is not prime\n";
+		}
+	}
+}
diff --git a/challenge-008/duncan-c-white/perl5/ch-2.pl b/challenge-008/duncan-c-white/perl5/ch-2.pl
new file mode 100755
index 0000000000..d813df3174
--- /dev/null
+++ b/challenge-008/duncan-c-white/perl5/ch-2.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+# Challenge 2: "Write a function, center, whose argument is a list of
+# strings, which will be lines of text. The function should insert spaces
+# at the beginning of the lines of text so that if they were printed,
+# the text would be centered, and return the modified lines."
+
+use strict;
+use warnings;
+use Function::Parameters;
+use File::Slurp;
+use Data::Dumper;
+
+die "Usage: ch-2.pl [DATAFILE]\n" if @ARGV > 1;
+my $datafilename = shift // $0;
+
+
+#
+# my $maxlen = maxlength( @data );
+#       Find and return the maximum length of any string
+#       element of @data.
+#
+fun maxlength( @data )
+{
+        my $maxlen = 0;
+        foreach my $s (@data)
+        {
+                my $l = length($s);
+                $maxlen = $l if $l>$maxlen;
+        }
+        return $maxlen;
+}
+
+
+#
+# my @centred = center( @data );
+#       Center every element of @data, building
+#       and returning a new @centred array, in
+#       which every element is the original element
+#       of @data, padded with leading spaces to centere it.
+#
+fun center( @data )
+{
+        my @result;
+        my $maxlen = maxlength( @data );
+        foreach my $s (@data)
+        {
+                my $l = length($s);
+                my $pad = ($maxlen - $l)/2;
+                my $centred = (' 'x$pad).$s;
+                push @result, $centred;
+        }
+        return @result;
+}
+
+
+my @data = read_file( $datafilename );
+my @centered = center( @data );
+map { print } @centered;
diff --git a/challenge-010/duncan-c-white/README b/challenge-010/duncan-c-white/README
index fb3a863c80..2384fb220f 100644
--- a/challenge-010/duncan-c-white/README
+++ b/challenge-010/duncan-c-white/README
@@ -1,14 +1,27 @@
-Challenge 1: "Create a script which takes a list of numbers from
-command line and print the same in the compact form. For example, if
-you pass 1,2,3,4,9,10,14,15,16 then it should print the compact form
-like 1-4,9,10,14-16.."
+Challenge 1: "Write a script to encode/decode Roman numerals. For example,
+given Roman numeral CCXLVI, it should return 246. Similarly, for decimal
+number 39, it should return XXXIX."
 
-Quite simple and dull problem. But ok, let's have a go.
+My notes: That's a nice problem, let's have a go.
 
-Challenge 2: "Create a script to calculate Ramanujan's constant with at
-least 32 digits of precision."
 
-Never heard of this constant, seems to be e^(pi*sqrt(163)), which is
-"very nearly an integer", I don't particularly care about abtruse mathematical
-formulae.  But ok, Perl's built in module biggrat will let you do this anyway,
-specifying accuracy 32; see ch-2.sh for the oneliner.
+Challenge 2: "Write a to find Jaro-Winkler distance between two strings."
+
+My notes:
+
+WTF is Jaro-Winkler, read wikipedia page, well Jaro-Winkler is a
+simple prefix adjustment to the Jaro distance, but the wikipedia page
+explaining Jaro distances is not very clear - it describes it in terms
+of matched characters and transposed characters, but it's description
+of matching within a range, and of how to count transposed characters
+is almost completely unclear.  I couldn't write code based on such a
+poor description!
+
+But googling further, Rosetta Stone had various implementations in
+various languages (including C and Perl), which clarifies the terribly
+unclear wikipedia entry.  Ok, I basically understand it now.  Transposed
+characters are matching characters that are diferent, eg TH vs HT
+
+So I'll have a go anyway, although I ran out of time to do it in the
+weekly challenge (and I screwed up the git side of things, so couldn't
+submit it late either).
diff --git a/challenge-010/duncan-c-white/perl5/ch-1.pl b/challenge-010/duncan-c-white/perl5/ch-1.pl
new file mode 100755
index 0000000000..b981956516
--- /dev/null
+++ b/challenge-010/duncan-c-white/perl5/ch-1.pl
@@ -0,0 +1,116 @@
+#!/usr/bin/perl
+
+# Challenge 1: "Write a script to encode/decode Roman numerals. For example,
+# given Roman numeral CCXLVI, it should return 246. Similarly, for decimal
+# number 39, it should return XXXIX."
+
+
+use strict;
+use warnings;
+use Function::Parameters;
+use Data::Dumper;
+
+
+#
+# my $roman = oneroman( $digit, $one, $five, $ten );
+#	Given a single $digit (0..9), build and return
+#	the roman-numeral equivalent, using $one, $five and $ten,
+#	the roman-numeral equivalents of 1, 5 and 10.  If those were
+#	'I', 'V' and 'X', the roman-numerals equivalents of each digit
+#	are '', I, II, III, IV, V, VI, VII, VIII, IX
+#
+fun oneroman( $digit, $one, $five, $ten )
+{
+	return $one x $digit if $digit<4;	        # 0..3
+	return "$one$five" if $digit==4;	        # 4
+	return $five.($one x ($digit-5)) if $digit<9;   # 5..9
+	return "$one$ten";				# 9
+}
+
+
+#
+# my $roman = toroman( $n );
+#	Given $n, a positive integer from 1..3999,
+#	convert it to a roman-numeral string, eg 246 => CCXLVI
+#
+fun toroman( $n )
+{
+	die "toroman: $n should be 1..3999\n" if $n<1 || $n>3999;
+
+	my $roman = '';
+
+	# deal with the thousands..
+	my $m = int($n/1000);
+	$roman = ( 'M' x $m );
+	$n %= 1000;
+
+	# deal with the hundreds..
+	$roman .= oneroman( int($n/100), 'C', 'D', 'M' );
+	$n %= 100;
+
+	# deal with the tens..
+	$roman .= oneroman( int($n/10), 'X', 'L', 'C' );
+	$n %= 10;
+
+	# deal with the ones..
+	$roman .= oneroman( $n, 'I', 'V', 'X' );
+
+	return $roman;
+}
+
+
+
+#
+# my $n = fromroman( $roman );
+#	Given $roman, a well-formed roman-numeral string,
+#	convert it to an integer.
+#
+fun fromroman( $roman )
+{
+	my $orig = $roman;
+	my $result = 0;
+	$result += 1000 while $roman =~ s/^M//;
+	$result += 900  if    $roman =~ s/^CM//;
+	$result += 500  if    $roman =~ s/^D//;
+	$result += 400  if    $roman =~ s/^CD//;
+	$result += 100  while $roman =~ s/^C//;
+	$result += 90   if    $roman =~ s/^XC//;
+	$result += 50   if    $roman =~ s/^L//;
+	$result += 40   if    $roman =~ s/^XL//;
+	$result += 10   while $roman =~ s/^X//;
+	$result += 9    if    $roman =~ s/^IX//;
+	$result += 5    if    $roman =~ s/^V//;
+	$result += 4    if    $roman =~ s/^IV//;
+	$result += 1    while $roman =~ s/^I//;
+	die "fromroman: roman '$orig' not empty at end, $roman left over\n"
+		if $roman;
+	return $result;
+}
+
+die "Usage: ch-1.pl [N|ROMAN|TEST] [N|ROMAN|TEST]...\n" if @ARGV == 0;
+foreach my $val (@ARGV)
+{
+	if( $val =~ /\d/ )
+	{
+		my $roman = toroman( $val );
+		print "toroman($val) = $roman\n";
+	}
+	elsif( $val eq "TEST" )
+	{
+		# check it works: try converting every number to roman, and
+		# then back again, and checking that you end up with...
+		# "the number you first thought of":-).
+		foreach my $n (1..3999)
+		{
+			my $roman = toroman( $n );
+			my $n2 = fromroman( $roman );
+			die "error: n=$n, roman=$roman, n2=$n2\n" unless $n==$n2;
+			print "toroman($n)=$roman, and fromroman($roman)=$n\n";
+		}
+	}
+	else
+	{
+		my $n = fromroman( $val );
+		print "fromroman($val) = $n\n";
+	}
+}
diff --git a/challenge-010/duncan-c-white/perl5/ch-2.pl b/challenge-010/duncan-c-white/perl5/ch-2.pl
new file mode 100755
index 0000000000..014d2cdf7d
--- /dev/null
+++ b/challenge-010/duncan-c-white/perl5/ch-2.pl
@@ -0,0 +1,204 @@
+#!/usr/bin/perl
+
+# Challenge 2: "Write a to find Jaro-Winkler distance between two strings."
+# 
+# My notes:
+# 
+# WTF is Jaro-Winkler, read wikipedia page, well Jaro-Winkler is a simple prefix
+# adjustment to the Jaro distance, but the wikipedia page explaining Jaro distances
+# is not very clear - it describes it in terms of matched characters and transposed
+# characters, but it's description of matching within a range, and of how to count
+# transposed characters is almost completely unclear.  I couldn't write code based
+# on such a poor description!
+# 
+# But googling further, Rosetta Stone had various implementations in various languages
+# (including C and Perl), which clarifies the terribly unclear wikipedia entry.
+# Matching involves the same char at pos i in str1, and somewhere within match_distance
+# of pos i in str2.  All matched characters are marked.
+#
+# Transpositions are a second phase, looking at all matched characters - if the next
+# pair of matched characters in str1 and str2 are different, that's a transposition.
+# 
+# Ok, I basically understand it now.  Transposed characters are matched characters
+# in different positions, eg TH vs HT
+
+
+use strict;
+use warnings;
+use Function::Parameters;
+use Data::Dumper;
+use List::Util qw(min max);
+
+
+#
+# my $m = matches( $w1, $w2, $l1, $l2, $match_distance, $m1, $m2 );
+#	Compute $m, the number of exact matches within $w1 and $w2 (of
+#	lengths $l1 and $l2), within $match_distance positions of each other,
+#	and build up @$m1 and @$m2, arrays of matched positions in both strings.
+#
+fun matches( $w1, $w2, $l1, $l2, $match_distance, $m1, $m2 )
+{
+	# number of matches
+	my $m = 0.0;
+
+	# look throughout $w1 at every position $i
+	for( my $i = 0; $i < $l1; $i++)
+	{
+		# start and end take into account the match distance
+		my $start = max(0, $i - $match_distance);
+		my $end = min($i + $match_distance + 1, $l2);
+
+		# forevery possible matching pos k in w2
+		for( my $k = $start; $k < $end; $k++)
+		{
+			# find first str2[k] not matched
+			next if $m2->[$k];
+
+			# where w[i] eq w2[k]
+			if( substr($w1,$i,1) eq substr($w2,$k,1) )
+			{
+				# found a match
+				$m1->[$i] = 1;
+				$m2->[$k] = 1;
+				$m++;
+				last;
+			}
+		}
+	}
+
+	return $m;
+}
+
+
+#
+# my $t = transpositions( $w1, $w2, $l1, $l2, $m1, $m2 );
+#	Compute $t, the number of matches transpositions within $w1 and $w2 (of
+#	lengths $l1 and $l2), using @$m1 and @$m2, arrays of matched positions in
+#	both strings.
+#
+fun transpositions( $w1, $w2, $l1, $l2, $m1, $m2 )
+{
+	my $t = 0.0;
+
+	my $k = 0;
+	# foreach matched position i in w1
+	for( my $i = 0; $i < $l1; $i++)
+	{
+		next unless $m1->[$i];
+
+		# find next matched position in w2
+		$k++ while !$m2->[$k];
+
+		# increment t if chars different
+		$t++ if substr( $w1,$i,1) ne substr($w2,$k,1);
+
+		$k++;
+	}
+
+	# divide the number of t by two as per the algorithm specs
+	return ($t/2);
+}
+
+
+#
+# my $jsim = jaro_sim($str1, $str2);
+#	Plain Jaro similarity of $str1 and $str2.
+#
+fun jaro_sim( $str1, $str2 )
+{
+	# matching should happen as follows, building m1[] and m2[]
+
+	my $l1 = length($str1);
+	my $l2 = length($str2);
+  
+	# if both strings are empty return 1
+	# if only one of the strings is empty return 0
+	if( $l1 == 0 )
+	{
+		return $l2 == 0 ? 1.0 : 0.0;
+	}
+  
+	# max distance between two chars to be considered matching
+	my $match_distance = int( max($l1, $l2) / 2 ) - 1;
+
+	my @m1;
+	my @m2;
+	my $m = matches( $str1, $str2, $l1, $l2, $match_distance, \@m1, \@m2 );
+	my $t = transpositions( $str1, $str2, $l1, $l2, \@m1, \@m2 );
+
+	# return the Jaro similarity
+	my $s = (($m / $l1) + ($m / $l2) + (($m - $t) / $m)) / 3.0;
+	#printf( "s1=$str1, s2=$str2, l1=$l1, l2=$l2, match_distance=$match_distance, m=%f, t=%f\n",
+	#	$m, $t );
+	return $s;
+}
+
+
+#
+# my $jdist = jaro_dist($str1, $str2);
+#	Jaro distance between $str1 and $str2.
+#
+fun jaro_dist( $str1, $str2 )
+{
+	my $jsim = jaro_sim( $str1, $str2 );
+	printf( "jsim=%f\n", $jsim );
+	return 1.0 - $jsim;
+}
+
+
+#
+# my $jwsim = jarowinkler_sim($str1, $str2);
+#	Jaro-Winkler similarity of $str1 and $str2,
+#
+fun jarowinkler_sim( $str1, $str2 )
+{
+	my $jsim = jaro_sim( $str1, $str2 );
+	my $prefixlen=0;
+	my $i=0;
+	while( substr($str1,$i,1) eq substr($str2,$i,1) )
+	{
+		$prefixlen++;
+		$i++;
+	}
+	$prefixlen = min(4,$prefixlen);
+	#print "prefixlen=$prefixlen\n";
+	my $p = 0.1;
+	return $jsim - $prefixlen*$p*(1.0-$jsim);
+}
+
+
+#
+# my $jwdist = jarowinkler_dist($str1, $str2);
+#	Jaro-Winkler distance between $str1 and $str2.
+#
+fun jarowinkler_dist( $str1, $str2 )
+{
+	my $jwsim = jarowinkler_sim( $str1, $str2 );
+	#printf( "jwsim=%f\n", $jwsim );
+	return 1.0 - $jwsim;
+}
+
+
+die "Usage: jaro-winkler-dist ALL | jaro-winkler-dist WORD1 WORD2\n"
+	unless (@ARGV==1 && $ARGV[0] eq "ALL") || @ARGV==2;
+my $w1 = shift;
+if( $w1 ne "ALL" )
+{
+	my $w2 = shift;
+	my $jdist = jarowinkler_dist($w1, $w2);
+	printf( "jarowinkler-dist($w1,$w2) = %.6f\n", $jdist );
+}
+else
+{
+	my @data = (
+		[ "CRATE",    "TRACE" ],
+		[ "MARTHA",    "MARHTA" ],
+		[ "DIXON",     "DICKSONX" ],
+		[ "JELLYFISH", "SMELLYFISH" ],
+	);
+	foreach my $pair (@data)
+	{
+		my( $w1, $w2 ) = @$pair;
+		printf("jdiff($w1,$w2)=%.6f\n", jarowinkler_dist($w1,$w2));
+	}
+}
diff --git a/challenge-011/duncan-c-white/README b/challenge-011/duncan-c-white/README
index fb3a863c80..3ff28fa716 100644
--- a/challenge-011/duncan-c-white/README
+++ b/challenge-011/duncan-c-white/README
@@ -1,14 +1,24 @@
-Challenge 1: "Create a script which takes a list of numbers from
-command line and print the same in the compact form. For example, if
-you pass 1,2,3,4,9,10,14,15,16 then it should print the compact form
-like 1-4,9,10,14-16.."
+Challenge 1: "Write a script that computes the equal point in the Fahrenheit and Celsius scales, knowing that the freezing point of water is 32 °F and 0 °C, and that the boiling point of water is 212 °F and 100 Â,"
 
-Quite simple and dull problem. But ok, let's have a go.
+My notes: Isn't that just Maths?  solve F = 9/5C + 32 for F==C?
 
-Challenge 2: "Create a script to calculate Ramanujan's constant with at
-least 32 digits of precision."
+C = 9/5C + 32 => 4/5C = -32 => C = 5/4 x -32 = 5 x -8 = -40
 
-Never heard of this constant, seems to be e^(pi*sqrt(163)), which is
-"very nearly an integer", I don't particularly care about abtruse mathematical
-formulae.  But ok, Perl's built in module biggrat will let you do this anyway,
-specifying accuracy 32; see ch-2.sh for the oneliner.
+But if I have to "compute" something that I should obviously "solve by
+algebra", could I do some sort of "where do two lines intersect" solver?
+Let's have a go.
+
+
+Challenge 2: "Write a script to create an Indentity Matrix for the given
+size. For example, if the size is 4, then create Identity Matrix 4x4."
+
+My notes:
+
+Surely that's incredibly straight forward.  The identity matrix has 1s
+on the leading diagonal and 0s everywhere else.  But should we create
+it in memory as a 2-D array and print that out, or just print out the
+identity matrix?  Let's choose the latter as it's simpler and more direct,
+even though the former approach would be more useful in real life, as
+presumably this is going to be one operation in a more general Matrix
+class/module [really, these questions need to be BETTER SPECIFIED to
+clarify this sort of thing]
diff --git a/challenge-011/duncan-c-white/perl5/ch-1.pl b/challenge-011/duncan-c-white/perl5/ch-1.pl
new file mode 100755
index 0000000000..8597a87110
--- /dev/null
+++ b/challenge-011/duncan-c-white/perl5/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+# Challenge 1: "Write a script that computes the equal point in the
+# Fahrenheit and Celsius scales, knowing that the freezing point of water
+# is 32 °F and 0 °C, and that the boiling point of water is 212 °F and
+# 100."
+#
+# My notes: Isn't that just Maths?  solve F = 9/5C + 32 for F==C?
+# 
+# C = 9/5C + 32 => 4/5C = -32 => C = 5/4 x -32 = 5 x -8 = -40
+# 
+# But if I have to "compute" something that I should obviously "solve by
+# algebra", could I do some sort of "where do two lines intersect" solver?
+# Let's have a go.
+
+
+use strict;
+use warnings;
+use Function::Parameters;
+use Data::Dumper;
+
+my $c = 0;
+my $delta = 3.0;
+my $epsilon = 0.000001;
+
+#
+# my $f = fahr($c);
+#	Convert celsius $c to fahrenheit $f.
+#
+fun fahr( $c )
+{
+	return 9.0*$c/5.0 + 32;
+}
+
+#
+# my $error = offby( $c );
+#	Compute and return "how far is fahr(c) off by (different from c)"
+#
+fun offby( $c )
+{
+	return abs(fahr($c)-$c);
+}
+
+
+#die "c=0, f=", fahr(0), "\nc=100, f=", fahr(100), "\n";
+
+# compute the intersection point of F = 9/5C + 32 and C = 5/9(F-32),
+# ie. the value of c for which F(c)==c,
+# using the fact that | F(c)-c | diminishes monotonically as we get
+# closer to the solution value of c
+# 
+do {
+	my $sd = ( offby($c-$delta) < offby($c) ) ?  -$delta : $delta;
+	while( offby($c+$sd) < offby($c) )
+	{
+		$c += $sd;
+	}
+	print "c=$c, diff=", offby($c), ", delta=$delta\n";
+	$delta /= 10.0;
+} while( abs( fahr($c)-$c ) > $epsilon );
+
+print "c=$c\n";
diff --git a/challenge-011/duncan-c-white/perl5/ch-2.pl b/challenge-011/duncan-c-white/perl5/ch-2.pl
new file mode 100755
index 0000000000..2662e3b6d6
--- /dev/null
+++ b/challenge-011/duncan-c-white/perl5/ch-2.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+# Challenge 2: "Write a script to create an Indentity Matrix for the given
+# size. For example, if the size is 4, then create Identity Matrix 4x4."
+# 
+# My notes:
+# 
+# Surely that's incredibly straight forward.  The identity matrix has 1s on the
+# leading diagonal and 0s everywhere else.  But should we create it in memory
+# as a 2-D array and print that out, or just print out the identity matrix?
+# Let's choose the latter as it's simpler and more direct, even though the
+# former approach would be more useful in real life, as presumably this is
+# going to be one operation in a Matrix class/module [really, these questions
+# need to be BETTER SPECIFIED to clarify this sort of thing]
+
+die "Usage: ch-2.pl N\n" unless @ARGV == 1;
+
+my $n = shift;
+
+die "ch-2.pl: n ($n) must be > 0\n" unless $n>0;
+
+for( $row=0; $row<$n; $row++ )
+{
+	my $line ='';
+	for( $col=0; $col<$n; $col++ )
+	{
+		my $ch = ($row==$col)?'1':'0';
+		$line .= $ch;
+	}
+	print "$line\n";
+}