Boggle results

[Tony Bowden]

On Mon, Feb 10, 2003 at 02:24:07PM +0000, Jasper McCrea wrote:
> since marty hasn't posted everyone's code, like he said he would (I think),
> would everyone post their code so that I can waste _more_ time taking a gander.

This was written for a slightly different purpose, and is thus
non-optimal. (In particular, it finds ALL the places on the board that
a given word can be played, rather than short-circuiting after the
first one. But fixing that makes the nice recursive map in can_play
much uglier!)

In the version I gave marty the $play variable was defined in the wrong
place, and thus it didn't work!

The have_letters_for() sub is purely for optimisation.

Tony

----

  #!/usr/bin/perl

  use strict;
  use warnings;

  our $play = [
    [1..16],
    [2,5,6],[1,3,5..7],[2,4,6..8],[3,7,8],
    [1,2,6,9,10],[1..3,5,7,9..11],[2..4,6,8,10..12],[3,4,7,11,12],
    [5,6,10,13,14],[5..7,9,11,13..15],[6..8,10,12,14..16],[7,8,11,15,16],
    [9,10,14],[9..11,13,15],[10..12,14,16],[11,12,15]
  ];

  chomp(my @words = <>);
  my $board = [ "-", split //, join "", splice @words, 0, 4 ];
  my %on_board; @on_board{@$board} = ();

  shift @words;

  local $\ = "\n";
  foreach (grep length > 2, @words) {
    next if (my $word = lc $_) =~ /q(?!u)/;
    $word =~ s/qu/q/;
    print if have_letters_for($word) && can_play($board, $word, 0);
  }

  sub have_letters_for {
    my $word = shift;
    while (my $let = chop $word) { return unless exists $on_board{$let} }
    return 1;
  }

  sub can_play {
    my ($board, $word, $posn) = @_;
    if (length $word > 1) {
      my $last = chop $word;
      return map {
        local $board->[$_] = "-";
        can_play($board, $word, $_);
      } can_play($board, $last, $posn);
    }
    return grep $board->[$_] eq $word, @{ $play->[$posn] };
  }