Because it's Friday: Card Trick

I love magic tricks, especially those that don't require sleight-of-hand (which I'm not nearly dexterous enough to pull off consistently). So this magic trick is perfect for me. Plus: the magic is actually math — specifically, a sorting algorithm based on ternary arithmetic:

 

The best YouTube comment on this video:

Have a great weekend, all!

Comments

[Aaron]

# 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)

# what's your favorite number?
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)

[Winston]

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!