Flipping bits game: Difference between revisions

Content added Content deleted
m (→‎{{header|Perl 6}}: numeric sorting of rows)
(→‎{{header|Haskell}}: Specified imports, applied hlint, hindent)
Line 1,264: Line 1,264:
=={{header|Haskell}}==
=={{header|Haskell}}==
Maximum game size is 9x9 because the array indices are the characters 1 until 9.
Maximum game size is 9x9 because the array indices are the characters 1 until 9.
<lang Haskell>
<lang Haskell>import Data.Array (Array, (!), (//), array, bounds)

import Data.Array
import Data.List
import Data.List (intersperse)

import Control.Monad
import Control.Monad (zipWithM_, replicateM, foldM, when)
⚫
import System.Random

⚫
import System.Random (randomRIO)


type Board = Array (Char, Char) Int
type Board = Array (Char, Char) Int
Line 1,276: Line 1,278:
flp 1 = 0
flp 1 = 0


numRows, numCols :: Board -> [Char]
numRows, numCols :: Board -> String
numRows t =
numRows t = let ((a, _), (b, _)) = bounds t in [a .. b]
let ((a, _), (b, _)) = bounds t
in [a .. b]

numCols t =
⚫
let ((_, a), (_, b)9) = bounds t
in [a .. b]


⚫
numCols t = let ((_, a), (_, b)) = bounds t in [a .. b]
⚫
flipRow, flipCol :: Board -> Char -> Board
flipRow, flipCol :: Board -> Char -> Board
flipRow t r = let e = [ (ix, flp (t ! ix)) | ix <-
flipRow t r =
let e =
⚫
zip (repeat r) (numCols t) ]
in t // e
[ (ix, flp (t ! ix))
⚫
| ix <- zip (repeat r) (numCols t) ]
in t // e


flipCol t c = let e = [ (ix, flp (t ! ix)) | ix <-
flipCol t c =
let e =
⚫
zip (numRows t) (repeat c) ]
in t // e
[ (ix, flp (t ! ix))
⚫
| ix <- zip (numRows t) (repeat c) ]
in t // e


printBoard :: Board -> IO ()
printBoard :: Board -> IO ()
printBoard t = do
printBoard t = do
let rows = numRows t
let rows = numRows t
cols = numCols t
cols = numCols t
f 0 = '0'
f 0 = '0'
f 1 = '1'
f 1 = '1'
p r xs = putStrLn $ [r, ' '] ++ intersperse ' ' (map f xs)
p r xs = putStrLn $ [r, ' '] ++ intersperse ' ' (map f xs)
putStrLn $ " " ++ intersperse ' ' cols
putStrLn $ " " ++ intersperse ' ' cols
zipWithM_
zipWithM_ p rows [ [ t ! (y, x) | x <- cols ] | y <- rows ]
⚫
p
⚫
rows
[ [ t ! (y, x)
⚫
| x <- cols ]
| y <- rows ]


-- create a random goal board, and flip rows and columns randomly
-- create a random goal board, and flip rows and columns randomly
-- to get a starting board
-- to get a starting board
setupGame :: Char -> Char -> IO (Board, Board)
setupGame :: Char -> Char -> IO (Board, Board)
setupGame sizey sizex = do
setupGame sizey sizex
-- random cell value at (row, col)
-- random cell value at (row, col)
= do
⚫
let mk rc = fmap (\v -> (rc, v)) $ randomRIO (0, 1)
rows = ['a' .. sizey]
let mk rc = (\v -> (rc, v)) <$> randomRIO (0, 1)
cols = ['1' .. sizex]
rows = ['a' .. sizey]
goal <- fmap (array (('a', '1'), (sizey, sizex))) $
cols = ['1' .. sizex]
goal <-
mapM mk [ (r, c) | r <- rows, c <- cols ]
array (('a', '1'), (sizey, sizex)) <$>
⚫
start <- do
mapM
⚫
let change :: Board -> Int -> IO Board
mk
-- flip random row
[ (r, c)
⚫
change t 0 = fmap (flipRow t) $ randomRIO ('a', sizey)
-- flip random col
| r <- rows
, c <- cols ]
⚫
change t 1 = fmap (flipCol t) $ randomRIO ('1', sizex)
start <-
numMoves <- randomRIO (3, 15) -- how many flips (3 - 15)
⚫
do let change :: Board -> Int -> IO Board
-- determine if rows or cols are flipped
moves <- replicateM numMoves $ randomRIO (0, 1)
-- flip random row
⚫
change t 0 = flipRow t <$> randomRIO ('a', sizey)
⚫
-- make changes and get a starting board
foldM change goal moves
-- flip random col
⚫
change t 1 = flipCol t <$> randomRIO ('1', sizex)
⚫
if goal /= start -- check if boards are different
then return (goal, start) -- all ok, return both boards
numMoves <- randomRIO (3, 15) -- how many flips (3 - 15)
else setupGame sizey sizex -- try again
-- 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 :: IO ()
main = do
main = do
putStrLn "Select a board size (1 - 9).\nPress any other key to exit."
putStrLn "Select a board size (1 - 9).\nPress any other key to exit."
sizec <- getChar
sizec <- getChar
when (sizec `elem` ['1' .. '9']) $ do
when (sizec `elem` ['1' .. '9']) $
let size = read [sizec] - 1
do let size = read [sizec] - 1
(g, s) <- setupGame (['a'..] !! size) (['1'..] !! size)
(g, s) <- setupGame (['a' ..] !! size) (['1' ..] !! size)
turns g s 0
turns g s 0
where
⚫
turns goal current moves = do
⚫
where
⚫
putStrLn "\nGoal:"
⚫
turns goal current moves = do
⚫
printBoard goal
⚫
putStrLn "\nGoal:"
⚫
putStrLn "\nBoard:"
⚫
printBoard goal
printBoard current
⚫
putStrLn "\nBoard:"
printBoard current
when (moves > 0) $
when (moves > 0) $
putStrLn $ "\nYou've made " ++ show moves ++ " moves so far."
putStrLn $ "\nYou've made " ++ show moves ++ " moves so far."
putStrLn $
putStrLn $ "\nFlip a row (" ++ numRows current ++
"\nFlip a row (" ++
") or a column (" ++ numCols current ++ ")"
numRows current ++ ") or a column (" ++ numCols current ++ ")"
v <- getChar
v <- getChar
if v `elem` numRows current
if v `elem` numRows current
then check $ flipRow current v
then check $ flipRow current v
else if v `elem` numCols current
else if v `elem` numCols current
then check $ flipCol current v
then check $ flipCol current v
else tryAgain
else tryAgain
where
where check t = if t == goal
check t =
if t == goal
then putStrLn $ "\nYou've won in " ++
show (moves + 1) ++ " moves!"
then putStrLn $ "\nYou've won in " ++ show (moves + 1) ++ " moves!"
else turns goal t (moves + 1)
else turns goal t (moves + 1)
tryAgain = do
tryAgain = do
putStrLn ": Invalid row or column."
turns goal current moves</lang>
putStrLn ": Invalid row or column."
{{Out}}
⚫
turns goal current moves
⚫
<pre>Select a board size (1 - 9).
</lang>
<b>Output:</b>
<pre>
⚫
Select a board size (1 - 9).
Press any other key to exit.
Press any other key to exit.
3
3
Line 1,395: Line 1,413:
Flip a row (abc) or a column (123)
Flip a row (abc) or a column (123)
c
c
You've won in 2 moves!
You've won in 2 moves!</pre>
</pre>


=={{header|J}}==
=={{header|J}}==
Retrieved from "https://rosettacode.org/wiki/Flipping_bits_game"