Created
March 4, 2018 22:27
-
-
Save chrismwendt/a48cf10fd90d2092b0760a6df6d75438 to your computer and use it in GitHub Desktop.
A solution to the 3 gods puzzle
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/usr/bin/env stack | |
| {- | |
| stack | |
| --resolver lts-10.1 | |
| --install-ghc | |
| --package random-extras | |
| --package random-fu | |
| script | |
| -} | |
| {-# LANGUAGE OverloadedStrings #-} | |
| import System.Random | |
| import Control.Monad | |
| import Data.Random.Extras | |
| import Data.Random.RVar | |
| import Data.Random.Source.DevRandom | |
| data GodType = T | F | R deriving (Eq, Show) | |
| type GodID = Int | |
| type Permutation = [GodType] | |
| data PrimQ = | |
| PrimQ GodID GodID GodType -- (X, Y, Z): ask god X "Is god Y of type Z?" | |
| deriving (Eq, Show) | |
| data Eng = Yes | No deriving (Eq, Show) | |
| data Urk = Da | Ja deriving (Eq, Show) | |
| data LangMap = DaMeansYes | DaMeansNo deriving (Eq, Show) | |
| type Question = ([GodType], GodType, LangMap) -> Eng | |
| data Strategy = | |
| SDone Permutation | |
| | SQuestion | |
| GodID -- who to ask | |
| Question | |
| Strategy -- when the repsonse is "da" | |
| Strategy -- when the repsonse is "ja" | |
| boolToEng :: Bool -> Eng | |
| boolToEng True = Yes | |
| boolToEng False = No | |
| solution :: Strategy | |
| solution = | |
| let | |
| q about theType (types, ty, langMap) = | |
| boolToEng | |
| $ (case ty of | |
| T -> id | |
| F -> not | |
| R -> id) | |
| $ (if langMap == DaMeansYes then id else not) | |
| $ (types !! about) == theType | |
| in | |
| SQuestion 0 (q 1 R) | |
| (SQuestion 2 (q 0 R) | |
| (SQuestion 2 (q 2 T) | |
| (SDone [R, F, T]) | |
| (SDone [R, T, F])) | |
| (SQuestion 2 (q 2 T) | |
| (SDone [F, R, T]) | |
| (SDone [T, R, F]))) | |
| (SQuestion 1 (q 0 R) | |
| (SQuestion 1 (q 1 T) | |
| (SDone [R, T, F]) | |
| (SDone [R, F, T])) | |
| (SQuestion 1 (q 1 T) | |
| (SDone [F, T, R]) | |
| (SDone [T, F, R]))) | |
| sampleRun :: Strategy -> IO () | |
| sampleRun s = do | |
| perm <- runRVar (shuffle [T, F, R]) DevRandom | |
| langMap <- fmap ([DaMeansYes, DaMeansNo] !!) $ randomRIO (0, 1) | |
| let | |
| flipEng Yes = No | |
| flipEng No = Yes | |
| engToUrk DaMeansYes Yes = Da | |
| engToUrk DaMeansYes No = Ja | |
| engToUrk DaMeansNo Yes = Ja | |
| engToUrk DaMeansNo No = Da | |
| answerAs T eng = return $ engToUrk langMap eng | |
| answerAs F eng = return $ engToUrk langMap (flipEng eng) | |
| answerAs R eng = fmap ([Da, Ja] !!) $ randomRIO (0, 1) | |
| go (SDone p) = print (p == perm, p, perm) | |
| go (SQuestion to q whenDa whenJa) = do | |
| answer <- answerAs (perm !! to) (q (perm, perm !! to, langMap)) | |
| case (answer :: Urk) of | |
| Da -> go whenDa | |
| Ja -> go whenJa | |
| go s | |
| main :: IO () | |
| main = replicateM_ 10 $ sampleRun solution |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment