#!/usr/bin/perl
# Todo:
# Narrow possibilties by eliminating words with repeat letters when I have
# guessed one of the repeats letters but the letter I guessed is either not a
# repeat in the target word or is in a different position.
# Example:
# "rustlers" is a possible word, I guess 'r' and am presented with
# "r _ _ _ r _ _ _", meaning the word has two r's, just in the wrong spot,
# and therefore rustlers should be eliminated.

use warnings;
use strict;
use 5.010;

# Simple instructions:
# perl $0 "w _ r d" "previousfailedguesses"

say $ARGV[0];
my @word = split(/ /, $ARGV[0]);

my $guessed = $ARGV[1] ? join('|', split(//, $ARGV[1])) : "0";
say $guessed;

my %wordlist; # Hash of word-length arrays
open(WORD, '<', '/usr/share/dict/american-english') or die $!;
while (<WORD>) {
	chomp;
	next if /[^a-z]/; # Lazy way out~
	my @chars = split(//, $_);
	push @{$wordlist{$#chars}}, $_;
}
close WORD;

my @narrowed = @{$wordlist{$#word}}; # Narrowed possible answers by size

OUTER: for (my $i = 0; $i <= $#narrowed; $i++) {	
	my @chars = split(//, $narrowed[$i]);
	
	# Narrowed by previous guesses
	if ($narrowed[$i] =~ /$guessed/) {
		splice(@narrowed, $i, 1);
		$i--; # Decrement counter now that word has been removed
		next OUTER;
	}
	
	# Narrowed by matching characters
	for (my $pos = 0; $pos <= $#word; $pos++) {
		next if $word[$pos] eq '_';
		
		if ($word[$pos] ne $chars[$pos]) {
			splice(@narrowed, $i, 1);
			$i--;
			next OUTER;
		}
	}
}

# %alphabet holds the number of times a letter occurs within all words
# %seen holds the number times a letter occurs in one word
my %alphabet;
$alphabet{$_} = 0 foreach ('a'..'z');
foreach my $word (@narrowed) {
	my %seen;
	$seen{$_} = 0 foreach ('a'..'z');
	my @chars = split(//, $word);
	
	foreach my $char (@chars) {
		$alphabet{$char}++ if $seen{$char} == 0; # Limit 1 increment for each letter once per word
		$seen{$char}++;
	}
	
	undef %seen;
}

say $_ foreach @narrowed; # Word list
say sort { $alphabet{$b} <=> $alphabet{$a} } keys %alphabet; # Most common letter, including ones already guessed

##</code><code>##

$ perl hangman.pl "e _ _ e _ _ _ _" ""
e _ _ e _ _ _ _
0
eagerest
eateries
echelons
eclectic
edgeways
edgewise
effected
egresses
embedded
embezzle
emceeing
emperors
endeared
endeavor
endemics
enfeeble
engender
enmeshed
enmeshes
ensemble
ententes
entering
envelope
envelops
especial
essences
esteemed
ethereal
eugenics
eutectic
exceeded
excelled
excepted
excerpts
excesses
expected
expedite
expelled
expended
expenses
expertly
extended
exterior
external
ensdtcxrlpimagohbvwyufzjkq

##</code><code>##

$ perl hangman.pl "e _ _ e _ _ _ _" "n"
e _ _ e _ _ _ _
n
eagerest
eateries
eclectic
edgeways
edgewise
effected
egresses
embedded
embezzle
emperors
especial
esteemed
ethereal
eutectic
exceeded
excelled
excepted
excerpts
excesses
expected
expedite
expelled
expertly
exterior
etdxscrpilagmwybouhfzjknvq

##</code><code>##

$ perl hangman.pl "e _ _ e _ t _ _" "n"
e _ _ e _ t _ _
n
eclectic
effected
eutectic
excepted
expected
expertly
tecxdpilryufwajkhgnvmsqbzo

##</code><code>##

$ perl hangman.pl "e _ _ e _ t _ _" "nx"
e _ _ e _ t _ _
n|x
eclectic
effected
eutectic
teciduflwraxjykhgnvmspqbzo

##</code><code>##

$ perl hangman.pl "e _ _ e _ t i _" "nx"
e _ _ e _ t i _
n|x
eclectic
eutectic
tieculwraxdjykhgfnvmspqbzo

##</code><code>##

$ perl hangman.pl "e _ _ e _ t i _" "nxu"
e _ _ e _ t i _
n|x|u
eclectic
tielcwraxdjyukhgfnvmspqbzo