Mind boggling card trick: Difference between revisions

→‎{{header|Haskell}}: Swapped to a more direct (recursive) formulation of threeStacks
(→‎{{header|Haskell}}: Swapped to a more direct (recursive) formulation of threeStacks)
Line 264:
import Data.Monoid ((<>))
 
-- RED vs BLACK ----------------------------------------
rb :: Int -> Char
rb n
| even n = 'R'
| otherwise = 'B'
 
-- THREE STACKS ----------------------------------------
threeStacks :: String -> (String, String, String)
threeStacks cards =
let cut = quot (length cards) 2
discards = take cut cards
pairs = (zip discards $ drop cut cards)
(rs, bs) = partition (('R' ==) . fst) pairs
in (snd <$> rs, snd <$> bs, discards)
 
-- TEST ------------------------------------------------
main :: IO [Int]
main = do
Line 306 ⟶ 290:
]
return ns
-- RED vs BLACK ----------------------------------------
rb :: Int -> Char
rb n
| even n = 'R'
| otherwise = 'B'
 
-- THREE STACKS ----------------------------------------
threeStacks :: String -> (String, String, String)
threeStacks cards = go ([],[],[]) cards
where
go tpl [] = tpl
go (rs, bs, ds) (x:[]) = (rs, bs, x:ds)
go (rs, bs, ds) (x: y: xs)
| 'R' == x = go (y:rs, bs, x:ds) xs
| otherwise = go (rs, y:bs, x:ds) xs
 
-- SHUFFLE -----------------------------------------------
9,659

edits