A Blog About D4T4 & M47H

538 Riddler: Martin Gardner's 'Hip' Game

09 January ’17

I began this week's Riddler by deriving an expression for the number of squares on a n-sized board:

This expression is a polynomial with a degree of 4, which confirms that the number of squares grows more quickly than the area of the board, making it increasingly difficult to achieve a draw.

To find tie configurations, I used an integer program. The objective function, to be minimized, represents the number of squares formed. There are two constraints for each square, each requiring that all 4 points not be assigned to a single player. And one constraint requires that the points be evenly divided between the two players. All variables are binary.

A 6x6 board is the largest board for which the optimal solution to this integer program is 0, indicating a tie. For a 7x7 board, the optimal solution still has 3 squares. And ties must be impossible on any larger boards since they will of course contain a 7x7 sub-board. Here's what optimal solutions on the 6x6 and 7x7 boards look like:


# make the squares
n <- 6
squares <- data.frame()
for (i in 1:(n-1)){
  for (j in 2:n){
    p1 <- c(i, j)
    p2 <- expand.grid(x2=(p1[1]+1):n, y2=p1[2]:n)
    p3 <- data.frame(x3=p2$x2+p2$y2-p1[2], y3=p2$y2-p2$x2+p1[1])
    p4 <- data.frame(x4=p1[1]+p2$y2-p1[2], y4=p1[2]-p2$x2+p1[1])
    squares_temp <- cbind(data.frame(x1=p1[1], y1=p1[2]),p2,p3,p4)
    squares_temp <- squares_temp[apply(squares_temp, 1, function(x) all(x>=1 & x<=n)),]
    squares <- rbind(squares, squares_temp)

squares2 <- squares %>% mutate(c1=(x1-1)*n+y1, c2=(x2-1)*n+y2, c3=(x3-1)*n+y3, c4=(x4-1)*n+y4)
for (i in 1:n^2){
  squares2[[paste0("p",i)]] <- ifelse(apply(squares2[,c("c1","c2","c3","c4")], 1, function(x) any(x==i)),1,0)
squares2 <- as.matrix(squares2[,paste0("p",1:n^2)])

n_squares <- nrow(squares2)
# make linear program
temp <- matrix(0, ncol=n_squares*2, nrow=n_squares*2)
diag(temp) <- rep(c(1,-1), each=n_squares)

A <- cbind(rbind(1, squares2, squares2), rbind(0, temp))
b <- c(ceiling(n^2/2), rep(c(1,3), each=n_squares))
dir <- c("=", rep(c(">=","<="), each=n_squares))

c <- rep(1, ncol(A))
c[1:n^2] <- 0

program <- lp(direction="min",, const.mat=A, const.dir=dir, const.rhs=b, all.bin=TRUE)
Success: the objective function is 0
# plot solution
solution <- data.frame(point=1:n^2, player=ifelse(head(program$solution,n^2)==1,"P1","P2"))
solution <- mutate(solution, x=ceiling(point/n), y=ifelse(point%%n==0,n,point%%n))

squares_made <- tail(program$solution, -n^2)
squares_made <- which(head(squares_made, n_squares)==1 | tail(squares_made, -n_squares)==1)

squares_made <- squares %>%
  mutate(s=row_number(), x5=x1, y5=y1) %>%
  gather(dimension, value, -s) %>%
  rowwise() %>% do(data.frame(s=.$s, value=.$value, dimension = paste(strsplit(.$dimension, "")[[1]], collapse="_"), stringsAsFactors=FALSE)) %>%
  ungroup() %>% separate(dimension, c("xy","order")) %>%
  group_by(s, order) %>% spread(xy, value) %>%
  filter(s %in% squares_made)

ggplot() +
  geom_tile(data=solution, aes(x=x,y=y,fill=player)) +
  geom_path(data=squares_made, aes(x=x,y=y,group=s))

538 Riddler: Dice Poker Riddler

01 January ’17

In this week's Riddler, we have another game theory problem. We can describe each player's strategy with a 6 number tuple. For player A, represents the probability that player A raises given a roll of i. For player B, represents the probability that player B calls a raise from player A given a roll of i. Each player's expected winnings can be expressed as follows:

We can start by analyzing the pure strategies. Pure strategies explicitly define how a player will play a game (e.g. do X if opponent does Y). In the above definition, a pure strategy is one where and are binary. For our game, each player has potential pure strategies. Using the above formula, we can calculate player A's winnings for a every pair of pure strategies, then search the resulting 64x64 grid () for Nash equilibria. Because this is a zero-sum game, potential pure Nash equilibria will be "saddle" point(s) satisfying the following conditions:

In other words, they will be column maximums (meaning player A will have no reason to deviate) and row minimums (meaning player B will have no reason to deviate). Interestingly, as is seen in the visual below, there are no pure Nash equilibria! We can see this by looking at a few common strategies. Player A's most common row-maximizing strategy is always raising: (1,1,1,1,1). However, if player B knew player A was using this strategy, they would respond by only calling if they had at least a 2, netting them $0.11 of expected winnings. And if player A knew player B was using this strategy, they would respond by only raising when they had a 4 or higher, netting them $0.17 of expected winnings and triggering yet another change to player B's strategy.

Though there is not a pure strategy Nash equilibrium, there must exist a mixed strategy Nash equilibrium. A mixed strategy is simply a linear combination of pure strategies, the coefficients representing how often that strategy is to be used. Von Neumann's minimax theorem tells us that this equilibrium is at the minimax. We can construct a pair of linear programs to find the first and second player strategies ( and respectively):

Solving these linear programs, we find that player A's optimal strategy is to always raise when they have a 5 or 6 and raise of the time when they have a 1 (i.e. bluff). Very cool! Player B's optimal strategy is to always call when they have a 5 or 6 and call , , and of the time when they have a 2, 3, and 4 respectively. At this equilibrium, player A's expected winnings are $0.093.

Calculations below in R. Also need to credit Laurent Lessard's blog post on this problem; as always, he did an awesome job laying out the underlying math.


# win / lose / split matrix
E <- matrix(0, nrow=6, ncol=6)
E[upper.tri(E)] <- 1
E[lower.tri(E)] <- -1

# a is probability of raise, b is probability of call if raised; both are vectors of length 6
winnings <- function(a, b){
  a_matrix <- matrix(rep(a, times=6), ncol=6, byrow=TRUE)
  b_matrix <- matrix(rep(b, times=6), ncol=6, byrow=FALSE)
  temp <- (1-a_matrix)*E + a_matrix*(2*b_matrix*E + 1*(1-b_matrix))

# make exhaustive pure strategy state space
pure_strat <- t(expand.grid(lapply(1:6, function(x) 0:1)))
n_pure_strat <- ncol(pure_strat)
pure_strat_cross <- expand.grid(A=1:n_pure_strat, B=1:n_pure_strat)
pure_strat_cross$W <- with(pure_strat_cross, mapply(function(a, b) winnings(pure_strat[,a], pure_strat[,b]), A, B))

# find pure nash (if exists)
pure_strat_cross <- pure_strat_cross %>%
  group_by(A) %>% mutate(min_W_per_A = min(W)) %>% ungroup() %>%
  group_by(B) %>% mutate(max_W_per_B = max(W)) %>% ungroup() %>%
  mutate(is_nash_eq = (W == min_W_per_A & W == max_W_per_B))

[1] 0
ggplot() +
  geom_tile(data=pure_strat_cross, aes(x = A, y = B, fill = W)) +
  scale_fill_gradient(low="red", high="green") +
  geom_tile(data=filter(pure_strat_cross, W == max_W_per_B), aes(x = A, y = B), colour="darkgreen", alpha=0, size=0.75) +
  geom_tile(data=filter(pure_strat_cross, W == min_W_per_A), aes(x = A, y = B), colour="darkred", alpha=0, size=0.75) +
  geom_tile(data=filter(pure_strat_cross, is_nash_eq), aes(x = A, y = B), fill="gold")

# most used strategies and opposite player responses
top_A_strategy <- pure_strat_cross %>% filter(W == max_W_per_B) %>%
  group_by(A) %>% summarise(num_B = n_distinct(B)) %>%
  arrange(-num_B) %>% head(1) %>% .$A

     Var1 Var2 Var3 Var4 Var5 Var6
[1,]    1    1    1    1    1    1
t(pure_strat[,pure_strat_cross %>% filter(A == top_A_strategy & W == min_W_per_A) %>% .$B])
     Var1 Var2 Var3 Var4 Var5 Var6
[1,]    0    0    1    1    1    1
[2,]    0    1    1    1    1    1
top_B_strategy <- pure_strat_cross %>% filter(W == min_W_per_A) %>%
  group_by(B) %>% summarise(num_A = n_distinct(A)) %>%
  arrange(-num_A) %>% head(1) %>% .$B

     Var1 Var2 Var3 Var4 Var5 Var6
[1,]    0    1    1    1    1    1
t(pure_strat[,pure_strat_cross %>% filter(B == top_B_strategy & W == max_W_per_B) %>% .$A])
     Var1 Var2 Var3 Var4 Var5 Var6
[1,]    0    0    0    0    1    1
[2,]    0    0    0    1    1    1
# mixed strategy nash equilibrium
P <- matrix(pure_strat_cross %>% arrange(A, B) %>% .$W, byrow=TRUE, ncol=n_pure_strat)

obj <- c(rep(0, n_pure_strat), 1)
A_base <- rbind(
  matrix(c(rep(1, n_pure_strat), 0), nrow=1), # sum of probabilities equals 1
  cbind(diag(n_pure_strat), 0) # probabilities >= 0
A1 <- rbind(A_base, cbind(t(P), -1)) # minimax constraints
A2 <- rbind(A_base, cbind(-P, 1)) # minimax constraints
dir <- c("=", rep(">=", 2*n_pure_strat))
b <- c(1, rep(0, 2*n_pure_strat))

lp_A <- lp(direction="max",, const.mat=A1, const.dir=dir, const.rhs=b)
lp_B <- lp(direction="min",, const.mat=A2, const.dir=dir, const.rhs=b)

# solutions and expected winnings
head(lp_A$solution, -1) %*% t(pure_strat)
          Var1 Var2 Var3 Var4 Var5 Var6
[1,] 0.6666667    0    0    0    1    1
head(lp_B$solution, -1) %*% t(pure_strat)
     Var1 Var2      Var3      Var4 Var5 Var6
[1,]    0  0.5 0.8333333 0.3333333    1    1
[1] 0.09259259

538 Riddler: Rebel vs. Stormtroopers

26 December ’16

In this week's Riddler, we are rebels trying to defeat a group of 9 advancing stormtroopers. Fortunately for us, we are more accurate than the notoriously inaccurate stormtroopers, and the stormtroopers are clumped together, making them easy to pick off.

First, the hit / miss probabilities for the stormtroopers / rebel with N stormtroopers remaining:


The probability that the rebel shoots one of the N remaining stormtroopers before being shot can be expressed as follows:

Putting this together for the entire battle, this is the equation we need to solve:

That denominator is very hairy (and the word "approximately" in the prompt makes me think closed form is a bit of a pipe dream), so I went at this empirically. Easy enough with Excel Goal Seek or Wolfram Alpha. The rebel and stormtroopers are evenly matched when . It gets a lot tougher for the rebel if the stormtroopers aren't clumped together; in that case, for the battle to be evenly matched.