Randometer (empty) → 0.1.0.0

raw patch · 5 files changed

+219/−0 lines, 5 filesdep +basedep +random-fusetup-changed

Dependencies added: base, random-fu

Files

• LICENSE +20/−0
• README.md +8/−0
• Randometer.cabal +18/−0
• Setup.hs +2/−0
• randometer.hs +171/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 So8res++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,8 @@+This is a little set of games that have helped me gain an intuition for random+behavior. A better knowledge of what random patterns look like has helped me,+in real life, to better differentiate between chance occurrences and actual+patterns.++Humans are [biased to see patterns in random data](http://psych.cornell.edu/sites/default/files/Gilo.Vallone.Tversky.pdf):+these games go a little way towards helping identify and correct for that bias,+by staving off premature pattern matching.

@@ -0,0 +1,18 @@+name:                Randometer+version:             0.1.0.0+synopsis:            Randomness intuition trainer+homepage:            http://github.com/Soares/Randometer.hs+license:             MIT+license-file:        LICENSE+author:              So8res+maintainer:          nate@so8r.es+category:            PersonalGrowth+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++executable randometer+  main-is:             randometer.hs+  other-extensions:    OverloadedStrings+  build-depends:       base >=4.6 && <4.7, random-fu >=0.2 && <0.3+  default-language:    Haskell2010

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,171 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main, moreOrLess, decide, chooseOne) where+import Control.Applicative+import Control.Monad (replicateM)+import Data.Char (toLower)+import Data.Random+import Text.Printf (printf)+import System.IO (hFlush, stdout)++size :: (Int, Int)+size = (24, 6)++data Trial = On | Off deriving Eq+instance Show Trial where+    show On = "●"+    show Off = "○"++invert :: Trial -> Trial+invert On = Off+invert Off = On++trial :: IO Trial+trial = runRVar (randomElement [On, Off]) StdRandom++mutedTrial :: Double -> Trial -> IO Trial+mutedTrial propensity memory = do+    rand <- runRVar (uniform 0 1) StdRandom+    pure $ if rand < propensity then invert memory else memory++biasedTrial :: Double -> IO Trial+biasedTrial propensity = do+    rand <- runRVar (uniform 0 1) StdRandom+    pure $ if rand < propensity then On else Off++generator :: Int -> Double -> IO [Trial]+generator i = (trial >>=) . generator' i where+    generator' 0 _ _ = pure []+    generator' cap propensity previous = (previous:) <$> genrest where+        gennext = mutedTrial propensity previous+        genrest = gennext >>= generator' (cap - 1) propensity++biasedGenerator :: Int -> Double -> IO [Trial]+biasedGenerator n p = replicateM n $ biasedTrial p++boxed :: [String] -> [String]+boxed xs = header : map addSides xs ++ [footer] where+    len = maximum $ map length xs+    header = '┌' : replicate len '─' ++ "┐"+    addSides line = '│' : take len (line ++ repeat ' ') ++ "│"+    footer = '└' : replicate len '─' ++ "┘"++puzzle :: Int -> [Trial] -> [String]+puzzle _ [] = []+puzzle n ys = boxed $ map (concatMap show) (groupsOf n ys)++groupsOf :: Int -> [a] -> [[a]]+groupsOf _ [] = []+groupsOf n xs = take n xs : groupsOf n (drop n xs)++askN :: String -> [Int] -> IO Int+askN prompt ints = do+    printf "%s\n» " prompt+    hFlush stdout+    guess <- getLine+    if guess `elem` map show ints+    then pure $ read guess+    else askN prompt ints++askBool :: String -> IO Bool+askBool prompt = do+    printf "%s\n» " prompt+    hFlush stdout+    guess <- getLine+    case map toLower guess of+        "y" -> return True+        "yes" -> return True+        "n" -> return False+        "no" -> return False+        _ -> askBool prompt++numberedBox :: Int -> [String] -> [String]+numberedBox n xs = pad x0 : (leader ++ x1) : map pad xN where+    leader = printf "%d. " n+    pad = (map (const ' ') leader ++)+    x0 = head xs+    x1 = head $ tail xs+    xN = tail $ tail xs++shuffleBoards :: [[Trial]] -> IO [Int]+shuffleBoards boards = runRVar (shuffle [0 .. pred $ length boards]) StdRandom++displayBoards :: [[Trial]] -> [Int] -> IO ()+displayBoards boards key = do+    let display n = putStr . unlines . numberedBox n . puzzle (fst size)+    mapM_ (uncurry display) (zip [1 ..] $ map (boards !!) key)++chooseOne :: Double -> [Double] -> IO ()+chooseOne x xs = do+    boards <- mapM (generator $ uncurry (*) size) (x:xs)+    key <- shuffleBoards boards+    displayBoards boards key++    guess <- pred <$> askN "Which is truly random?" [1 .. length boards]+    putStrLn ""+    putStrLn (if key !! guess == 0 then "Correct!" else "Wrong.")++    let reveal n = printf "%d: %0.2f switch\n" n ((x:xs) !! (key !! pred n))+    mapM_ reveal [1 .. length boards]++chooseUnbiased :: Double -> [Double] -> IO ()+chooseUnbiased x xs = do+    boards <- mapM (biasedGenerator $ uncurry (*) size) (x:xs)+    key <- shuffleBoards boards+    displayBoards boards key++    guess <- pred <$> askN "Which is unbiased?" [1 .. length boards]+    putStrLn ""+    putStrLn (if key !! guess == 0 then "Correct!" else "Wrong.")++    let reveal n = printf "%d: %0.2f ●\n" n ((x:xs) !! (key !! pred n))+    mapM_ reveal [1 .. length boards]++decide :: Double -> [Double] -> IO ()+decide x xs = do+    boards <- mapM (generator $ uncurry (*) size) (x:xs)+    choice <- runRVar (randomElement [0 .. pred $ length boards]) StdRandom+    putStr $ unlines $ puzzle (fst size) $ boards !! choice+    guess <- askBool "Was this generated by a fair random generator?"+    putStrLn (if guess == (choice == 0) then "Correct!" else "Wrong.")+    printf "The dots flip with %0.2f chance.\n" $ (x:xs) !! choice++decideBiased :: Double -> [Double] -> IO ()+decideBiased x xs = do+    boards <- mapM (biasedGenerator $ uncurry (*) size) (x:xs)+    choice <- runRVar (randomElement [0 .. pred $ length boards]) StdRandom+    putStr $ unlines $ puzzle (fst size) $ boards !! choice+    guess <- askBool "Was this generated by an unbiased random generator?"+    putStrLn (if guess == (choice == 0) then "Correct!" else "Wrong.")+    printf "The dots flip with %0.2f chance.\n" $ (x:xs) !! choice++moreOrLess :: IO ()+moreOrLess = do+    var <- runRVar stdUniform StdRandom+    board <- generator (uncurry (*) size) var+    putStr $ unlines $ puzzle (fst size) board+    guess <- askBool "Are these dots more likely to flip than chance?"+    putStrLn (if guess == (var > 0.5) then "Correct!" else "Wrong.")+    putStrLn ""+    printf "The dots flipped %0.6f times out of one.\n" var++identifyBias :: IO ()+identifyBias = do+    var <- runRVar stdUniform StdRandom+    board <- biasedGenerator (uncurry (*) size) var+    putStr $ unlines $ puzzle (fst size) board+    guess <- askBool "Are these dots biased towards ●?"+    putStrLn (if guess == (var > 0.5) then "Correct!" else "Wrong.")+    putStrLn ""+    printf "The were biased %0.6f ●.\n" var++main :: IO ()+main = do+    game <- askN "Would you like to play a game? (Select [0-5])" [0..5]+    case game of+        0 -> chooseOne (1/2) [1/4, 1/3, 2/3, 3/4]+        1 -> decide (1/2) [1/4, 1/3, 2/3, 3/4]+        2 -> moreOrLess+        3 -> chooseUnbiased (1/2) [1/4, 1/3, 2/3, 3/4]+        4 -> decideBiased (1/2) [1/4, 1/3, 2/3, 3/4]+        5 -> identifyBias+        _ -> putStrLn "Wait, how did you do that?"