Writing an Aaronson Oracle
Table of Contents
Github | https://gist.github.com/ambuc/01187518b73c21029e8ef427cc9137be |
---|
The Aaronson Oracle is a game where you type f
and d
at random and the
Oracle tries to guess which you’re gonna type next. It looks at your input
history and tries to find patterns.
import Data.Map as M
import Data.Maybe
import Numeric
We use a Map [Bool] Double
structure (called a brain here for no good reason)
to store sequences and how often they occur. Instead of storing f
and d
, we
store Booleans True and False (True = "f")
.
We improve the brain with learn
, which takes the history of sequences and uses
it to increment subsequence occurrence counts. We store sequences between three
and five characters long, and simultaneously create and/or update them with:
Map.insertwithKey f key newValue
, wheref key oldValue newValue = oldValue + newValue
, which can be writtenf _ = (+)
orf = const (+)
We fold this learn'
operation across the brain a few times and return the new
brain.
learn :: [Bool] -> Map [Bool] Double -> Map [Bool] Double
learn hist brain = Prelude.foldr learn' brain [3..5]
where learn' n = M.insertWithKey (const (+)) (take n hist) 1.0
We want to use the brain to “guess” how likely an f
or d
will be. This will
be a weighted average, where the value is how likely a given lookback period
would indicate, and the weight is how many datapoints we have for a given
lookback period.
For example, take a brain with key/value pairs:
[ T T ] -> 2
[ F T ] -> 3
[ T T F ] -> 3
[ F T F ] -> 1
Imagine we’ve just typed F
and then T
. Looking back only one character (just
at the T
) would indicate that F will follow 3 out of 5 times, but looking back
two characters would indicate that T
will follow 3 out of 4 times. We can
weight those values by certainty to get a pretty good prediction.
guess :: Map [Bool] Double -> [Bool] -> Bool
guess brain hist = wAvg (Prelude.map guess' [2..4]) >= 0.5
where wAvg xs = sum (Prelude.map (uncurry (*)) xs) / sum (Prelude.map snd xs)
guess' n = (occ True / (occ True + occ False), occ True + occ False)
where occ val = fromMaybe 0.0 $ M.lookup (val : take n hist) brain
M.lookup key map
returns a Maybe val
, so we wrap it in a fromMaybe default
to ensure some real number gets returned.
Then it’s time to play a turn! Each turn needs to be aware of what turn number it is (turn), how many games were won and held before it (wons, total), the prior history (hist), and the prior brain (brain).
We get the keypress, judge it against the guess brain hist
, and print a
message to the user.
Then we kick off a new round with an incremented turn number, potential incremented win number, incremented total games number, augmented history, and new and improved brain.
play :: Int -> (Double, Double) -> [Bool] -> Map [Bool] Double -> IO a
play turn (wons, total) hist brain = do
press <- getLine
let key = press == "f"
let right = key == guess brain hist
let wins = (if right then succ else id) wons
print $ "I guessed " ++ (if right then "RIGHT!" else "wrong.")
++ " My avg: " ++ showFFloat (Just 2) (wins / succ total) ""
play (succ turn) (wins, succ total) (key:hist) (learn (key:hist) brain)
The main block prints instructions and kicks off the game at round zero, with zero wins for zero total games, an empty history array, and an empty brain.
main = do
print "aaronson oracle | Press 'f' or 'd' over and over (followed by enter)"
print " | and we'll try to predict which you'll press next."
play 0 (0.0, 0.0) [] M.empty
You can see the full code here, in a gist.