added in first pass - #1 not using ** or log; #2 with consonant and b/f/m rule applied

2 files changed, 82 insertions, 0 deletions

diff --git a/challenge-105/james-smith/perl/ch-1.pl b/challenge-105/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..2c51155994
--- /dev/null
+++ b/challenge-105/james-smith/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+is( 1*nth_root(5,248832),12);
+is( 1*nth_root(5,34),    2.02439746);
+
+done_testing();
+
+sub nth_root {
+  my( $n, $k ) = @_;
+  sub pow {
+    my $res = 1;
+    $res *= $_[0] foreach 1..$_[1];
+    return $res;
+  }
+  ## Not going to use any of the high level maths here as
+  ## We could easily write this as $k**(1/$n);
+
+  ## We will use a simple binary search - where we start with
+  ## two values "l" and "r";
+  ## and each time cut the region in 2. Which ever half "k" is
+  ## in we move either "l" or "r" to the mid value and repeat
+
+  my $l = 0;
+
+  ## Tweak to quickly chose a better r...
+  ## If k has less than n digits it can't be greater than 10
+  ## If k has less than 2n digits it can't be greater than 100
+  ## .... So we can optimize the value of r - to speed things
+  ## up slightly...
+
+  my $r = '1'.'0'x (1+ int(length(int $k)/$n) );
+     $r = $k if $r>$k;
+
+  my $m; # This is the midpoint...
+  my($ln,$rn) = (1, pow($r,$n));
+
+  ## Table of savings....
+  ##    r #steps (for n=5)  #steps without opt delta saving
+  ##   10     37 k < 100_000                50    13    35%
+  ##  100     40 k < 10_000_000_000         67    27    40%
+  ## 1000     44 k < 1_000_000_000_000_000  84    40    48%
+
+  while( $r-$l > 1e-10) { ## Repeat until the interval is small
+    my $mn = pow($m = ($r+$l)/2,$n);
+    if($mn<$k) {
+      ($l,$ln) = ($m,$mn);
+      next;
+    }
+    ($r,$rn) = ($m,$mn);
+  }
+  return sprintf '%0.8f',$m;
+}
+
diff --git a/challenge-105/james-smith/perl/ch-2.pl b/challenge-105/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..27e7c525b6
--- /dev/null
+++ b/challenge-105/james-smith/perl/ch-2.pl
@@ -0,0 +1,23 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+my $TEMPLATE = '%1$s, %1$s, bo-%3$s%2$s
+Bonana-fanna fo-%4$s%2$s
+Fee fi mo-%5$s%2$s
+%1$s!
+
+';
+my $REGEX = '^[aeiou]*([bcdfghjklmnpqrstvwxyz])';
+
+print map { the_name_game( $_ ) } qw(Katie Lucy James Bob Fred Mike Aaron Abel);
+#done_testing();
+
+sub the_name_game {
+  return sprintf $TEMPLATE, $_[0], $_[0]=~s{$REGEX}{}ri, map { $_ eq lc $1?'':$_ } qw(b f m);
+}
+