Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on January 31, 2019, 10:09:23 pm

Title: Bulls and Cows AI
Post by: bplus on January 31, 2019, 10:09:23 pm
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: QB64: [Select]
  1. _TITLE "Bulls and Cows AI" ' for QB64 B+ started 2019-01-31
  2. DEFINT A-Z
  4. DIM SHARED secret$
  5. DIM SHARED possibles(1 TO 9876) 'permutation T or F
  6.  
  7. 'As suggested by Rosetta,
  8. '  "One method is to generate a list of all possible numbers that could be the answer,"
  9. '  "then to prune the list by keeping only those numbers that would give an equivalent"
  10. '  "score to how your last guess was scored. Your next guess can be any number from the"
  11. '  "pruned list. Either you guess correctly or run out of numbers to guess, which"
  12. '  "indicates a problem with the scoring."
  13.  
  14.  
  15. 'Creating a list of all possible permutations of the 10 digits
  16. 'taken 4 at a time = 10*9*8*7 possibles = 5040.
  17. 'Loading such that if a nonrepeating 4 digit number then -1 else leave at 0
  18. FOR i = 123 TO 9876
  19.     IF noRepeat(RIGHT$("000" + LTRIM$(STR$(i)), 4)) THEN possibles(i) = -1: count = count + 1
  20.     'check noRepeat function
  21.     'PRINT i, possibles(i)
  22.     'INPUT "OK press enter "; wate$
  24. 'check possibles count
  25. PRINT "Possible permutations of 4 non repeating digits ="; count 'equals 5040?
  26.  
  27. createSecretNumber
  28.  
  29. 'test score$ with a regular game of Bulls and Cows
  30. 'PRINT secret$
  31. 'guesses = 0
  32. 'DO
  33. '    INPUT "Please enter your 4 digit guess "; guess$
  34. '    guesses = guesses + 1
  35. '    PRINT score$(secret$, guess$)
  36. '    PRINT
  37. 'LOOP WHILE secret$ <> guess$
  38. 'PRINT "You found the number in"; guesses; " guesses."
  39.  
  40.  
  41. 'OK now for the main event
  42. PRINT "Here is the secret number so you can follow along: "; secret$
  45.     'INPUT "Please enter your 4 digit guess "; guess$
  46.  
  47.     'insert AI player here
  48.     r = INT(RND * 9876) + 1
  49.     WHILE possibles(r) = 0
  50.         r = r + 1
  51.         IF r > 9876 THEN r = 123
  52.     WEND
  53.     guess$ = RIGHT$("000" + LTRIM$(STR$(r)), 4)
  54.  
  55.     'display the guess and it's score
  56.     PRINT "AI guesses "; guess$
  57.     guesses = guesses + 1
  58.     sc$ = score$(secret$, guess$)
  59.     PRINT "Scores: "; LEFT$(sc$, 1); " bull(s), "; RIGHT$(sc$, 1); " cow(s)"
  60.     IF sc$ <> "40" THEN
  61.         'now AI will use that score to eliminate all possibles that would not yeild the cattle count
  62.         changes = 0: remainder = 0
  63.         FOR i = 123 TO 9876
  64.             IF possibles(i) <> 0 THEN
  65.                 is$ = RIGHT$("000" + LTRIM$(STR$(i)), 4)
  66.                 tsc$ = score$(guess$, is$)
  67.                 'PRINT "i string$ "; is$; "  score is "; tsc$
  68.  
  69.                 IF score$(guess$, is$) <> sc$ THEN possibles(i) = 0: changes = changes + 1 ELSE remainder = remainder + 1
  70.                 'INPUT "OK press enter "; wate$
  71.             END IF
  72.         NEXT
  73.         PRINT "AI reduced number of possible permutations by"; RTRIM$(STR$(changes)); ", so"; remainder; "possible(s) remain."
  74.         INPUT "OK press enter "; wate$
  75.     END IF
  76.     PRINT
  77. LOOP WHILE secret$ <> guess$
  78. PRINT "AI found the number in"; guesses; "guesses."
  79.  
  80.  
  81. SUB createSecretNumber
  82.     digits$ = "0123456789": secret$ = ""
  83.     FOR i = 1 TO 4
  84.         p = INT(RND * LEN(digits$)) + 1
  85.         secret$ = secret$ + MID$(digits$, p, 1)
  86.         digits$ = MID$(digits$, 1, p - 1) + MID$(digits$, p + 1)
  87.     NEXT
  89.  
  90. FUNCTION noRepeat (d$)
  91.     IF LEN(d$) <> 4 THEN EXIT FUNCTION
  92.     FOR i = 1 TO 3
  93.         c$ = MID$(d$, i, 1)
  94.         FOR j = i + 1 TO 4
  95.             IF c$ = MID$(d$, j, 1) THEN EXIT FUNCTION
  96.         NEXT
  97.     NEXT
  98.     noRepeat = -1
  100.  
  101. FUNCTION score$ (secret$, test$)
  102.     FOR i = 1 TO 4
  103.         c$ = MID$(test$, i, 1)
  104.         IF MID$(secret$, i, 1) = c$ THEN
  105.             bulls = bulls + 1
  106.         ELSEIF INSTR(secret$, c$) THEN
  107.             cows = cows + 1
  108.         END IF
  109.     NEXT i
  110.     score$ = LTRIM$(STR$(bulls)) + LTRIM$(STR$(cows))
  112.  

What does it mean when you create something that "thinks" better than you?
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Sure the AI was lucky here in guessing, but even when not lucky it does better than I.
Title: Re: Bulls and Cows AI
Post by: _vince on January 31, 2019, 11:11:26 pm
Pretty cool
Title: Re: Bulls and Cows AI
Post by: Dimster on February 01, 2019, 12:35:24 pm
A couple of questions bplus - 1st, QB64 does not have a way to search a variable of numbers without the conversion to a string? for example Today = 20190201 so Day = Left(Today,2). Is that correct?
 2nd, in The Bulls and Cows AI search you have a line "FOR i = 123 TO 9876", where does the 123 come from? Is that ceding the order of a correct answer or just simply reducing the number of iterations?

Thanks
Title: Re: Bulls and Cows AI
Post by: SMcNeill on February 01, 2019, 01:05:18 pm
Quote from: Dimster on February 01, 2019, 12:35:24 pm
A couple of questions bplus - 1st, QB64 does not have a way to search a variable of numbers without the conversion to a string? for example Today = 20190201 so Day = Left(Today,2). Is that correct?
Thanks

Today = 20190201
Day = Today MOD 100
Month = (Today MOD 10000 ) \ 100
Year = Today \ 1000

Title: Re: Bulls and Cows AI
Post by: bplus on February 01, 2019, 01:49:24 pm
I just learned of a mistake I made with Bulls and Cows game. Apparently it is played with only the digits 1 to 9 with only 3024 possible permutations, not played with digits 0 to 9 and 5040 permutations.

Ah well, could probably set this up to play with any amount of letters and digits, just a matter of getting a list of all possible perms for the AI to prune with guesses.
Title: Re: Bulls and Cows AI
Post by: bplus on February 01, 2019, 01:58:51 pm
Quote from: Dimster on February 01, 2019, 12:35:24 pm
A couple of questions bplus - 1st, QB64 does not have a way to search a variable of numbers without the conversion to a string? for example Today = 20190201 so Day = Left(Today,2). Is that correct?
 2nd, in The Bulls and Cows AI search you have a line "FOR i = 123 TO 9876", where does the 123 come from? Is that ceding the order of a correct answer or just simply reducing the number of iterations?

Thanks

I think Steve might have question 1 covered. Day would be right$(today, 2) if today is a string, left$ or right$ won't work on a number.

as to 2nd question,
I started at 123 because I was going in numeric order from lowest non repeating "4" digit "numbers" to 9876 highest non repeating 4 digit number. 123 = 0123 in 4 digit string form, testing non repeats from 4 digit strings to build the original set of possible permutations. 0000 to 0122 will all have repeat digits, so I was skipping those tests.
Title: Re: Bulls and Cows AI
Post by: bplus on February 01, 2019, 02:41:51 pm
OK so here is the AI fixed up for only digits 1 to 9:
Code: QB64: [Select]
  1. _TITLE "Bulls and Cows AI for digits 1 to 9" ' for QB64 B+ started 2019-01-31
  2. '2019-02-01 fix for digits 1 to 9
  3.  
  4. DEFINT A-Z
  6. DIM SHARED secret$
  7. DIM SHARED possibles(1 TO 9876) 'permutation T or F
  8.  
  9. 'As suggested by Rosetta,
  10. '  "One method is to generate a list of all possible numbers that could be the answer,"
  11. '  "then to prune the list by keeping only those numbers that would give an equivalent"
  12. '  "score to how your last guess was scored. Your next guess can be any number from the"
  13. '  "pruned list. Either you guess correctly or run out of numbers to guess, which"
  14. '  "indicates a problem with the scoring."
  15.  
  16.  
  17. 'Creating a list of all possible permutations of the 9 digits
  18. 'taken 4 at a time = 9*8*7*6 possibles = 3024.
  19. 'Loading such that if a nonrepeating 4 digit number then -1 else leave at 0
  20. FOR i = 1234 TO 9876
  21.     IF noRepeat(LTRIM$(STR$(i))) THEN possibles(i) = -1: count = count + 1
  23. 'check possibles count
  24. PRINT "Possible permutations of 4 non repeating digits ="; count 'equals 5040?
  25.  
  26. createSecretNumber
  27.  
  28. 'test score$ with a regular game of Bulls and Cows
  29. 'PRINT secret$
  30. 'guesses = 0
  31. 'DO
  32. '    INPUT "Please enter your 4 digit guess "; guess$
  33. '    guesses = guesses + 1
  34. '    PRINT score$(secret$, guess$)
  35. '    PRINT
  36. 'LOOP WHILE secret$ <> guess$
  37. 'PRINT "You found the number in"; guesses; " guesses."
  38.  
  39.  
  40. 'OK now for the main event
  41. PRINT "Here is the secret number so you can follow along: "; secret$
  44.     'INPUT "Please enter your 4 digit guess "; guess$
  45.  
  46.     'insert AI player here
  47.     r = INT(RND * 9876) + 1
  48.     WHILE possibles(r) = 0
  49.         r = r + 1
  50.         IF r > 9876 THEN r = 1234
  51.     WEND
  52.     guess$ = LTRIM$(STR$(r))
  53.  
  54.     'display the guess and it's score
  55.     PRINT "AI guesses "; guess$
  56.     guesses = guesses + 1
  57.     sc$ = score$(secret$, guess$)
  58.     PRINT "Scores: "; LEFT$(sc$, 1); " bull(s), "; RIGHT$(sc$, 1); " cow(s)"
  59.     IF sc$ <> "40" THEN
  60.         'now AI will use that score to eliminate all possibles that would not yeild the cattle count
  61.         changes = 0: remainder = 0
  62.         FOR i = 1234 TO 9876
  63.             IF possibles(i) <> 0 THEN
  64.                 is$ = RIGHT$("000" + LTRIM$(STR$(i)), 4)
  65.                 ' tsc$ = score$(guess$, is$)
  66.                 'PRINT "i string$ "; is$; "  score is "; tsc$
  67.  
  68.                 IF score$(guess$, is$) <> sc$ THEN possibles(i) = 0: changes = changes + 1 ELSE remainder = remainder + 1
  69.                 'INPUT "OK press enter "; wate$
  70.             END IF
  71.         NEXT
  72.         PRINT "AI reduced number of possible permutations by"; RTRIM$(STR$(changes)); ", so"; remainder; "possible(s) remain."
  73.         INPUT "OK press enter "; wate$
  74.     END IF
  75.     PRINT
  76. LOOP WHILE secret$ <> guess$
  77. PRINT "AI found the number in"; guesses; "guesses."
  78.  
  79.  
  80. SUB createSecretNumber
  81.     digits$ = "123456789": secret$ = ""
  82.     FOR i = 1 TO 4
  83.         p = INT(RND * LEN(digits$)) + 1
  84.         secret$ = secret$ + MID$(digits$, p, 1)
  85.         digits$ = MID$(digits$, 1, p - 1) + MID$(digits$, p + 1)
  86.     NEXT
  88.  
  89. FUNCTION noRepeat (d$)
  90.     IF LEN(d$) <> 4 THEN EXIT FUNCTION
  91.     IF INSTR(d$, "0") THEN EXIT FUNCTION
  92.     FOR i = 1 TO 3
  93.         c$ = MID$(d$, i, 1)
  94.         FOR j = i + 1 TO 4
  95.             IF c$ = MID$(d$, j, 1) THEN EXIT FUNCTION
  96.         NEXT
  97.     NEXT
  98.     noRepeat = -1
  100.  
  101. FUNCTION score$ (secret$, test$)
  102.     FOR i = 1 TO 4
  103.         c$ = MID$(test$, i, 1)
  104.         IF MID$(secret$, i, 1) = c$ THEN
  105.             bulls = bulls + 1
  106.         ELSEIF INSTR(secret$, c$) THEN
  107.             cows = cows + 1
  108.         END IF
  109.     NEXT i
  110.     score$ = LTRIM$(STR$(bulls)) + LTRIM$(STR$(cows))
  112.  
Text Only | Text with Attachments