NOTE: This is not my primary entry. Please scroll down below to "Tank Battle" for my primary entry.
You may have to play it a few times before it begins to guess the numbers you're thinking of with better accuracy. It just uses a simple pattern recognition system to attempt to anticipate what numbers you think of. Even then, it doesn't have very much advantage over a pure random guessing system if you try to trick it.
;Mind Reader ;By John Judnich Type Record Field Num End Type Global winnings, losses Cls Graphics 640,480,0,2 AppTitle "Mind Reader" Color 255,255,0 Print "Instructions:" Color 255,255,255 Print "Welcome to the Mind Reader. To play this game," Print "simply think of the number 1 or 0, and press a" Print "key when you're ready. The computer will try to" Print "read your mind by adapting to your thought" Print "pattern which is learned over time. Therefore," Print "the computer's guesses will not initially be" Print "very correct." Print Print "You get 1 point when the computer can't guess" Print "you're number, and the computer gets 1 point" Print "when the computer guesses your number correctly." Print Print "The first to reach 10 points wins!" Print Print "Note: This program trusts you are honest, and" Print "that you will honestly admit when the computer" Print "guesses your number. If you lie, the computer" Print "will get confused about your brain pattern." Print "You can delete your brain pattern file at any" Print "time if you want to start over." Print Print "Enter your name below: (this is used to load" Print "the correct thought pattern file later)" Color 255,0,0 name$ = Input$() Color 255,255,255 ;Load thought pattern Cls Locate 0,0 If FileType(name$+".mnd") = 1 Then Print "Welcome back, "+name$+"!" LoadPattern(name$+".mnd") Else Print "Welcome, "+name$+"!" End If Color 0,255,0 Print "Games won: "+winnings Color 255,0,0 Print "Games lost: "+losses Color 255,255,255 If winnings+losses > 0 Then prcnt = 100 * winnings / (winnings+losses) Print "Your records indicate that you have a "+prcnt+" percent chance to win." End If Print Print ;Play game computerscore = 0 playerscore = 0 Repeat Print "Think of a number (0 or 1 only), then press a key..." WaitKey() numguess = GuessNumber() ;If playerscore > 0 Then If 100*computerscore/playerscore > 50 Then numguess = 1-numguess Color 255,255,0 Print "Were you thinking of "+numguess+"? (Y = Yes N = No)" Color 255,255,255 Repeat answer = WaitKey() Until answer = 121 Or answer = 110 If answer = 121 Then computerscore = computerscore + 1: numreal = numguess If answer = 110 Then playerscore = playerscore + 1: numreal = 1-numguess ;Record the player's number guess.Record = New Record guess\num = numreal Color 0,0,255 Print "Current scores:" Print "Computer: "+computerscore+" Player:"+playerscore Color 255,255,255 Print Print Until computerscore = 10 Or playerscore = 10 Print Print If computerscore = 10 Then Color 255,0,0 Print "Sorry!" Color 255,255,255 Print "You lost the game," losses = losses + 1 Else Color 0,255,0 Print "Congratulations!" Color 255,255,255 Print "You won the game!" winnings = winnings + 1 End If Print SavePattern(name$+".mnd") WaitKey() End ;This scans the current brain pattern data to guess the next number Function GuessNumber() itm.Record = Last Record If itm = Null Then Return Rand(0, 1) itm = Before itm maxlength = 0 maxitem.Record = Null While itm <> Null chkitm.Record = Last Record itm2.Record = itm length = 0 Repeat If itm2\Num <> chkitm\Num Then Exit length = length + 1 itm2 = Before itm2 chkitm = Before chkitm Until itm2 = Null Or chkitm = Null If length > maxlength Then maxlength = length: maxitem = itm itm = Before itm Wend DebugLog maxlength If maxlength > 2 Then maxitem = After maxitem guess = maxitem\Num Else guess = Rand(0, 1) End If Return guess End Function Function LoadPattern(filename$) Repeat x.Record = First Record If x <> Null Then Delete x Until x = Null file = ReadFile(filename$) winnings = ReadInt(file) losses = ReadInt(file) While Not Eof(file) x.Record = New Record x\Num = ReadByte(file) DebugLog x\Num Wend End Function Function SavePattern(filename$) file = WriteFile(filename$) WriteInt file, winnings WriteInt file, losses For x.Record = Each Record WriteByte file, x\Num Next End Function
You may have to play it a few times before it begins to guess the numbers you're thinking of with better accuracy. It just uses a simple pattern recognition system to attempt to anticipate what numbers you think of. Even then, it doesn't have very much advantage over a pure random guessing system if you try to trick it.