Celem tego wyzwania jest napisanie programu potrafiącego odgadnąć słowo w jak najmniejszej liczbie prób. Opiera się na koncepcji programu telewizyjnego Lingo ( http://en.wikipedia.org/wiki/Lingo_(US_game_show) ).

Zasady

Biorąc pod uwagę długość słowa przekazaną jako pierwszy argument w wierszu poleceń, program odtwarzający podejmuje pięć prób odgadnięcia słowa, pisząc zgadnięcie na standardowym wyjściu, a następnie pojedynczy \nznak.

Po odgadnięciu program na swoim standardowym wejściu otrzymuje ciąg znaków, po którym następuje pojedynczy \nznak.

Ciąg ma taką samą długość jak słowo do odgadnięcia i składa się z sekwencji następujących znaków:

• X: co oznacza, że ​​danej litery nie ma w słowie do odgadnięcia
• ?: co oznacza, że ​​dana litera jest obecna w słowie do odgadnięcia, ale w innym miejscu
• O: co oznacza, że ​​list w tej lokalizacji został poprawnie odgadnięty

Na przykład, jeśli słowo do odgadnięcia jest dents, a program wysyła słowo dozes, otrzyma OXX?Obo di ssą prawidłowe, ejest niesłuszna, a oi znie są obecne.

Bądź ostrożny, jeśli litera występuje więcej razy w zgadywaniu niż w słowie do zgadnięcia, nie będzie oznaczona jako ?i Owięcej razy niż liczba wystąpień litery w słowie do zgadnięcia. Na przykład, jeśli słowo do zgadnięcia to coziesi program wysyła tosses, otrzyma, XOXXOOponieważ jest tylko jedno sdo zlokalizowania.

Słowa są wybierane z angielskiej listy słów. Jeśli słowo wysłane przez program nie jest prawidłowym słowem o prawidłowej długości, próba jest uważana za automatyczną awarię i Xzwracane są tylko te.
Program odtwarzacza powinien zakładać, że plik o nazwie wordlist.txti zawierający jedno słowo w wierszu znajduje się w bieżącym katalogu roboczym i można go odczytać w razie potrzeby.
Odgadnięcia powinny składać się wyłącznie z małych liter alfabetu ( [a-z]).
Program nie może wykonywać żadnych innych operacji sieciowych lub związanych z plikami.

Gra kończy się, gdy Ozostanie zwrócony ciąg złożony z samego ciągu lub gdy program wykona 5 prób i nie będzie w stanie odgadnąć słowa.

Punktacja

Wynik gry jest określony przez podaną formułę:

score = 100 * (6 - number_of_attempts)

Więc jeśli słowo jest poprawnie odgadnięte przy pierwszej próbie, daje się 500 punktów. Ostatnia próba jest warta 100 punktów.

Brak odgadnięcia słowa daje zero punktów.

Jama

Programy odtwarzające będą oceniane przez próbę odgadnięcia 100 losowych słów dla każdego słowa o długości od 4 do 13 znaków włącznie.
Losowe wybieranie słów będzie dokonywane z wyprzedzeniem, więc wszystkie wpisy będą musiały odgadnąć te same słowa.

Zwycięski program i zaakceptowana odpowiedź będą tymi, które osiągną najwyższy wynik.

Programy będą uruchamiane na maszynie wirtualnej Ubuntu, przy użyciu kodu pod adresem https://github.com/noirotm/lingo . Implementacje w dowolnym języku są akceptowane, o ile dostarczone są uzasadnione instrukcje ich kompilacji i / lub uruchomienia.

Podaję kilka implementacji testowych w Rubim w repozytorium git, nie krępuj się czerpać z nich inspiracji.

To pytanie będzie okresowo aktualizowane o rankingi opublikowanych odpowiedzi, aby umożliwić pretendentom poprawę swoich wpisów.

Oficjalna ocena końcowa odbędzie się 1 lipca .

Aktualizacja

Wpisy mogą teraz zakładać obecność wordlistN.txtplików, aby przyspieszyć czytanie listy słów dla bieżącej długości słowa dla N od 4 do 13 włącznie.

Na przykład istnieje wordlist4.txtplik zawierający wszystkie czteroliterowe słowa i wordlist10.txtzawierający wszystkie dziesięć liter i tak dalej.

Wyniki pierwszej rundy

Na dzień 01.01.2014 r. Przesłano trzy wpisy, z następującymi wynikami:

                        4       5       6       7       8       9       10      11      12      13      Total
./chinese-perl-goth.pl  8100    12400   15700   19100   22100   25800   27900   30600   31300   33600   226600
java Lingo              10600   14600   19500   22200   25500   28100   29000   31600   32700   33500   247300
./edc65                 10900   15800   22300   24300   27200   29600   31300   33900   33400   33900   262600

** Rankings **
1: ./edc65 (262600)
2: java Lingo (247300)
3: ./chinese-perl-goth.pl (226600)

Wszystkie wpisy były wykonywane konsekwentnie, z wyraźnym zwycięzcą, będąc wpisem C ++ @ edc65.

Wszyscy zawodnicy są niesamowici. Do tej pory nie byłem w stanie nawet pokonać @ chinese-perl-goth.
Jeśli zostanie przesłanych więcej zgłoszeń, odbędzie się kolejna ocena. Bieżące wpisy można również poprawić, jeśli czujesz, że możesz to zrobić lepiej.

C ++ 267700 punktów

Przenoszenie ze starego silnika MasterMind.
Różnice w stosunku do MasterMind:

• Więcej automatów
• Więcej symboli
• Większa przestrzeń rozwiązania (ale nie tak dużo, ponieważ nie wszystkie kombinacje symboli są dozwolone)
• Odpowiedź jest bardzo pouczająca, więc po każdym zgadywaniu mamy więcej informacji
• Odpowiedź jest wolniejsza do wygenerowania i szkoda, ponieważ mój algorytm musi to robić dużo.

Podstawową ideą jest wybranie słowa, które minimalizuje przestrzeń rozwiązania. Algorytm jest naprawdę powolny przy pierwszym zgadywaniu (mam na myśli „dni”), ale najlepsze pierwsze zgadywanie zależy tylko od słowa len, więc jest zakodowane na stałe w źródle. Inne domysły są wykonywane w ciągu kilku sekund.

Kod

(Kompilacja z g ++ -O3)

#include <iostream>
#include <iomanip>
#include <fstream>
#include <string>
#include <ctime>
#include <cstdlib>

using namespace std;

class LRTimer
{
private:
    time_t start;
public:
    void startTimer(void)
    {
        time(&start);
    }

    double stopTimer(void)
    {
        return difftime(time(NULL),start);
    } 

};

#define MAX_WORD_LEN 15
#define BIT_QM 0x8000

LRTimer timer;
int size, valid, wordLen;

string firstGuess[] = { "", "a", "as", "iao", "ares", 
    "raise", "sailer", "saltier", "costlier", "clarities", 
    "anthelices", "petulancies", "incarcerates", "allergenicity" };

class Pattern
{
public:
    char letters[MAX_WORD_LEN];
    char flag;
    int mask;

    Pattern() 
        : letters(), mask(), flag()
    {
    }

    Pattern(string word) 
        : letters(), mask(), flag()
    {
        init(word);
    }

    void init(string word)
    {
        const char *wdata = word.data();
        for(int i = 0; i < wordLen; i++) {
            letters[i] = wdata[i];
            mask |= 1 << (wdata[i]-'a');
        }
    }

    string dump()
    {
        return string(letters);
    }

    int check(Pattern &secret)
    {
        if ((mask & secret.mask) == 0)
            return 0;

        char g[MAX_WORD_LEN], s[MAX_WORD_LEN];
        int r = 0, q = 0, i, j, k=99;
        for (i = 0; i < wordLen; i++)
        {
            g[i] = (letters[i] ^ secret.letters[i]);
            if (g[i])
            {
                r += r;
                k = 0;
                g[i] ^= s[i] = secret.letters[i];
            }
            else
            {
                r += r + 1;
                s[i] = 0;
            }
        }
        for (; k < wordLen; k++)
        {
            q += q;
            if (g[k]) 
            {
                for (j = 0; j < wordLen; j++)
                    if (g[k] == s[j])
                    {
                        q |= BIT_QM;
                        s[j] = 0;
                        break;
                    }
            }
        }
        return r|q;
    }

    int count(int ck, int limit);

    int propcheck(int limit);

    void filter(int ck);
};

string dumpScore(int ck)
{
    string result(wordLen, 'X');
    for (int i = wordLen; i--;)
    {
        result[i] = ck & 1 ? 'O' : ck & BIT_QM ? '?' : 'X';
        ck >>= 1;
    }
    return result;
}

int parseScore(string ck)
{
    int result = 0;
    for (int i = 0; i < wordLen; i++)
    {
        result += result + (
            ck[i] == 'O' ? 1 : ck[i] == '?' ? BIT_QM: 0
        );
    }
    return result;
}

Pattern space[100000];

void Pattern::filter(int ck)
{
    int limit = valid, i = limit;
//  cerr << "Filter IN Valid " << setbase(10) << valid << " This " << dump() << "\n"; 

    while (i--)
    {
        int cck = check(space[i]);
//      cerr << setbase(10) << setw(8) << i << ' ' << space[i].dump() 
//          << setbase(16) << setw(8) << cck << " (" << Pattern::dumpScore(cck) << ") ";

        if ( ck != cck )
        {
//          cerr << " FAIL\r" ;
            --limit;
            if (i != limit) 
            {
                Pattern t = space[i];
                space[i] = space[limit];
                space[limit] = t;
            }
        }
        else
        {
//          cerr << " PASS\n" ;
        }
    }
    valid = limit;
//  cerr << "\nFilter EX Valid " << setbase(10) << valid << "\n"; 
};

int Pattern::count(int ck, int limit)
{
    int i, num=0;
    for (i = 0; i < valid; ++i)
    {
        if (ck == check(space[i]))
            if (++num >= limit) return num;
    }
    return num;
}

int Pattern::propcheck(int limit)
{
    int k, mv, nv;

    for (k = mv = 0; k < valid; ++k)
    {
        int ck = check(space[k]);
        nv = count(ck, limit);
        if (nv >= limit)
        {
            return 99999;
        }
        if (nv > mv) mv = nv;
    }
    return mv;
}

int proposal(bool last)
{
    int i, minnv = 999999, mv, result;

    for (i = 0; i < valid; i++) 
    {
        Pattern& guess = space[i];
//      cerr << '\r' << setw(6) << i << ' ' << guess.dump();
        if ((mv = guess.propcheck(minnv)) < minnv)
        {
//          cerr << setw(6) << mv << ' ' << setw(7) << setiosflags(ios::fixed) << setprecision(0) << timer.stopTimer() << " s\n";
            minnv = mv;
            result = i;
        }
    }   
    if (last) 
        return result;
    minnv *= 0.75;
    for (; i<size; i++) 
    {
        Pattern& guess = space[i];
//      cerr << '\r' << setw(6) << i << ' ' << guess.dump();
        if ((mv = guess.propcheck(minnv)) < minnv)
        {
//          cerr << setw(6) << mv << ' ' << setw(7) << setiosflags(ios::fixed) << setprecision(0) << timer.stopTimer() << " s\n";
            minnv = mv;
            result = i;
        }
    }   
    return result;
}

void setup(string wordfile)
{
    int i = 0; 
    string word;
    ifstream infile(wordfile.data());
    while(infile >> word)
    {
        if (word.length() == wordLen) {
            space[i++].init(word);
        }
    }
    infile.close(); 
    size = valid = i;
}

int main(int argc, char* argv[])
{
    if (argc < 2) 
    {
        cerr << "Specify word length";
        return 1;
    }

    wordLen = atoi(argv[1]);

    timer.startTimer();
    setup("wordlist.txt");
    //cerr << "Words " << size 
    //  << setiosflags(ios::fixed) << setprecision(2)
    //  << " " << timer.stopTimer() << " s\n";

    valid = size;
    Pattern Guess = firstGuess[wordLen];
    for (int t = 0; t < 5; t++)
    {
        cout << Guess.dump() << '\n' << flush;
        string score;
        cin >> score;
        int ck = parseScore(score);
        //cerr << "\nV" << setw(8) << valid << " #" 
        //  << setw(3) << t << " : " << Guess.dump()
        //  << " : " << score << "\n";
        if (ck == ~(-1 << wordLen))
        {
            break;
        }
        Guess.filter(ck); 
        Guess = space[proposal(t == 3)];
    }
    // cerr << "\n";

    double time = timer.stopTimer();
    //cerr << setiosflags(ios::fixed) << setprecision(2)
    //   << timer.stopTimer() << " s\n";

    return 0;
}

Moje wyniki

Ocena z żargonem, 100 rund:

4   9000
5   17700
6   22000
7   25900
8   28600
9   29700
10  31000
11  32800
12  33500
13  34900

Razem 265'100

Wyniki samooceny

Oto moje średnie punkty, zdobyte na całej liście słów. Nie do końca niezawodne, ponieważ niektóre szczegóły algorytmu zmieniły się podczas testów.

 4 # words  6728 PT AVG   100.98 87170.41 s
 5 # words 14847 PT AVG   164.44 42295.38 s
 6 # words 28127 PT AVG   212.27 46550.00 s 
 7 # words 39694 PT AVG   246.16 61505.54 s
 8 # words 49004 PT AVG   273.23 63567.45 s
 9 # words 50655 PT AVG   289.00 45438.70 s
10 # words 43420 PT AVG   302.13 2952.23 s
11 # words 35612 PT AVG   323.62 3835.00 s
12 # words 27669 PT AVG   330.19 5882.98 s
13 # words 19971 PT AVG   339.60 2712.98 s

Według tych liczb mój średni wynik powinien być blisko 257'800

WYNIK PIT

W końcu zainstalowałem Ruby, więc teraz mam „oficjalny” wynik:

    4       5       6       7       8       9      10      11      12      13   TOTAL
10700   16300   22000   25700   27400   30300   32000   33800   34700   34800   267700

Java, 249700 punktów (w moim teście pokonuje chińskiego Perla Gotha)

Zaktualizowana lista rankingowa:

                        4 5 6 7 8 9 10 11 12 13 Razem
perl chinese_perl_goth.pl 6700 12300 16900 19200 23000 26100 28500 29600 32100 33900 228300
java Lingo 9400 14700 18900 21000 26300 28700 30300 32400 33800 34200 249700

Oto stara lista rankingowa wykorzystująca pit.rb:

                        4 5 6 7 8 9 10 11 12 13 Razem
ruby player-example.rb 200 400 400 500 1800 1400 1700 1600 3200 4400 15600
ruby player-example2.rb 2700 3200 2500 4300 7300 6300 8200 10400 13300 15000 73200
ruby player-example3.rb 4500 7400 9900 13700 15400 19000 19600 22300 24600 27300 163700
perl chinese_perl_goth.pl 6400 14600 16500 21000 22500 26000 27200 30600 32500 33800 231100
java Lingo 4800 13100 16500 21400 27200 29200 30600 32400 33700 36100 245000

** Rankingi **
1: Java Lingo (245000)
2: perl chinese_perl_goth.pl (231100)
3: Ruby player-example3.rb (163700)
4: Ruby player-example2.rb (73200)
5: ruby ​​player-example.rb (15600)

W porównaniu do @chineseperlgoth przegrywam krótszymi słowami (<6 znaków), ale wygrywam dłuższymi słowami (> = 6 znaków).

Pomysł jest podobny do @chineseperlgoth, po prostu moim głównym pomysłem jest znalezienie zgadywania (może to być dowolne słowo o tej samej długości, niekoniecznie jedna z pozostałych możliwości), co daje najwięcej informacji do następnego zgadnięcia.

Obecnie nadal gram z formułą, ale dla powyższej tabeli wyników wybieram słowo, które da minimum:

-num_confusion * entropia

Najnowsza wersja wykorzystuje inną ocenę, aby znaleźć następne najlepsze zgadywanie, co maksymalizuje liczbę „pojedynczych możliwości” po bieżącym zgadywaniu. Odbywa się to poprzez wypróbowanie wszystkich słów w przyciętej liście słów (w celu zaoszczędzenia czasu) wszystkich możliwych kandydatów i sprawdzenie, które przypuszczenie jest bardziej prawdopodobne, aby uzyskać „pojedynczą możliwość” (to znaczy, po tym przypuszczeniu będzie tylko jedna możliwa odpowiedź) dla następne przypuszczenie.

Na przykład ten przebieg:

Rozpoczynając nową rundę, słowo jest dobrodziejstwem
Mam: seora
Wysłane:? XOXX
Got: topsl
Wysłane: XOX? X
Mam: mnisi
Wysłano: XO? XO
Mam: bewig
Wysłano: OXXXX
Mam: dobrodziejstwa
Wysłane: OOOOO
Runda wygrana z wynikiem 100

Z pierwszych trzech domysłów, mamy już gdzieś „* oo * s” z „n” i wciąż musimy wymyślić jeszcze jedną literę. Piękno tego algorytmu polega na tym, że zamiast zgadywać słowa podobne do tej formy, odgaduje słowo, które w ogóle nie ma związku z poprzednimi domysłami, próbując podać więcej liter, miejmy nadzieję, że ujawni brakującą literę. W tym przypadku zdarza się również, że poprawnie przyjmuje pozycję brakującego „b” i kończy się poprawnym odgadnięciem „dobrodziejstw”.

Oto kod:

import java.util.*;
import java.io.*;

class Lingo{
    public static String[] guessBestList = new String[]{
                                "",
                                "a",
                                "sa",
                                "tea",
                                "orae",
                                "seora", // 5
                                "ariose",
                                "erasion",
                                "serotina",
                                "tensorial",
                                "psalterion", // 10
                                "ulcerations",
                                "culteranismo",
                                "persecutional"};
    public static HashMap<Integer, ArrayList<String>> wordlist = new HashMap<Integer, ArrayList<String>>();

    public static void main(String[] args){
        readWordlist("wordlist.txt");
        Scanner scanner = new Scanner(System.in);
        int wordlen = Integer.parseInt(args[0]);
        int roundNum = 5;
        ArrayList<String> candidates = new ArrayList<String>();
        candidates.addAll(wordlist.get(wordlen));
        String guess = "";
        while(roundNum-- > 0){
            guess = guessBest(candidates, roundNum==4, roundNum==0);
            System.out.println(guess);
            String response = scanner.nextLine();
            if(isAllO(response)){
                break;
            }
            updateCandidates(candidates, guess, response);
            //print(candidates);
        }
    }

    public static void print(ArrayList<String> candidates){
        for(String str: candidates){
            System.err.println(str);
        }
        System.err.println();
    }

    public static void readWordlist(String path){
        try{
            BufferedReader reader = new BufferedReader(new FileReader(path));
            while(reader.ready()){
                String word = reader.readLine();
                if(!wordlist.containsKey(word.length())){
                    wordlist.put(word.length(), new ArrayList<String>());
                }
                wordlist.get(word.length()).add(word);
            }
        } catch (Exception e){
            System.exit(1);
        }
    }

    public static boolean isAllO(String response){
        for(int i=0; i<response.length(); i++){
            if(response.charAt(i) != 'O') return false;
        }
        return true;
    }

    public static String getResponse(String word, String guess){
        char[] wordChar = word.toCharArray();
        char[] result = new char[word.length()];
        Arrays.fill(result, 'X');
        for(int i=0; i<guess.length(); i++){
            if(guess.charAt(i) == wordChar[i]){
                result[i] = 'O';
                wordChar[i] = '_';
            }
        }
        for(int i=0; i<guess.length(); i++){
            if(result[i] == 'O') continue;
            for(int j=0; j<wordChar.length; j++){
                if(result[j] == 'O') continue;
                if(wordChar[j] == guess.charAt(i)){
                    result[i] = '?';
                    wordChar[j] = '_';
                    break;
                }
            }
        }
        return String.valueOf(result);
    }

    public static void updateCandidates(ArrayList<String> candidates, String guess, String response){
        for(int i=candidates.size()-1; i>=0; i--){
            String candidate = candidates.get(i);
            if(!response.equals(getResponse(candidate, guess))){
                candidates.remove(i);
            }
        }
    }

    public static int countMatchingCandidates(ArrayList<String> candidates, String guess, String response){
        int result = 0;
        for(String candidate: candidates){
            if(response.equals(getResponse(candidate, guess))){
                result++;
            }
        }
        return result;
    }

    public static String[] getSample(ArrayList<String> words, int size){
        String[] result = new String[size];
        int[] indices = new int[words.size()];
        for(int i=0; i<words.size(); i++){
            indices[i] = i;
        }
        Random rand = new Random(System.currentTimeMillis());
        for(int i=0; i<size; i++){
            int take = rand.nextInt(indices.length-i);
            result[i] = words.get(indices[take]);
            indices[take] = indices[indices.length-i-1];
        }
        return result;
    }

    public static String guessBest(ArrayList<String> candidates, boolean firstGuess, boolean lastGuess){
        if(candidates.size() == 1){
            return candidates.get(0);
        }
        String minGuess = candidates.get(0);
        int wordlen = minGuess.length();
        if(firstGuess && guessBestList[wordlen].length()==wordlen){
            return guessBestList[wordlen];
        }
        int minMatches = Integer.MAX_VALUE;
        String[] words;
        if(lastGuess){
            words = candidates.toArray(new String[0]);
        } else if (candidates.size()>10){
            words = bestWords(wordlist.get(wordlen), candidates, 25);
        } else {
            words = wordlist.get(wordlen).toArray(new String[0]);
        }
        for(String guess: words){
            double sumMatches = 0;
            for(String word: candidates){
                int matches = countMatchingCandidates(candidates, guess, getResponse(word, guess));
                if(matches == 0) matches = candidates.size();
                sumMatches += (matches-1)*(matches-1);
            }
            if(sumMatches < minMatches){
                minGuess = guess;
                minMatches = sumMatches;
            }
        }
        return minGuess;
    }

    public static String[] bestWords(ArrayList<String> words, ArrayList<String> candidates, int size){
        int[] charCount = new int[123];
        for(String candidate: candidates){
            for(int i=0; i<candidate.length(); i++){
                charCount[(int)candidate.charAt(i)]++;
            }
        }
        String[] tmp = (String[])words.toArray(new String[0]);
        Arrays.sort(tmp, new WordComparator(charCount));
        String[] result = new String[size+Math.min(size, candidates.size())];
        String[] sampled = getSample(candidates, Math.min(size, candidates.size()));
        for(int i=0; i<size; i++){
            result[i] = tmp[tmp.length-i-1];
            if(i < sampled.length){
                result[size+i] = sampled[i];
            }
        }
        return result;
    }

    static class WordComparator implements Comparator<String>{
        int[] charCount = null;

        public WordComparator(int[] charCount){
            this.charCount = charCount;
        }

        public Integer count(String word){
            int result = 0;
            int[] multiplier = new int[charCount.length];
            Arrays.fill(multiplier, 1);
            for(char chr: word.toCharArray()){
                result += multiplier[(int)chr]*this.charCount[(int)chr];
                multiplier[(int)chr] = 0;
            }
            return Integer.valueOf(result);
        }

        public int compare(String s1, String s2){
            return count(s1).compareTo(count(s2));
        }
    }
}

Perl

Nadal jest miejsce na ulepszenia, ale przynajmniej wyprzedza przykładowych graczy :)

Zakłada dostęp do zapisu do bieżącego katalogu w celu buforowania list słów (w celu przyspieszenia jego działania); utworzy wordlist.lenN.storpliki za pomocą Storable. Jeśli jest to problem, usuń read_cached_wordlisti zmień kod, aby użyć just read_wordlist.

Wyjaśnienie

Najpierw buduję histogram częstotliwości liter we wszystkich słowach w bieżącej liście słów ( build_histogram). Następnie muszę wybrać moje następne przypuszczenie - co się dzieje find_best_word. Algorytm oceniania po prostu dodaje razem wartości histogramu, pomijając już widoczne litery. To daje mi słowo zawierające najczęstsze litery na liście słów. Jeśli z danym wynikiem jest więcej niż jedno słowo, wybieram jedno losowo. Po znalezieniu słowa wysyłam je do silnika gry, czytam odpowiedź, a następnie próbuję zrobić z nią coś pożytecznego :)

Utrzymuję zestaw warunków, czyli liter, które mogą wystąpić na danym stanowisku w słowie. Na początku jest to po prostu proste (['a'..'z'] x $len), ale jest aktualizowane na podstawie wskazówek podanych w odpowiedzi (patrz update_conds). Następnie buduję wyrażenie regularne na podstawie tych warunków i filtruję przez niego listę słów.

Podczas testów dowiedziałem się wtedy, że wspomniane filtrowanie nie radzi sobie ?zbyt dobrze, stąd drugi filtr ( filter_wordlist_by_reply). Wykorzystuje to fakt, że litera oznaczona jako ?występuje w słowie na innym miejscu i odpowiednio filtruje listę słów.

Kroki te powtarza się dla każdej iteracji głównej pętli, chyba że rozwiązanie zostanie znalezione (lub nie można już czytać ze standardowego wejścia, co oznacza błąd).

Kod

#!perl
use strict;
use warnings;
use v5.10;
use Storable;

$|=1;

sub read_wordlist ($) {
    my ($len) = @_;
    open my $w, '<', 'wordlist.txt' or die $!;
    my @wordlist = grep { chomp; length $_ == $len } <$w>;
    close $w;
    \@wordlist
}

sub read_cached_wordlist ($) {
    my ($len) = @_;
    my $stor = "./wordlist.len$len.stor";
    if (-e $stor) {
        retrieve $stor
    } else {
        my $wl = read_wordlist $len;
        store $wl, $stor;
        $wl
    }
}

sub build_histogram ($) {
    my ($wl) = @_;
    my %histo = ();
    for my $word (@$wl) {
        $histo{$_}++ for ($word =~ /./g);
    }
    \%histo
}

sub score_word ($$) {
    my ($word, $histo) = @_;
    my $score = 0;
    my %seen = ();
    for my $l ($word =~ /./g) {
        if (not exists $seen{$l}) {
            $score += $histo->{$l};
            $seen{$l} = 1;
        }
    }
    $score
}

sub find_best_word ($$) {
    my ($wl, $histo) = @_;
    my @found = (sort { $b->[0] <=> $a->[0] } 
                 map [ score_word($_, $histo), $_ ], @$wl);
    return undef unless @found;
    my $maxscore = $found[0]->[0];
    my @max;
    for (@found) {
        last if $_->[0] < $maxscore;
        push @max, $_->[1];
    }
    $max[rand @max]
}

sub build_conds ($) {
    my ($len) = @_;
    my @c;
    push @c, ['a'..'z'] for 1..$len;
    \@c
}

sub get_regex ($) {
    my ($cond) = @_;
    local $" = '';
    my $r = join "", map { "[@$_]" } @$cond;
    qr/^$r$/
}

sub remove_cond ($$$) {
    my ($conds, $pos, $ch) = @_;
    return if (scalar @{$conds->[$pos]} == 1);
    return unless grep { $_ eq $ch } @{$conds->[$pos]};
    $conds->[$pos] = [ grep { $_ ne $ch } @{$conds->[$pos]} ]
}

sub add_cond ($$$) {
    my ($conds, $pos, $ch) = @_;
    return if (scalar @{$conds->[$pos]} == 1);
    return if grep { $_ eq $ch } @{$conds->[$pos]};
    push @{$conds->[$pos]}, $ch
}

sub update_conds ($$$$) {
    my ($word, $reply, $conds, $len) = @_;
    my %Xes;
    %Xes = ();
    for my $pos (reverse 0..$len-1) {
        my $r = substr $reply, $pos, 1;
        my $ch = substr $word, $pos, 1;

        if ($r eq 'O') {
            $conds->[$pos] = [$ch]
        }

        elsif ($r eq '?') {
            for my $a (0..$len-1) {
                if ($a == $pos) {
                    remove_cond $conds, $a, $ch
                } else {
                    unless (exists $Xes{$a} and $Xes{$a} eq $ch) {
                        add_cond($conds, $a, $ch);
                    }
                }
            }
        }

        elsif ($r eq 'X') {
            $Xes{$pos} = $ch;
            for my $a (0..$len-1) {
                remove_cond $conds, $a, $ch
            }
        }
    }
}

sub uniq ($) {
    my ($data) = @_;
    my %seen; 
    [ grep { !$seen{$_}++ } @$data ]
}

sub filter_wordlist_by_reply ($$$) {
    my ($wl, $word, $reply) = @_;
    return $wl unless $reply =~ /\?/;
    my $newwl = [];
    my $len = length $reply;
    for my $pos (0..$len-1) {
        my $r = substr $reply, $pos, 1;
        my $ch = substr $word, $pos, 1;
        next unless $r eq '?';
        for my $a (0..$len-1) {
            if ($a != $pos) {
                if ('O' ne substr $reply, $a, 1) {
                    push @$newwl, grep { $ch eq substr $_, $a, 1 } @$wl
                }
            }
        }
    }
    uniq $newwl
}

my $len = $ARGV[0] or die "no length";
my $wl = read_cached_wordlist $len;
my $conds = build_conds $len;

my $c=0;
do {
    my $histo = build_histogram $wl;
    my $word = find_best_word $wl, $histo;
    die "no candidates" unless defined $word;
    say $word;
    my $reply = <STDIN>; 
    chomp $reply;
    exit 1 unless length $reply;
    exit 0 if $reply =~ /^O+$/;
    update_conds $word, $reply, $conds, $len;
    $wl = filter_wordlist_by_reply $wl, $word, $reply;
    $wl = [ grep { $_ =~ get_regex $conds } @$wl ]
} while 1