#!/usr/bin/env perl
# $Id: scrab,v 1.5 2009/03/26 22:03:52 friedman Exp $

# TODO: Generate a DAG and search that.
# The current algorithm is very inefficient.

$^W = 1;

use strict;
use Getopt::Long;

my @dictfiles = ($ENV{SCRABDICT},
                 "/com/doc/misc/scrabble/ospd4.txt",
                 "/export/docs/scrabble/ospd4.txt",
                 "$ENV{HOME}/tmp/ospd4.txt",
                 "/usr/share/dict/words"
                );

# The frequency tables aren't in use at the moment,
# but they are a handy reference.
my %game_rules =
  ( scrabble => { frequency => { a =>  9,    k =>  1,    u =>  4,
                                 b =>  2,    l =>  4,    v =>  2,
                                 c =>  2,    m =>  2,    w =>  2,
                                 d =>  4,    n =>  6,    x =>  1,
                                 e => 12,    o =>  8,    y =>  2,
                                 f =>  2,    p =>  2,    z =>  1,
                                 g =>  3,    q =>  1,    _ =>  2,
                                 h =>  2,    r =>  6,
                                 i =>  9,    s =>  4,
                                 j =>  1,    t =>  6, },

                  score     => { a =>  1,    k =>  5,    u =>  1,
                                 b =>  3,    l =>  1,    v =>  4,
                                 c =>  3,    m =>  3,    w =>  4,
                                 d =>  2,    n =>  1,    x =>  8,
                                 e =>  1,    o =>  1,    y =>  4,
                                 f =>  4,    p =>  3,    z => 10,
                                 g =>  2,    q => 10,    _ =>  0,
                                 h =>  4,    r =>  1,
                                 i =>  1,    s =>  1,
                                 j =>  8,    t =>  1, },
                },

    lexulous => { frequency => { a =>  8,    k =>  1,    u =>  3,
                                 b =>  2,    l =>  3,    v =>  2,
                                 c =>  2,    m =>  2,    w =>  2,
                                 d =>  3,    n =>  5,    x =>  1,
                                 e => 11,    o =>  7,    y =>  3,
                                 f =>  2,    p =>  2,    z =>  1,
                                 g =>  2,    q =>  1,    _ =>  2,
                                 h =>  2,    r =>  5,
                                 i =>  8,    s =>  3,
                                 j =>  1,    t =>  5, },

                  score     => { a =>  1,    k =>  6,    u =>  1,
                                 b =>  4,    l =>  1,    v =>  5,
                                 c =>  4,    m =>  4,    w =>  5,
                                 d =>  2,    n =>  1,    x =>  8,
                                 e =>  1,    o =>  1,    y =>  5,
                                 f =>  5,    p =>  4,    z => 12,
                                 g =>  2,    q => 12,    _ =>  0,
                                 h =>  5,    r =>  1,
                                 i =>  1,    s =>  1,
                                 j =>  8,    t =>  2, },
                },
  );

my $opt_rules = $ENV{SCRABRULES} || 'scrabble'; # default rules
my $opt_dict;

use vars qw(*letter_score);
local *letter_score;

sub score
{
  my @let;

  if (@_ > 1) { @let = @_ }
  elsif (ref $_[0] eq 'HASH')
    { @let = map { ($_) x $_[0]->{$_} } keys %{$_[0]} }
  else { @let = split (//, $_[0]) }

  my $sc = 0;
  map { $sc += $letter_score{$_} } @let;
  return $sc;
}

sub letfreq
{
  my @let = split (//, lc shift);
  my %freq;
  map { $freq{$_}++ } @let;
  return \%freq;
}

# Return 1 if a is a subset of b
sub subset
{
  my ($a, $b) = @_;

  while (my ($l, $f) = each %$a)
    {
      return 0 unless ($b->{$l} || 0) >= $f;
    }
  return 1;
}

sub dictfile
{
  return $opt_dict if defined $opt_dict;

  for my $file (@dictfiles)
    {
      return $file if defined $file && -s $file;
    }
}

sub parse_options
{
  local *ARGV = \@{$_[0]}; # modify our local arglist, not real ARGV.

  Getopt::Long::config (qw(bundling auto_abbrev require_order));
  GetOptions ("l|lexulous", sub { $opt_rules = 'lexulous' },
              "d|dictionary=s", \$opt_dict,
             );
}

sub main
{
  parse_options (\@_);

  my $ifreq = letfreq ($_[0]);
  my @list;

  open (F, $_[2] || dictfile());
  my %match;
  while (<F>)
    {
      next if length ($_) > (length ($_[0]) + 1);
      next if length ($_) < 4; # includes NL, so skip 1-2 letter words
      next if ($_[1] && ! /$_[1]/io);
      chop;
      my $freq = letfreq ($_);
      $match{lc $_} = 1 if subset ($freq, $ifreq);
    }

  *letter_score = $game_rules{$opt_rules}->{score};

  map { printf "%3d  %s\n", score ($_), $_ }
      sort { length $a <=> length $b || $a cmp $b }
           keys %match;
}

main (@ARGV);

# eof