The game

Given an   N×N   square array of zeroes or ones in an initial configuration,   and a target configuration of zeroes and ones.



The game is to transform one to the other in as few moves as possible by inverting whole numbered rows or whole lettered
columns at once   (as one move).

In an inversion.   any  1  becomes  0,   and any  0  becomes  1  for that whole row or column.



Task

Create a program to score for the Flipping bits game.

 The game should create an original random target configuration and a starting configuration.
 Ensure that the starting position is never the target position.
 The target position must be guaranteed as reachable from the starting position.   (One possible way to do this is to generate the start position by legal flips from a random target position.   The flips will always be reversible back to the target from the given start position).
 The number of moves taken so far should be shown.


Show an example of a short game here, on this page, for a   3×3   array of bits.




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