The Aaronson Oracle is a game where you type
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
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, where
f key oldValue newValue = oldValue + newValue, which can be written
f _ = (+)or
f = const (+)
We fold this
learn' operation across the brain a few times and return the new
> 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
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
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
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
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.