#!/usr/bin/perl
use strict;

# author: wu

my $debug = 0;

print "Enter words (enter . on a line by itself when done):\n";
my @words;
while ( 1 ) {
    my $line = <STDIN>;
    chomp $line;
    last if $line eq ".";
    push @words, split /\s+/, $line;
}

print "\nGenerating word scores...\n";
my $indexes;
my $matches;
for my $word ( @words ) {
    print "WORD: $word\n" if $debug;
    for my $idx ( 0 .. length( $word ) - 1 ) {
        my $char = substr( $word, $idx, 1 );
        print "\t$char" if $debug;
        my $human_idx = $idx + 1;
        $indexes->{$human_idx}->{$char}++;
        $matches->{$human_idx}->{$char}->{$word}++;
    }
    print "\n" if $debug;
}

my $scores;
for my $word ( @words ) {
    print "SCORING WORD: $word\n" if $debug;

    for my $idx ( 0 .. length( $word ) - 1 ) {
        my $char = substr( $word, $idx, 1 );
        my $human_idx = $idx + 1;

        # add the rank of this letter in this substring index to the
        # total score of this word
        $scores->{$word} += $indexes->{$human_idx}->{$char};
    }

}

print "\nScores:\n";
print_words( @words );

print "\nYour Guesses ( word followed by whitespace followed by # matches )\n";
my $guesses;
for my $word ( @words ) { $guesses->{$word} = 1 }

LINE:
while ( 1 ) {
    print "> ";
    my $line = <STDIN>;
    chomp $line;

    unless ( $line =~ m|^(\w+)\s+(\d+)$| ) {
        print "> ";
        next LINE;
    }

    my $guessed = $1;
    my $num_letters = $2;

    for my $word ( keys %{ $guesses } ) {
        unless ( matches_string( $guessed, $word, $num_letters ) ) {
            delete $guesses->{$word};
        }
    }

    print "\n";
    print_words( keys %{ $guesses } );
    print "\n";

    my $left = scalar keys %{ $guesses };
    if ( $left == 1 || $left == 0 ) {
        print "\nDone!\n";
        exit;
    }

}

sub print_words {
    my ( @words ) = @_;
    for my $word ( sort { $scores->{$a} <=> $scores->{$b} } @words ) {
        print $scores->{$word}, " $word\n";
    }
}
sub matches_string {
    my ( $word1, $word2, $num_letters ) = @_;

    my $count_matched = 0;
    for my $idx ( 0 .. length( $word1 ) - 1 ) {
        if ( substr( $word1, $idx, 1 ) eq substr( $word2, $idx, 1 ) ) {
            $count_matched++;
        }
    }

    #print "MATCHES: $word1 $word2 = $count_matched\n";

    if ( $count_matched == $num_letters ) {
        return 1;
    }

    return;

}