RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on February 01, 2019, 03:21:06 AM
-
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:
_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.
-
Oh at Rosetta they only play this with digits 1 to 9, here is the fix:
_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