Mind-Boggling Card Trick

September 4, 2018

This is straight forward:

(define (trick)
  (let ((pack (shuffle (append (make-list 26 'B) (make-list 26 'R)))))
    (display "Pack: ") (display pack) (newline)
    (let loop ((pack pack) (blacks (list)) (reds (list)) (discards (list)))
      (if (pair? pack)
          (if (eq? (car pack) 'B)
              (loop (cddr pack) (cons (cadr pack) blacks) reds (cons (car pack) discards))
              (loop (cddr pack) blacks (cons (cadr pack) reds) (cons (car pack) discards)))
            (display "Blacks: ") (display blacks) (newline)
            (display "Reds: ") (display reds) (newline)
            (display "Discards: ") (display discards) (newline)
            (let ((swap (randint (min (length blacks) (length reds)))))
              (display "Swap size is ") (display swap) (newline)
              (let* ((blacks (shuffle blacks)) (reds (shuffle reds))
                     (bs (append (take swap reds) (drop swap blacks)))
                     (rs (append (take swap blacks) (drop swap reds))))
                (display "Blacks: ") (display bs) (newline)
                (display "Reds: ") (display rs) (newline)
                (let ((black-count (length (filter (lambda (x) (eq? x 'B)) bs)))
                      (red-count (length (filter (lambda (x) (eq? x 'R)) rs))))
                  (display "Black count is ") (display black-count) (display "; ")
                  (display "red count is ") (display red-count) (display ".") (newline)
                  (if (= black-count red-count)
                      (display "Black count equals red count.")
                      (display "Black count does not equal red count."))))))))))

Here is a sample run:

> (trick)
Pack: (B R B R B R R R R B B R B R B B R R R B R R B B B R B R R R B R R B B B R B R R B R B B B B R B R B R B)
Blacks: (B B R B R R R B B R R R R R)
Reds: (B B B R B B R R B R B R)
Discards: (R R R B B B R R B R B R B B B R R R B B B R R B B B)
Swap size is 11
Blacks: (R B R B R B B B B B R R R B)
Reds: (B R B R R B B R R R R R)
Black count is 8; red count is 8.
Black count equals red count.

You can run the program at https://ideone.com/QCHUms. Can anyone provide an explanation of the trick?

Pages: 1 2

4 Responses to “Mind-Boggling Card Trick”

  1. Informatmiago said

    This is indeed a magic trick:

    The first phase is not random at all, because the operation ensures that there are the same number of black in the black stack as there are reds in the red stack. Discading the seen cards, ensures that there will remain the exact same number of cards (either of the same color, or the opposite color) to be moved to the other stack.

    The second part is just for the spectacle, since it’s an operation that does not change that property (if two cards of the same color are exchanged, then no change; if cards of different colors are exchanged, then either it increments both counts (if the right color leaves each stack), or it decrements both counts (if red leaves the red stack and black leaves the black stack). Randomness does not matter, you could choose the cards you want, as long as you exchange the same number from both stacks :-)

  2. Rutger said

    This code almost reads like the assignment to me ;)

    from random import shuffle
    from random import randint
    deck = 26*['black'] + 26*['red']
    red_stack = []
    black_stack = []
    while deck:
    	item = deck.pop()
    	if item == 'black':
    swap = randint(1, min(len(black_stack), len(red_stack)))
    black_stack, red_stack = red_stack[:swap]+black_stack[swap:], black_stack[:swap]+red_stack[swap:]
  3. Globules said

    A Haskell version.

    import Control.Monad.Random (RandT, evalRandT, getRandomR, liftIO)
    import Data.Tuple.Extra (both)
    import Data.List (partition)
    import System.Random.Shuffle (shuffleM)
    import System.Random.TF.Gen (TFGen)
    import System.Random.TF.Init (initTFGen)
    import Text.Printf (PrintfArg, formatArg, formatString, printf)
    data Card = Black | Red deriving (Eq, Show)
    orderedDeck :: [Card]
    orderedDeck = replicate 26 Black ++ replicate 26 Red
    -- Look at the first card of the list.  If it's black add the next card to the
    -- black stack, otherwise add it to the red stack.  Discard the first card.
    -- Repeat this until the list has been exhausted.  Return the black and red
    -- stacks.  If the list contains an odd number of cards the last one will simply
    -- be discarded.
    makeStacks :: [Card] -> ([Card], [Card])
    makeStacks = both (map snd) . partition ((== Black) . fst) . pairs
      where pairs (x:y:zs) = (x, y) : pairs zs
            pairs _        = []
    -- The result of randomly swapping elements between two lists.  (We don't bother
    -- retaining the relative order of the original elements.)
    randomSwap :: ([a], [a]) -> RandC ([a], [a])
    randomSwap (xs, ys) = do n <- getRandomR (0, (length xs `min` length ys) - 1)
                             (xs1, xs2) <- splitShuffle n xs
                             (ys1, ys2) <- splitShuffle n ys
                             return (ys1 ++ xs2, xs1 ++ ys2)
      where splitShuffle n zs = splitAt n <$> shuffleM zs
    -- Simulate the card trick described in the exercise.
    cardTrick :: RandC ()
    cardTrick = do deck <- shuffleM orderedDeck
                   (blackStack, redStack) <- randomSwap (makeStacks deck)
                   printNumberOf Black blackStack
                   printNumberOf Red   redStack
    main :: IO ()
    main = initTFGen >>= evalRandT cardTrick
    ---------------------------------- Utilities ----------------------------------
    type RandC a = RandT TFGen IO a
    instance PrintfArg Card where
      formatArg c = formatString (show c)
    printNumberOf :: Card -> [Card] -> RandC ()
    printNumberOf c = liftIO . printf "%s cards in %s stack: %d\n" c c
                             . length . filter (== c)
    $ for i in $(seq 1 10); do ./cardtrick; done
    Black cards in Black stack: 4
    Red cards in Red stack: 4
    Black cards in Black stack: 6
    Red cards in Red stack: 6
    Black cards in Black stack: 8
    Red cards in Red stack: 8
    Black cards in Black stack: 5
    Red cards in Red stack: 5
    Black cards in Black stack: 9
    Red cards in Red stack: 9
    Black cards in Black stack: 10
    Red cards in Red stack: 10
    Black cards in Black stack: 6
    Red cards in Red stack: 6
    Black cards in Black stack: 7
    Red cards in Red stack: 7
    Black cards in Black stack: 6
    Red cards in Red stack: 6
    Black cards in Black stack: 6
    Red cards in Red stack: 6
  4. Daniel said

    Here’s a solution in Python.

    from collections import deque
    import random
    deck = [0] * 26 + [1] * 26
    stacks = [deque(), deque()]
    for top, bottom in zip(deck[0::2], deck[1::2]):
    for stack in stacks:
    min_len = min(len(stack) for stack in stacks)
    num_swaps = random.randint(0, min_len - 1)
    for idx in range(num_swaps):
    assert stacks[0].count(0) == stacks[1].count(1)

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: