imported my solutions to this week's tasks... stashes and typeglobs, fun

4 files changed, 260 insertions, 32 deletions

diff --git a/challenge-107/duncan-c-white/README b/challenge-107/duncan-c-white/README
index e2e541033b..4073520658 100644
--- a/challenge-107/duncan-c-white/README
+++ b/challenge-107/duncan-c-white/README
@@ -1,48 +1,65 @@
-Task 1: "Nth root
+Task 1: "Self-descriptive Numbers
 
-You are given positive numbers $N and $k.
+Write a script to display the first three self-descriptive numbers. As per wikipedia, the definition of Self-descriptive Number is
 
-Write a script to find out the $Nth root of $k. For more information,
-please take a look at
-https://en.wikipedia.org/wiki/Nth_root#Computing_principal_roots
+    In mathematics, a self-descriptive number is an integer m that in a
+    given base b is b digits long in which each digit d at position n (the
+    most significant digit being at position 0 and the least significant
+    at position b-1) counts how many instances of digit n are in m.
 
-Example
+For example:
 
-	Input: $N = 5, $k = 248832
-	Output: 12
+ 1210 is a four-digit self-descriptive number:
 
-	Input: $N = 5, $k = 34
-	Output: 2.02
-"
+    position 0 has value 1 i.e. there is only one 0 in the number
+    position 1 has value 2 i.e. there are two 1 in the number
+    position 2 has value 1 i.e. there is only one 2 in the number
+    position 3 has value 0 i.e. there is no 3 in the number
+
+Output
 
-My notes: ok, dull but easy, using the Newton-Raphson Method.
+    1210, 2020, 21200
+
+WARNING: I realised just before the launch this task was also part of the week
+43 and contributed by Laurent Rosenfeld. It is too late to change now. Feel
+free to share your previous solutions if you took part in the week 43
+already. I should have been more carefull, sorry.
+"
 
+My notes: well, as it happened I skipped task 43, so let's have a go.  The
+important thing is: number of digits == base, which puts extra constraints
+on the digits.  So try bases b = 2.. try all base b numbers for "self-
+descriptiveness" and then and stop after finding the first N self-descriptive
+numbers.  Let's take N as a command line input for generality, default 3.
 
-Task 2: "The Name Game
 
-You are given a $name.
+Task 2: "List Methods
 
-Write a script to display the lyrics to the Shirley Ellis song The Name
-Game. Please checkout https://en.wikipedia.org/wiki/The_Name_Game
-for more information.
+Write a script to list methods of a package/class.
 
 Example
 
-  Input: $name = "Katie"
-  Output:
+package Calc;
+
+use strict;
+use warnings;
+
+sub new { bless {}, shift; }
+sub add { }
+sub mul { }
+sub div { }
+
+1;
+
+Output
 
-    Katie, Katie, bo-batie,
-    Bonana-fanna fo-fatie
-    Fee fi mo-matie
-    Katie!
+BEGIN
+mul
+div
+new
+add
 "
 
-My notes: wtf?  are we reduced to ill-defined childhood rhymes now?
-use simple rules:
-- remove first consonant from name if the first letter is a consonant,
-- otherwise leave the name alone.
-- if the removed consonant was b, f or m, then (respectively) bo-b
-  becomes bo-, fo-f becomes fo-, and mo-m becomes mo-
-- ignore the "no indication what to do with names like Anita where the stress
-  falls on a later syllable" problem, as that was in one cover version, so
-  I claim it's not part of the official rules.
+My notes: hmm, introspection.  I genuinely can't remember how to do this
+without a but of googling.  Isn't there a symbol table hash per package,
+that Memoize manipulates?  Ah yes: the stash containing typeglobs.
diff --git a/challenge-107/duncan-c-white/perl/Calc.pm b/challenge-107/duncan-c-white/perl/Calc.pm
new file mode 100644
index 0000000000..c70b2405a5
--- /dev/null
+++ b/challenge-107/duncan-c-white/perl/Calc.pm
@@ -0,0 +1,13 @@
+package Calc;
+
+use strict;
+use warnings;
+
+our $x = 1;
+
+sub new { bless {}, shift; }
+sub add { }
+sub mul { }
+sub div { }
+
+1;
diff --git a/challenge-107/duncan-c-white/perl/ch-1.pl b/challenge-107/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..bef0ea36d6
--- /dev/null
+++ b/challenge-107/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,121 @@
+#!/usr/bin/perl
+# 
+# Task 1: "Self-descriptive Numbers
+# 
+# Write a script to display the first three self-descriptive numbers. As
+# per wikipedia, the definition of Self-descriptive Number is
+# 
+#     In mathematics, a self-descriptive number is an integer m that in a
+#     given base b is b digits long in which each digit d at position n (the
+#     most significant digit being at position 0 and the least significant
+#     at position b-1) counts how many instances of digit n are in m.
+# 
+# For example:
+# 
+#  1210 is a four-digit self-descriptive number:
+# 
+#     position 0 has value 1 i.e. there is only one 0 in the number
+#     position 1 has value 2 i.e. there are two 1 in the number
+#     position 2 has value 1 i.e. there is only one 2 in the number
+#     position 3 has value 0 i.e. there is no 3 in the number
+# 
+# Output
+# 
+#     1210, 2020, 21200
+# 
+# WARNING: I realised just before the launch this task was also part of week
+# 43, contributed by Laurent Rosenfeld. It is too late to change now. Feel
+# free to share your previous solutions if you took part in the week 43
+# already. I should have been more careful, sorry.
+# "
+# 
+# My notes: well, as it happened I skipped task 43, so let's have a go.  The
+# important thing is: number of digits == base, which puts extra constraints
+# on the digits.  So try bases b = 2.. try all base b numbers for "self-
+# descriptiveness" and then and stop after finding the first N self-descriptive
+# numbers.  Let's take N as a command line input for generality, default 3.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Function::Parameters;
+use Data::Dumper;
+
+my $debug=0;
+die "Usage: selfdescriptive [--debug] [N]\n"
+	unless GetOptions( "debug" => \$debug ) && @ARGV<2;
+
+my $n = shift // 3;
+
+# find first $n self-descriptive numbers
+
+my $found = 0;
+
+#
+# my $issd = selfdescriptive($digitseq);
+#	Determine whether the given digit sequence is
+#	a self descriptive number; return 1 for yes, 0 for no.
+#
+fun selfdescriptive( $digitseq )
+{
+	my @occ = (0) x length($digitseq);
+	# compute number of occurences of digit (index)
+	foreach my $dig (split(//,$digitseq))
+	{
+		$occ[$dig]++;
+	}
+	#die "ds=$digitseq, occ=", Dumper \@occ;
+
+	for( my $pos = length($digitseq)-1; $pos>=0; $pos-- )
+	{
+		my $dig = substr($digitseq,$pos,1);
+		return 0 unless $occ[$pos] == $dig;
+	}
+
+	return 1;
+}
+
+
+
+#
+# my $iplus1 = inc_base_overflow( $n, $b );
+#	Increment digit sequence $n in base $b.
+#	Return "" if $d+1 overflows the current number of digits
+#
+fun inc_base_overflow( $n, $b )
+{
+	my $l = length($n);
+	for( my $pos = $l-1; $pos>=0; $pos-- )
+	{
+		my $dig = substr($n,$pos,1);
+		if( $dig < $b-1 )
+		{
+			$dig++;
+			substr($n,$pos,1) = $dig;
+			return $n;
+		}
+		substr($n,$pos,1) = "0";
+	}
+	return "";
+}
+
+
+for( my $b = 2; $found < $n; $b++ )
+{
+	my $i = "0" x $b;
+	for(;;)
+	{
+		if( selfdescriptive($i) )
+		{
+			say $i;
+			last if ++$found == $n;
+		}
+		#say "$i";
+
+		# now increment digitseq $i in base $b
+		$i = inc_base_overflow( $i, $b );
+		last if $i eq "";
+	}
+}
diff --git a/challenge-107/duncan-c-white/perl/ch-2.pl b/challenge-107/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..9748058c01
--- /dev/null
+++ b/challenge-107/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,77 @@
+#!/usr/bin/perl
+# 
+# Task 2: "List Methods
+# 
+# Write a script to list methods of a package/class.
+# 
+# Example
+# 
+# package Calc;
+# 
+# use strict;
+# use warnings;
+# 
+# sub new { bless {}, shift; }
+# sub add { }
+# sub mul { }
+# sub div { }
+# 
+# 1;
+# 
+# Output
+# 
+# BEGIN
+# mul
+# div
+# new
+# add
+# "
+# 
+# My notes: hmm, introspection.  I genuinely can't remember how to do this
+# without a but of googling.  Isn't there a symbol table hash per package,
+# that Memoize manipulates?  Ah yes: the stash containing typeglobs.  For
+# some reason I can't get BEGIN to appear, so I cheat and add it manually:-)
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+use Getopt::Long;
+use Data::Dumper;
+
+my $debug = 0;
+die "Usage: subs [--debug] Module\n"
+	unless GetOptions("debug"=>\$debug) && @ARGV==1;
+
+my $module = shift;
+
+use lib qw(.);
+
+eval "require $module" || die "can't require $module\n";
+
+my @sub = findsubs( $module );
+say for @sub;
+exit 0;
+
+
+#
+# my @subs = findsubs( $module );
+#	Find all the subroutines inside $module. Return a list of them.
+#	Couldn't get BEGIN to appear (although perlmod suggested it would)
+#	so added it explicitly:-)
+#
+fun findsubs( $module )
+{
+	my @result = ("BEGIN");
+	our %stash;
+	no strict 'refs';
+	*stash = *{"${module}::"};
+	while( my( $symbol,$glob) = each %stash )
+	{
+		#say "symbol=$symbol, glob=",Dumper($glob);
+		push @result, $symbol if defined *{$glob}{CODE};
+	}
+	use strict 'refs';
+	return @result;
+}