24.R

## Brute forcing the 24 puzzle (https://en.wikipedia.org/wiki/24_(puzzle)) and friends

## We create all permutations of maths signs and numbers (e.g. 1 + 1 + 1 + 1, 2 + 1 + 1 + 1, ..., 1 - 1 + 1 + 1, ...)
operators <- c("+", "-", "*", "/")
digits <- as.character(1:9) ## numbers to be used in the game
d_0 <- expand.grid(digit1 = digits, operator1 = operators,
                   digit2 = digits, operator2 = operators, 
                   digit3 = digits, operator3 = operators,
                   digit4 = digits, stringsAsFactors = FALSE)

## We consider that people can combine numbers and operators in different orders,
## which is the same as using parentheses and we turn the outcome as strings of text (e.g. "( 6 / 2 ) * 1 + 1" )
d_a <- apply(d_0, 1, \(x) paste(x, collapse = " "))
d_b <- apply(d_0, 1, \(x) paste("(", x[1], x[2], x[3], ")", x[4], x[5], x[6], x[7], collapse = " "))
d_c <- apply(d_0, 1, \(x) paste("(", x[1], x[2], x[3], x[4], x[5],")",  x[6], x[7], collapse = " "))
d_d <- apply(d_0, 1, \(x) paste("((", x[1], x[2], x[3], ")", x[4], x[5],")",  x[6], x[7], collapse = " "))
d_e <- apply(d_0, 1, \(x) paste("(", x[1], x[2], x[3], ")", x[4], "(", x[5], x[6], x[7], ")", collapse = " "))
d <- d_0[rep(seq_len(nrow(d_0)), 5), ]
d <- cbind(d, data.frame(expr = c(d_a, d_b, d_c, d_d, d_e)))

## We compute the operations (slowish)
d$result <- sapply(d$expr, \(x) eval(parse(text = x)))

## We identify the unique sets of numbers by sorting them (e.g. 1211 is the same as 1112 in this game) (slower)
d$number <- unlist(apply(d[, c("digit1", "digit2", "digit3", "digit4")], 1, \(x) paste(sort(x), collapse = ""), 
                         simplify = FALSE))
possible_numbers <- length(unique(d$number))

## We compute for each target between 0 and 100 (e.g. 24) what is the number of
## unique sets of numbers that can be solved
possible_targets <- 0:100
solvable <- sapply(possible_targets, \(target) {
  sum(tapply(d$result, d$number, \(x) any(abs(x - target) < .Machine$double.eps^0.5, na.rm = TRUE)))
})

## We plot the outcome using ggplot2
library(ggplot2)
ggplot(data.frame(target = possible_targets, cases = solvable), aes(y = cases, x = target)) +
  geom_point() + geom_line() +
  geom_vline(xintercept = 24, linetype = "dashed") +
  labs(x = "target value", y = "# solvable cases",
       title = "24 and friends game (brute-force) analysis",
       subtitle = "by RDataBerlin (2023/03/03)") +
  scale_y_continuous(breaks = c(seq(0, possible_numbers, by = 25), possible_numbers), minor_breaks = NULL,
                     limits = c(0, possible_numbers)) +
  scale_x_continuous(breaks = c(seq(0, 100, by = 6), 100), minor_breaks = NULL, limits = c(-1, 101)) +
  coord_cartesian(expand = FALSE) + theme_minimal() +
  theme(plot.subtitle = element_text(hjust = 0.5), plot.title = element_text(hjust = 0.5, face = "bold"))

## Finding (non-unique) solutions to a particular problem
solve24 <- function(digits = c(1, 1, 1, 1), target = 24, data = d) {
  if (length(digits) != 4) stop("You need to input 4 digits")
  if (any(digits < 1) & any(digits > 9) & any(digits %% 1 != 0)) stop("Each digit can only be 1, 2, 3, ..., or 9")
  digits_str <- paste0(sort(digits), collapse = "")
  res <- d[d$number == digits_str & abs(d$result - target) < .Machine$double.eps^0.5, "expr"]
  res <- res[!is.na(res)]
  ifelse(length(res) > 0, res, "no solution for these numbers")
}

solve24(c(1, 1, 1, 1))
solve24(c(5, 1, 2, 4))