Bulls and Cows AI

[B+]

Review the Bulls and Cows Game here: http://rosettacode.org/wiki/Bulls_and_cows

The code below has a Bulls and Cows Game commented out, if you want to try your hand at playing the game and to help appreciate the AI program.

Now for the AI player:

Code: [Select]

_TITLE "Bulls and Cows AI" ' for QB64 B+ started 2019-01-31
DEFINT A-Z
RANDOMIZE TIMER
DIM SHARED secret$
DIM SHARED possibles(1 TO 9876) 'permutation T or F

'As suggested by Rosetta,
'  "One method is to generate a list of all possible numbers that could be the answer,"
'  "then to prune the list by keeping only those numbers that would give an equivalent"
'  "score to how your last guess was scored. Your next guess can be any number from the"
'  "pruned list. Either you guess correctly or run out of numbers to guess, which"
'  "indicates a problem with the scoring."


'Creating a list of all possible permutations of the 10 digits
'taken 4 at a time = 10*9*8*7 possibles = 5040.
'Loading such that if a nonrepeating 4 digit number then -1 else leave at 0
FOR i = 123 TO 9876
    IF noRepeat(RIGHT$("000" + LTRIM$(STR$(i)), 4)) THEN possibles(i) = -1: count = count + 1
    'check noRepeat function
    'PRINT i, possibles(i)
    'INPUT "OK press enter "; wate$
NEXT
'check possibles count
PRINT "Possible permutations of 4 non repeating digits ="; count 'equals 5040?

createSecretNumber

'test score$ with a regular game of Bulls and Cows
'PRINT secret$
'guesses = 0
'DO
'    INPUT "Please enter your 4 digit guess "; guess$
'    guesses = guesses + 1
'    PRINT score$(secret$, guess$)
'    PRINT
'LOOP WHILE secret$ <> guess$
'PRINT "You found the number in"; guesses; " guesses."


'OK now for the main event
PRINT "Here is the secret number so you can follow along: "; secret$
PRINT
DO
    'INPUT "Please enter your 4 digit guess "; guess$

    'insert AI player here
    r = INT(RND * 9876) + 1
    WHILE possibles(r) = 0
        r = r + 1
        IF r > 9876 THEN r = 123
    WEND
    guess$ = RIGHT$("000" + LTRIM$(STR$(r)), 4)

    'display the guess and it's score
    PRINT "AI guesses "; guess$
    guesses = guesses + 1
    sc$ = score$(secret$, guess$)
    PRINT "Scores: "; LEFT$(sc$, 1); " bull(s), "; RIGHT$(sc$, 1); " cow(s)"
    IF sc$ <> "40" THEN
        'now AI will use that score to eliminate all possibles that would not yeild the cattle count
        changes = 0: remainder = 0
        FOR i = 123 TO 9876
            IF possibles(i) <> 0 THEN
                is$ = RIGHT$("000" + LTRIM$(STR$(i)), 4)
                tsc$ = score$(guess$, is$)
                'PRINT "i string$ "; is$; "  score is "; tsc$

                IF score$(guess$, is$) <> sc$ THEN possibles(i) = 0: changes = changes + 1 ELSE remainder = remainder + 1
                'INPUT "OK press enter "; wate$
            END IF
        NEXT
        PRINT "AI reduced number of possible permutations by"; RTRIM$(STR$(changes)); ", so"; remainder; "possible(s) remain."
        INPUT "OK press enter "; wate$
    END IF
    PRINT
LOOP WHILE secret$ <> guess$
PRINT "AI found the number in"; guesses; "guesses."


SUB createSecretNumber
    digits$ = "0123456789": secret$ = ""
    FOR i = 1 TO 4
        p = INT(RND * LEN(digits$)) + 1
        secret$ = secret$ + MID$(digits$, p, 1)
        digits$ = MID$(digits$, 1, p - 1) + MID$(digits$, p + 1)
    NEXT
END SUB

FUNCTION noRepeat (d$)
    IF LEN(d$) <> 4 THEN EXIT FUNCTION
    FOR i = 1 TO 3
        c$ = MID$(d$, i, 1)
        FOR j = i + 1 TO 4
            IF c$ = MID$(d$, j, 1) THEN EXIT FUNCTION
        NEXT
    NEXT
    noRepeat = -1
END FUNCTION

FUNCTION score$ (secret$, test$)
    FOR i = 1 TO 4
        c$ = MID$(test$, i, 1)
        IF MID$(secret$, i, 1) = c$ THEN
            bulls = bulls + 1
        ELSEIF INSTR(secret$, c$) THEN
            cows = cows + 1
        END IF
    NEXT i
    score$ = LTRIM$(STR$(bulls)) + LTRIM$(STR$(cows))
END FUNCTION

What does it mean when you create something that "thinks" better than you?
Sure the AI was lucky here in guessing, but even when not lucky it does better than I.

[B+]

Oh at Rosetta they only play this with digits 1 to 9, here is the fix:

Code: [Select]

_TITLE "Bulls and Cows AI for digits 1 to 9" ' for QB64 B+ started 2019-01-31
'2019-02-01 fix for digits 1 to 9

DEFINT A-Z
RANDOMIZE TIMER
DIM SHARED secret$
DIM SHARED possibles(1 TO 9876) 'permutation T or F

'As suggested by Rosetta,
'  "One method is to generate a list of all possible numbers that could be the answer,"
'  "then to prune the list by keeping only those numbers that would give an equivalent"
'  "score to how your last guess was scored. Your next guess can be any number from the"
'  "pruned list. Either you guess correctly or run out of numbers to guess, which"
'  "indicates a problem with the scoring."


'Creating a list of all possible permutations of the 9 digits
'taken 4 at a time = 9*8*7*6 possibles = 3024.
'Loading such that if a nonrepeating 4 digit number then -1 else leave at 0
FOR i = 1234 TO 9876
    IF noRepeat(LTRIM$(STR$(i))) THEN possibles(i) = -1: count = count + 1
NEXT
'check possibles count
PRINT "Possible permutations of 4 non repeating digits ="; count 'equals 5040?

createSecretNumber

'test score$ with a regular game of Bulls and Cows
'PRINT secret$
'guesses = 0
'DO
'    INPUT "Please enter your 4 digit guess "; guess$
'    guesses = guesses + 1
'    PRINT score$(secret$, guess$)
'    PRINT
'LOOP WHILE secret$ <> guess$
'PRINT "You found the number in"; guesses; " guesses."


'OK now for the main event
PRINT "Here is the secret number so you can follow along: "; secret$
PRINT
DO
    'INPUT "Please enter your 4 digit guess "; guess$

    'insert AI player here
    r = INT(RND * 9876) + 1
    WHILE possibles(r) = 0
        r = r + 1
        IF r > 9876 THEN r = 1234
    WEND
    guess$ = LTRIM$(STR$(r))

    'display the guess and it's score
    PRINT "AI guesses "; guess$
    guesses = guesses + 1
    sc$ = score$(secret$, guess$)
    PRINT "Scores: "; LEFT$(sc$, 1); " bull(s), "; RIGHT$(sc$, 1); " cow(s)"
    IF sc$ <> "40" THEN
        'now AI will use that score to eliminate all possibles that would not yeild the cattle count
        changes = 0: remainder = 0
        FOR i = 1234 TO 9876
            IF possibles(i) <> 0 THEN
                is$ = RIGHT$("000" + LTRIM$(STR$(i)), 4)
                ' tsc$ = score$(guess$, is$)
                'PRINT "i string$ "; is$; "  score is "; tsc$

                IF score$(guess$, is$) <> sc$ THEN possibles(i) = 0: changes = changes + 1 ELSE remainder = remainder + 1
                'INPUT "OK press enter "; wate$
            END IF
        NEXT
        PRINT "AI reduced number of possible permutations by"; RTRIM$(STR$(changes)); ", so"; remainder; "possible(s) remain."
        INPUT "OK press enter "; wate$
    END IF
    PRINT
LOOP WHILE secret$ <> guess$
PRINT "AI found the number in"; guesses; "guesses."


SUB createSecretNumber
    digits$ = "123456789": secret$ = ""
    FOR i = 1 TO 4
        p = INT(RND * LEN(digits$)) + 1
        secret$ = secret$ + MID$(digits$, p, 1)
        digits$ = MID$(digits$, 1, p - 1) + MID$(digits$, p + 1)
    NEXT
END SUB

FUNCTION noRepeat (d$)
    IF LEN(d$) <> 4 THEN EXIT FUNCTION
    IF INSTR(d$, "0") THEN EXIT FUNCTION
    FOR i = 1 TO 3
        c$ = MID$(d$, i, 1)
        FOR j = i + 1 TO 4
            IF c$ = MID$(d$, j, 1) THEN EXIT FUNCTION
        NEXT
    NEXT
    noRepeat = -1
END FUNCTION

FUNCTION score$ (secret$, test$)
    FOR i = 1 TO 4
        c$ = MID$(test$, i, 1)
        IF MID$(secret$, i, 1) = c$ THEN
            bulls = bulls + 1
        ELSEIF INSTR(secret$, c$) THEN
            cows = cows + 1
        END IF
    NEXT i
    score$ = LTRIM$(STR$(bulls)) + LTRIM$(STR$(cows))
END FUNCTION