Re: Hangman Assistant

[Lawliet]

Updated code:

#!/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 eithe
+r 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 s
+pot,
# 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/words') or die $!; # Edited to /words
+ as per request
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 si
+ze

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 f
+or each letter once per word
        $seen{$char}++;
    }
    
    undef %seen;
}


say $#narrowed + 1;
if ($#narrowed <= 10) {
    say $_ foreach @narrowed; # Word list
    say sort { $alphabet{$b} <=> $alphabet{$a} } keys %alphabet; # Mos
+t common letter, including ones already guessed
    
} else {
    # Find how close each letter is to half of the total word possibil
+ities to ensure maximum gain every guess after being sorted
    foreach my $occur (keys %alphabet) {
        $alphabet{$occur} = abs($#narrowed/2 - abs($alphabet{$occur} -
+ $#narrowed + 1));
    }
    
    say sort { $alphabet{$a} <=> $alphabet{$b} } keys %alphabet;
}

Updated example:

$ perl hangman.pl "_ _ _ _ _ _ _ _" ""
_ _ _ _ _ _ _ _
0
10588
rantislodecgupmhbyfkwvxzqj

$ perl hangman.pl "_ _ _ _ _ _ _ _" "r"
_ _ _ _ _ _ _ _
r
5252
atlnsieodcgumhpbyfkwvxzqjr

$ perl hangman.pl "_ _ _ _ _ _ _ _" "ra"
_ _ _ _ _ _ _ _
r|a
2761
tolnsdgueichpmbfykwvxzqjra

$ perl hangman.pl "_ _ _ _ _ t _ _" "ra"
_ _ _ _ _ t _ _
r|a
165
isncdolupmghbfykvxejqwtraz

$ perl hangman.pl "_ _ _ _ _ t i _" "ra"
_ _ _ _ _ t i _
r|a
17
slhpodungmxytieqbwrajkfvcz

$ perl hangman.pl "_ _ _ _ _ t i _" "ras"
_ _ _ _ _ t i _
r|a|s
9
bulletin
dietetic
eclectic
ecliptic
elliptic
eutectic
hypnotic
phonetic
quixotic
ticelpunohxdyqbwrajkgfvmsz

$ perl hangman.pl "_ c _ _ c t i c" "ras"
_ c _ _ c t i c
r|a|s
1
eclectic
tielcwraxdjyukhgfnvmspqbzo

Same amount of guesses as before, but a better way to get there (I think).