## December 07, 2012

You can follow this conversation by subscribing to the comment feed for this post.

# http://blog.revolutionanalytics.com/2012/12/because-its-friday-card-trick.html

# number of piles:
p <- 3

# number of deals:
d <- 3

# total number of cards:
n <- p^d

# break open a new deck of cards:
deck <- 1:n

# shuffle them well:
deck <- sample(deck)

# pick a card, any card:
card <- sample(deck, 1)

fav <- sample(n, 1)

target <- fav - 1;
# calculate moves: base-p of target
moves <- rep(NA, d)
for (i in rev(0:(d-1))) {
remainder <- target %% (p^i);
if (remainder < target) {
moves[i+1] <- (target-remainder)/(p^i) + 1
target <- remainder
} else {
moves[i+1] <- 1
}
}

# OK, run the trick:
for (i in 1:d) {
# layout the deck in p piles, from the top:
piles <- matrix(deck, ncol=3, byrow=T)

# which pile has your card in it?
chosen <- which(apply(piles, 2, function (c) { card %in% c }));

# now pickup the piles to remake the deck; make sure the chosen pile
# goes into the moves[i]'th slot, based on the base-p of target;
# we do this by quickly swapping the piles around before collecting:
piles[,c(chosen, moves[d-i+1])] <- piles[,c(moves[d-i+1], chosen)]
deck <- rev(piles);
}

# did I get the right card?
print(deck[fav] == card)

Ahhh very clever trick. I've seen the other variation of this card trick, but this ones much more effective. Matt you did a great job of explaining how the card trick works!

This is only a preview. Your comment has not yet been posted.

Your comment could not be posted. Error type:
Your comment has been posted. Post another comment

The letters and numbers you entered did not match the image. Please try again.

As a final step before posting your comment, enter the letters and numbers you see in the image below. This prevents automated programs from posting comments.

Having trouble reading this image? View an alternate.

## Information

R for the Enterprise

Got comments or suggestions for the blog editor?
Email David Smith.