Mind boggling card trick: Difference between revisions

import Data.List (partition)

import Data.Monoid ((<>))

main :: IO [Int]

main = do

-- DEALT

ns <- knuthShuffle [1 .. 52]

let (rs_, bs_, discards) = threeStacks (rb <$> ns)

-- SWAPPED

nSwap <- randomRIO (1, min (length rs_) (length bs_))

let (rs, bs) = exchange nSwap rs_ bs_

-- CHECKED

let rrs = filter ('R' ==) rs

]

return ns

-- RED vs BLACK ----------------------------------------

rb :: Int -> Char

| even n = 'R'

| otherwise = 'B'

-- THREE STACKS ----------------------------------------

threeStacks :: String -> (String, String, String)

| 'R' == x = go (y : rs, bs, x : ds) xs

| otherwise = go (rs, y : bs, x : ds) xs

exchange :: Int -> [a] -> [a] -> ([a], [a])

exchange n xs ys =

let [xs_, ys_] = splitAt n <$> [xs, ys]

in (fst ys_ <> snd xs_, fst xs_ <> snd ys_)

-- SHUFFLE -----------------------------------------------

-- (See Knuth Shuffle task)

knuthShuffle :: [a] -> IO [a]

knuthShuffle xs = (foldr swapElems xs . zip [1 ..]) <$> randoms (length xs)

randoms :: Int -> IO [Int]

swapElems :: (Int, Int) -> [a] -> [a]

swapElems (i, j) xs

| i == j = xs

| otherwise = replaceAt j (xs !! i) $ replaceAt i (xs !! j) xs

replaceAt :: Int -> a -> [a] -> [a]

replaceAt i c l =