Data commit

Task/Flipping-bits-game/Haskell/flipping-bits-game.hs

@@ -0,0 +1,115 @@
+import Data.List (intersperse)
+
+import System.Random (randomRIO)
+
+import Data.Array (Array, (!), (//), array, bounds)
+
+import Control.Monad (zipWithM_, replicateM, foldM, when)
+
+type Board = Array (Char, Char) Int
+
+flp :: Int -> Int
+flp 0 = 1
+flp 1 = 0
+
+numRows, numCols :: Board -> String
+numRows t =
+  let ((a, _), (b, _)) = bounds t
+  in [a .. b]
+
+numCols t =
+  let ((_, a), (_, b)) = bounds t
+  in [a .. b]
+
+flipRow, flipCol :: Board -> Char -> Board
+flipRow t r =
+  let e =
+        [ (ix, flp (t ! ix))
+        | ix <- zip (repeat r) (numCols t) ]
+  in t // e
+
+flipCol t c =
+  let e =
+        [ (ix, flp (t ! ix))
+        | ix <- zip (numRows t) (repeat c) ]
+  in t // e
+
+printBoard :: Board -> IO ()
+printBoard t = do
+  let rows = numRows t
+      cols = numCols t
+      f 0 = '0'
+      f 1 = '1'
+      p r xs = putStrLn $ [r, ' '] ++ intersperse ' ' (map f xs)
+  putStrLn $ "  " ++ intersperse ' ' cols
+  zipWithM_
+    p
+    rows
+    [ [ t ! (y, x)
+      | x <- cols ]
+    | y <- rows ]
+
+-- create a random goal board, and flip rows and columns randomly
+-- to get a starting board
+setupGame :: Char -> Char -> IO (Board, Board)
+setupGame sizey sizex
+                -- random cell value at (row, col)
+ = do
+  let mk rc = (\v -> (rc, v)) <$> randomRIO (0, 1)
+      rows = ['a' .. sizey]
+      cols = ['1' .. sizex]
+  goal <-
+    array (('a', '1'), (sizey, sizex)) <$>
+    mapM
+      mk
+      [ (r, c)
+      | r <- rows
+      , c <- cols ]
+  start <-
+    do let change :: Board -> Int -> IO Board
+           -- flip random row
+           change t 0 = flipRow t <$> randomRIO ('a', sizey)
+           -- flip random col
+           change t 1 = flipCol t <$> randomRIO ('1', sizex)
+       numMoves <- randomRIO (3, 15) -- how many flips (3 - 15)
+       -- determine if rows or cols are flipped
+       moves <- replicateM numMoves $ randomRIO (0, 1)
+       -- make changes and get a starting board
+       foldM change goal moves
+  if goal /= start -- check if boards are different
+    then return (goal, start) -- all ok, return both boards
+    else setupGame sizey sizex -- try again
+
+main :: IO ()
+main = do
+  putStrLn "Select a board size (1 - 9).\nPress any other key to exit."
+  sizec <- getChar
+  when (sizec `elem` ['1' .. '9']) $
+    do let size = read [sizec] - 1
+       (g, s) <- setupGame (['a' ..] !! size) (['1' ..] !! size)
+       turns g s 0
+  where
+    turns goal current moves = do
+      putStrLn "\nGoal:"
+      printBoard goal
+      putStrLn "\nBoard:"
+      printBoard current
+      when (moves > 0) $
+        putStrLn $ "\nYou've made " ++ show moves ++ " moves so far."
+      putStrLn $
+        "\nFlip a row (" ++
+        numRows current ++ ") or a column (" ++ numCols current ++ ")"
+      v <- getChar
+      if v `elem` numRows current
+        then check $ flipRow current v
+        else if v `elem` numCols current
+               then check $ flipCol current v
+               else tryAgain
+      where
+        check t =
+          if t == goal
+            then putStrLn $ "\nYou've won in " ++ show (moves + 1) ++ " moves!"
+            else turns goal t (moves + 1)
+        tryAgain = do
+          putStrLn ": Invalid row or column."
+          turns goal current moves