Mind boggling card trick: Difference between revisions

Content added Content deleted
m (→‎{{header|zkl}}: tweak comment)
(→‎{{header|Haskell}}: (Some tidying of the threeStack function, refreshed sample output))
Line 290: Line 290:
]
]
return ns
return ns


-- RED vs BLACK ----------------------------------------
-- RED vs BLACK ----------------------------------------
rb :: Int -> Char
rb :: Int -> Char
Line 299: Line 300:
-- THREE STACKS ----------------------------------------
-- THREE STACKS ----------------------------------------
threeStacks :: String -> (String, String, String)
threeStacks :: String -> (String, String, String)
threeStacks cards = go ([],[],[]) cards
threeStacks = go ([], [], [])
where
where
go tpl [] = tpl
go tpl [] = tpl
go (rs, bs, ds) (x:[]) = (rs, bs, x:ds)
go (rs, bs, ds) [x] = (rs, bs, x : ds)
go (rs, bs, ds) (x: y: xs)
go (rs, bs, ds) (x:y:xs)
| 'R' == x = go (y:rs, bs, x:ds) xs
| 'R' == x = go (y : rs, bs, x : ds) xs
| otherwise = go (rs, y:bs, x:ds) xs
| otherwise = go (rs, y : bs, x : ds) xs


-- SHUFFLE -----------------------------------------------
-- SHUFFLE -----------------------------------------------
-- (See Knuth Shuffle task)
-- (See Knuth Shuffle task)

knuthShuffle :: [a] -> IO [a]
knuthShuffle :: [a] -> IO [a]
knuthShuffle xs = (foldr swapElems xs . zip [1 ..]) <$> randoms (length xs)
knuthShuffle xs = (foldr swapElems xs . zip [1 ..]) <$> randoms (length xs)
Line 326: Line 326:
in a ++ c : drop 1 b</lang>
in a ++ c : drop 1 b</lang>
{{Out}}
{{Out}}
<pre>Discarded: RBRRRRBRRBRRRBBBBRBBBRRBBB
<pre>Discarded: RRRRRBBBBBRBBBRBBRBRRBRRRB
Swapped: 3
Swapped: 7
Red pile: BRBBBBRRRBRRR
Red pile: BBBRRBRBRBBRR
Black pile: RRRBBRBBRBBBR
Black pile: BRRRRRBBRBBRB
RRRRRRR = Red cards in the red pile
RRRRRR = Red cards in the red pile
BBBBBBB = Black cards in the black pile
BBBBBB = Black cards in the black pile
True</pre>
True</pre>


Retrieved from "https://rosettacode.org/wiki/Mind_boggling_card_trick"