James Curtis-Smith

Here are solutions to this weeks challenges from the Perl Weekly Challenge.

You can find my full code on Github

Nth root

You are given positive numbers $N and $k.

Write a script to find out the $Nth root of $k.

The solution

I decided that I would not go the easy way this week and just use the power function ** i.e. return $k**(1/$N).

Instead for integer values of $N, solve this with only using the simple mathematical operators +, /, *, -, <, >

To do this we will use a divide and conquer solution, starting at the two ends of the interval we calculate the values of x^N, and then iterate reducing the interval in half - choosing the interval where the value of x^N is less than k at the left hand end & x^N is greater than k.

To do this we store the value of the ends of the interval as l and r respectively and computer the Nth power of each (ln & rn).

We then do the same for the midpoint m = (l+r)/2

We replace the left values with the new mid values if m^N > k, and if not replace the right values with the mid values

The interval halves in size each time - so repeat until the gap is small..

sub nth_root {
  my( $n, $k ) = @_;
  sub pow {
    my $res = 1;
    $res *= $_[0] foreach 1..$_[1];
    return $res;
  }
  my $l = 0;
  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));
  while( $r-$l > 1e-10) {
    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;
}

You will note a quirky bit of code that defines the initial r - rather than choosing the right hand side of the interval we note that we can guess a better r based purely on the length of the string. e.g. when N = 5, we know that if k < 100_000 then the Nth route must be less than 10, if k < 10_000_000_000 then the Nth root is less than 100.

We can extrapolate this by dividing the length of the string representation of k by N to get the approximate max value represented by 1 and a number of 0s.

The name game

I will leave you to read the description on the challenge itself or the wiki page https://en.wikipedia.org/wiki/The_Name_Game

The simple rule states that if your name starts with a consonant that is stripped and substituted in different places,

There are special rules for b, f, m,

If the word starts with vowels, you strip the vowels and the first consonant

There are also rules defined that you remove the first syllable - but as finding syllables is difficult I will avoid this.

We will use 2 nice features of Perl this week

• The one I use quite a lot which is the regex modifier to return the replaced string
  But note $1 etc are defined as when doing a match so you can still use them, in this case we use it to handle the special cases where the letter removed is one of b, f or m.
• sprintf - with %1$... substitutions.
  Normally we just use %s to specify where to insert each entry in the parameters into the substitution string - but you can specify which parameter goes where by add int n between the % and the definition.
  This allows us repeat substitution strings without duplicating them in the list passed in, and/or change the order of the substitution. This is really useful if you have a series of templates you wish to choose from.

  
  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);
  
  sub the_name_game {
  
    return sprintf $TEMPLATE,
  
      $_[0], $_[0]=~s{$REGEX}{}ri,
  
      map { $_ eq lc $1?'':$_ } qw(b f m);
  
  }