#!/usr/local/bin/perl

use strict vars;
my ($w, $size, $entry, $eval, $cont, $line, $word);
my (@combs, @word);
my (%anagrams, %bysize, %combs);

#read dictionary file
my $file = shift;
open(FILE, "$file") or die "cannot open file $file: $!\n";
print "reading dictionary...\n";
push( @{ $anagrams{join("", sort( split(//,$w) ) )} }, $w ) while( chomp($w = <FILE>) );
close(FILE);

print "enter word and size(q to quit) ";
chomp($cont = <STDIN>);

while($cont !~ m/^q$/i) {

    %combs = @combs = %bysize = ();
    ($word, $size) = split(" ", $cont);
    if($size =~ m/^\d$/) {
        $eval = '$combs{$entry} = 1 if ($entry =~ m/^\w{' . $size . '}$/ )';
    } elsif($size =~ m/-/) {
        my ($fnum, $snum) = $size =~ m/(\d+)\s*-\s*(\d+)/;
        $eval = '$combs{$entry} = 1 if ($entry =~ m/^\w{' . $fnum . ',' . $snum . '}$/)';
    } elsif($size ne "") {
        $eval = '$combs{$entry} = 1 if length($entry)' . " $size";
    }
    #find all combinations in word
    @word = split(//, $word);
    foreach (&combinations(@word)) {
        $entry = join("", sort(@$_));
        if($size eq "") {
            $combs{$entry} = 1 if length($entry) > 0;
        } else {
            eval $eval;
        }
    }
    @combs = sort(keys %combs);
    # store each word in bysize hash arranged by size
    foreach (@combs) {
        push( @{ $bysize{ length($_) } }, @{ $anagrams{$_} } ) if @{ $anagrams{$_} };
    }

    # print words
    &print_set();

    print "enter word and size(q to quit) ";
    chomp($cont = <STDIN>);
}

sub print_set() {
    my ($key, $count, $total);
    my @words;
    foreach $key ( sort { $a <=> $b } keys %bysize ) {
        @words = sort( @{ $bysize{$key} } );
        print "\nwords of size $key:\n";
        $count = 0;
        foreach (@words) {
            $count++;
            print "$_ ";
            print "\n" if $count % 7 == 0;
        }
        $total += $count;
        print "\n";
    }
    print "\ntotal words: $total\n";
    print "\n\n";
}

sub combinations() {
    return [] unless @_;
    my $first = shift;
    my @rest = combinations(@_);
    return @rest, map { [$first, @$_] } @rest;
}

exit;