Skip to content

Instantly share code, notes, and snippets.

@agrif
Last active September 23, 2016 00:58
Show Gist options
  • Save agrif/6836ebe4a46eb3e168241f8f1a1000b2 to your computer and use it in GitHub Desktop.
Save agrif/6836ebe4a46eb3e168241f8f1a1000b2 to your computer and use it in GitHub Desktop.
import Control.Applicative
import Control.Monad
import Data.Foldable (traverse_)
import Data.List
data Move = B | X | O deriving (Eq, Show)
-- things that can have moves applied to them
class (Eq a) => Movable a where
move :: Move -> a -> [a]
-- blanks can have moves applied
instance Movable Move where
move m B = [B, m]
move m x = [x]
-- lists of things that can have moves applied can also have moves applied
instance (Movable a) => Movable [a] where
move m [] = []
move m (x:xs) = nub $ (:xs) <$> move m x <|> (x:) <$> move m xs
-- get the diagonal of a list
diagonal :: [[a]] -> [a]
diagonal [] = []
diagonal (x:xs) = head x : diagonal (tail <$> xs)
-- is this row either all X's or all O's?
winRow :: [Move] -> Bool
winRow = or . sequence [all (==X), all (==O)]
-- a board wins if:
-- 1. any row is all X or O
-- 2. any column is all X or O
-- 3. any diagonal is all X or O
win :: [[Move]] -> Bool
win = or . sequence [any winRow, any winRow . transpose, winRow . diagonal, winRow . diagonal . reverse]
-- apply a move to the board if it's not won
play :: [[Move]] -> [[[Move]]]
play b | win b = [b]
| otherwise = nub $ move X b ++ move O b
-- run a function until the result stops changing
converge :: (Eq a) => (a -> a) -> a -> a
converge f a | a == fa = a
| otherwise = converge f fa
where fa = f a
-- a blank 3x3 board
blankBoard = [[B, B, B], [B, B, B], [B, B, B]]
-- all boards you can reach from a blank board
boards :: [[[Move]]]
boards = converge (nub . foldMap play) [blankBoard]
-- print out boards nicer
printBoard :: [[Move]] -> IO ()
printBoard b = traverse_ printRow b >> putStrLn "-"
where printRow [] = putStrLn ""
printRow (B:xs) = putStr " " >> printRow xs
printRow (x:xs) = putStr (show x) >> printRow xs
-- print out how many boards there are
main :: IO ()
main = print (length boards)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment