Perl Advent Calendar 2009-12-02

New Winter Spectator Sport - Thongs & Toboggans

by Bill 'N1VUX' Ricker

I have confessed previously to using Perl to cheat at the NPR Sunday Puzzle. Some of my successes were not elegant, for instance my original solution for

Think of a familiar 9-letter word, in which the first letter immediately follows the 9th in the alphabet. The 2nd letter immediately follows the 8th in the alphabet. The 3rd immediately follows the 7th, and the 4th immediately follows the 6th.

For example: SPECTATOR (S follows R, and P follows O). Unfortunately, the pattern breaks down with the remaining letters.

Hint: The word is used most often in the TV and film industry.

What word is it?

-- WESun Puzzlemaster Challenge, 2002-10-20

required explicit looping with indices, looks like C or Fortran.

Modules such as Tie::CharArray List::Util and List::MoreUtils ¹ can modernize the code nicely. Tie::CharArray provides tie my @C, 'Tie::CharArray', $_; to alias the chars of the string, such that array elements assigned to change the string, so better than split "" for some uses. The chars(), codes() forms are shorthand and in a for (chars($_)) loop still aliases. Here I am using codes() to replace map {ord} split. Likewise from reduce {} pairwise {} to replace explicit loop logic ².

3 bethesda
4 offscreen
3 thongs
3 toboggans
3 tuffets
3 tumults

mod02.pl

   1 #! perl -ls
   2 
   3 use Tie::CharArray qw/chars codes/;
   4 use List::Util qw/reduce max/;
   5 use List::MoreUtils qw/pairwise/;
   6 
   7 my $m        = $count || shift || 3;
   8 my $filename = $fn    || shift || "enable1.txt";
   9 $length ||= 2 * $m;    ## Strictly puzzle  calls for eq 9
  10 
  11 open my $DICT, $filename or die "file open $filename $! ";
  12 
  13 while (<$DICT>) {
  14     chop while /\s/;
  15     next if length() < $length or /^[A-Za]/ or /\W/;    #impossible
  16     my @N  = codes($_); 
  17     my @RN = reverse @N;
  18 
  19     my $match = (
  20         reduce {
  21             !$a->[-1]
  22               ? $a
  23               : [ $a->[0] + $b, $b ];
  24         }
  25         [ 0, 1 ],    # inject total zero, continue one
  26         pairwise { ( $a - $b ) == 1 } @N,
  27         @RN
  28     )->[0];
  29 
  30     print "$match $_" if $match >= $m;
  31 
  32 }
  33 close DICT;
  34 

1. List::AllUtils combines List::Util and List::MoreUtils, though it's a bit of a misnomer because it excludes List::EvenMoreUtils.

2. Normally one expects implicit loops to be faster than for(@A) loops than for($i=;;) loops, but here the copying for reverse etc defeat the speed-up, it runs 2-3x slower.