# DonaldRauscher.com

## A Blog About D4T4 & M47H

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:  suppressMessages(library(dplyr))
suppressMessages(library(tidyr))
suppressMessages(library(ggplot2))
suppressMessages(library(lpSolve))

# 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):n, y2=p1:n)
p3 <- data.frame(x3=p2$x2+p2$y2-p1, y3=p2$y2-p2$x2+p1)
p4 <- data.frame(x4=p1+p2$y2-p1, y4=p1-p2$x2+p1)
squares_temp <- cbind(data.frame(x1=p1, y1=p1),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)
n_squares

105
# 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", objective.in=c, const.mat=A, const.dir=dir, const.rhs=b, all.bin=TRUE)
program

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)
rowwise() %>% do(data.frame(s=.$s, value=.$value, dimension = paste(strsplit(.\$dimension, "")[], collapse="_"), stringsAsFactors=FALSE)) %>%