Merge pull request #1253 from dcw803/master

please find my solutions - both in perl, ch-2 in postscript as well

5 files changed, 394 insertions, 41 deletions

diff --git a/challenge-047/duncan-c-white/README b/challenge-047/duncan-c-white/README
index 8a4cac1fc2..bc2b8ce427 100644
--- a/challenge-047/duncan-c-white/README
+++ b/challenge-047/duncan-c-white/README
@@ -1,52 +1,29 @@
-Task 1: "Cryptic Message:
+Task 1: "Roman Calculator
 
-The communication system of an office is broken and messages received
-are not completely reliable. To send the message Hello 6 times, it ended
-up sending these following:
+Write a script that accepts two roman numbers and operation. It should
+then perform the operation on the give roman numbers and print the result.
 
-H x l 4 !
-c e - l o
-z e 6 l g
-H W l v R
-q 9 m # o
+For example,
 
-Similarly another day we received a message repeatedly like below:
+perl ch-1.pl V + VI
 
-P + 2 l ! a t o
-1 e 8 0 R $ 4 u
-5 - r ] + a > /
-P x w l b 3 k \
-2 e 3 5 R 8 y u
-< ! r ^ ( ) k 0
+should print
 
-Write a script to decrypt the above repeated message (one message repeated
-6 times).
-
-HINT: Look for characters repeated in a particular position in all six
-messages received.
+XI
 "
 
-My notes: ah, so pick maxfreq letter in each column?
-
-Task #2: "Is the room open?
+My notes: cute, especially given that we did Roman->Int and Int->Roman in
+challenge 10:-).  So convert Roman->Int, Do Op, Int->Roman for the result.
+Added the ability for the user to specify the operands in EITHER Roman
+or Arabic.
 
-There are 500 rooms in a hotel with 500 employees having keys to all the
-rooms. The first employee opened main entrance door of all the rooms. The
-second employee then closed the doors of room numbers 2,4,6,8,10 and
-so on to 500. The third employee then closed the door if it was opened
-or opened the door if it was closed of rooms 3,6,9,12,15 and so on to
-500. Similarly the fourth employee did the same as the third but only
-room numbers 4,8,12,16 and so on to 500. This goes on until all employees
-has had a turn.
+Task #2: "Gapful Numbers
 
-Write a script to find out all the rooms still open at the end.
+Write a script to print first 20 Gapful Numbers greater than or equal
+to 100.  See https://oeis.org/A108343 for details.
+In summary, Gapful Numbers are those numbers >= 100 that are divisible
+by the number formed by their first and last digit.  Numbers up to 100
+trivially have this property and are excluded.  eg. 100 is, because 100%10==0
 "
 
-My notes: sounds pretty easy, two nested for loops, but one of those questions
-where I can't predict in advance what the answer will be.
-
-But having written the naive roomopen[r] based solution, I find that the
-answer is: the open rooms are all the room numbers that are exact squares!
-I'm not sure why, but I then implemented that more directly, with no
-arrays.  I then translated that into Postscript too, see the postscript
-directory:-)
+My notes: cute.  Easy.  Was so easy that I did it in Postscript as well.
diff --git a/challenge-047/duncan-c-white/perl/Roman.pm b/challenge-047/duncan-c-white/perl/Roman.pm
new file mode 100644
index 0000000000..ea7d572ffc
--- /dev/null
+++ b/challenge-047/duncan-c-white/perl/Roman.pm
@@ -0,0 +1,108 @@
+# Back in Challenge 10, task 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."
+# These are my routines toroman(n) and fromroman(r), converted into a module.
+
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+use Test::More;
+#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;
+}
+
+# testroman():
+#
+fun testroman()
+{
+	# check toroman() and fromroman() work: try converting every number to roman,
+	# and then back again, checking that you end up with...
+	# i.e "the number you first thought of":-).
+	foreach my $n (1..3999)
+	{
+		my $roman = toroman( $n );
+		my $n2 = fromroman( $roman );
+		is( $n, $n2, "fromroman(toroman($n))==$n" );
+	}
+	done_testing();
+}
+
+
+1;
diff --git a/challenge-047/duncan-c-white/perl/ch-1.pl b/challenge-047/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..593f0df701
--- /dev/null
+++ b/challenge-047/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+#
+# 
+# Task 1: "Roman Calculator
+# 
+# Write a script that accepts two roman numbers and operation. It should
+# then perform the operation on the give roman numbers and print the result.
+# 
+# For example,
+# 
+# perl ch-1.pl V + VI
+# 
+# should print
+# 
+# XI
+# "
+# 
+# My notes: cute, especially given that we did Roman->Int and Int->Roman in challenge 10:-).
+# So convert Roman->Int, Do Op, Int->Roman for the result.
+# 
+
+use feature 'say';
+use strict;
+use warnings;
+use Data::Dumper;
+
+use lib qw(.);
+use Roman;
+
+die "Usage: romancalc R1 OP R2    [R1 and R2 are Roman numerals or integers]\n".
+    "or:    romancalc test\n"
+	unless @ARGV==3 || (@ARGV==1 && $ARGV[0] eq "test");
+
+if( @ARGV==1 && $ARGV[0] eq "test" )
+{
+	testroman();
+	exit 0;
+}
+
+my( $r1, $op, $r2 ) = @ARGV;
+my $origr1 = $r1;
+my $origr2 = $r2;
+
+$r1 = fromroman($r1) if $r1 =~ /^[MCDLXVI]+$/;
+$r2 = fromroman($r2) if $r2 =~ /^[MCDLXVI]+$/;
+
+die "romancalc: bad r1: $r1\n" unless $r1 > 1 && $r1 < 4000;
+die "romancalc: bad r2: $r2\n" unless $r2 > 1 && $r2 < 4000;
+
+my $n = eval "$r1 $op $r2" || die "romancalc: bad operator $op\n";
+$n = int($n);
+
+my $r = toroman($n);
+say "result of $origr1 ($r1) $op $origr2 ($r2): $r ($n)";
diff --git a/challenge-047/duncan-c-white/perl/ch-2.pl b/challenge-047/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..c894655165
--- /dev/null
+++ b/challenge-047/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+#
+# Task #2: "Gapful Numbers
+# 
+# Write a script to print first 20 Gapful Numbers greater than or equal
+# to 100.  See https://oeis.org/A108343 for details.
+# In summary, Gapful Numbers are those numbers >= 100 that are divisible
+# by the number formed by their first and last digit.  Numbers up to 100
+# trivially have this property and are excluded.  eg. 100 is, because 100%10==0
+# "
+# 
+# My notes: cute.  Sounds easy.
+# 
+
+use feature 'say';
+use strict;
+use warnings;
+use Function::Parameters;
+
+#
+# gapful( $i );
+#	Return 1 iff $i is a gapful number >= 100.
+#
+fun gapful( $i )
+{
+	$i =~ /^(\d).*(\d)$/;	# find first and largest digits
+	my $div = 10*$1 + $2;
+	return $i % $div == 0 ? 1 : 0;
+}
+
+
+die "Usage: ch-2.pl [FirstN]\n" if @ARGV>1;
+my $n = shift // 20;
+
+my $found = 0;
+for( my $i = 100; $found<$n; $i++ )
+{
+	next unless gapful( $i );
+	say $i;
+	$found++;
+}
diff --git a/challenge-047/duncan-c-white/postscript/ch-2.ps b/challenge-047/duncan-c-white/postscript/ch-2.ps
new file mode 100644
index 0000000000..ea788c811b
--- /dev/null
+++ b/challenge-047/duncan-c-white/postscript/ch-2.ps
@@ -0,0 +1,173 @@
+%!PS-Adobe-3.0
+%%Pages: 1
+%%EndComments
+%
+%
+% Automatic translation of .dcw file to postscript
+%
+
+
+% Debugging....
+
+% const debuglm: left margin of debug messages
+/debuglm 0.5 72 mul def
+
+% const debugtop: top of debug messages - 11 inches up.
+/debugtop 11 72 mul def
+
+% const debugdown: how far to go down each line
+/debugdown 20 def
+
+
+% debugorigin():
+%	 move to debugging origin
+/debugorigin
+{
+	debuglm debugtop moveto
+	(Debugging log:) show
+	newline
+} bind def
+
+
+% debugnv( name, value );
+%	display name and value on a debug line.
+%	keep this as it's so much simpler than debug() below
+%	and also debug() has commented out invocations to
+%	this throughout it:-)
+/debugnv
+{
+	% initially: stack top: value, name
+	30 0 rmoveto
+	exch		% stack top: name, value
+	show		% show name, stack top: value
+	(: ) show
+	50 string cvs show	% show convert_to_string(value)
+	newline
+} bind def
+
+
+% debugsay( string, array_of_pairs );
+%	display a single message, combining the initial string and then
+%	every pair of items (variable,string) in <array> with no separators.
+%	eg debugsay( (x:), [ x (, y:) y (, z:) z ()] ) produces
+%	"x: value_of_x, y: value_of_y, z: value_of_z"
+/debugsay
+{
+    6 dict begin	% next N items defined are in a local dictionary
+	/array exch def % localize parameter name, removing it from stack
+	/initstr exch def % localize parameter name, removing it from stack
+	/len 0 def	% local variable - length of array
+	/pos 0 def	% local variable - position in array
+	/name () def	% local variable - an array element
+	/value () def	% local variable - next array element
+
+	30 0 rmoveto
+
+	/len array length def
+
+	initstr 50 string cvs show
+
+	% for pos = 0 to $#array step 2
+	0 2 len 1 sub
+	{
+		/pos exch def
+%		(pos) pos debugnv
+
+		% $name = $array[$pos];
+		/name array pos get def
+%		(name) name debugnv
+
+		% $value = $array[$pos+1];
+		/value array pos 1 add get def
+%		(value) value debugnv
+
+		name 50 string cvs show
+		value 50 string cvs show
+	} for
+
+	newline
+
+    end		% local dictionary destroyed here
+
+} def
+
+
+% newline();
+%	go to left margin of next line for debug messages
+/newline
+{
+	currentpoint debugdown sub % decrement Y pos
+	exch pop		% drop old X
+	debuglm exch		% form (debuglm,Y) on stack
+	moveto			% go there!
+} def
+
+
+% str = i2s(n):
+%	 convert n to a string
+/i2s
+{
+	50 string cvs
+} def
+
+
+% result = append( string1, string2 )
+% 	Concatenates two strings together.  Some languages
+%	already know how to do stuff like this!!!
+/append
+{
+	 % Initial stack: s1 s2 <-- top of stack
+         2 copy		% s1 s2 s1 s2
+	 length		% s1 s2 s1 len(s2)
+	 exch		% s1 s2 len(s2) s1
+	 length add	% s1 s2 len(s1)+len(s2)
+         string dup     % s1 s2 r r
+         4 2 roll       % r r s1 s2
+         2 index	% r r s1 s2 r
+	 0		% r r s1 s2 r 0
+	 3 index	% r r s1 s2 r 0 s1
+         putinterval    % strcpy( r+0, s1 )
+         		% r r s1 s2
+         exch		% r r s2 s1
+	 length		% r r s2 len(s1)
+	 exch		% r r len(s1) s2
+	 putinterval	% strcpy( r+len(s1), s2 )
+	 		% return r
+} bind def
+
+
+%%Page: 1 1
+%%PageOrientation: Portrait
+
+/Helvetica-Bold findfont 13 scalefont setfont
+
+debugorigin
+
+/n      20 def 
+/found   0 def 
+/i     100 def 
+{
+	/lower i cvi 10 mod def 
+	/upper i def 
+	{
+		upper 9 le 
+		{
+			exit
+		} if
+		/upper upper 10 div int def 
+	} loop
+	/div 10 upper mul lower add def 
+	i cvi div mod 0 eq
+	{
+		%say "$i"
+		() [i ()] debugsay
+		/found found 1 add def 
+	} if
+	found n ge 
+	{
+		exit
+	} if
+	/i i 1 add def 
+} loop
+
+showpage