mikefc

An error in the previous solution

Claus Ekstrom pointed out to me that my previous solution won’t actually find all possible solutions to the Countdown numbers puzzle. i.e.

This post includes a totally re-written solution which correctly finds all solutions.

In doing the re-write, this proper solution can be even faster than the old one!

Timing:

  • Runtime for 6 input numbers is about 10 seconds (if limited to only finding integer solutions)
  • If you’d like all ~8 million results of all possible expressions involving the 6 numbers (including floating point and NaNs), the runtime is about 50 seconds.

Alternate solutions

Puzzle Recap: 8 out of 10 cats does Countdown

The number puzzle segment of the show goes something like this:

  1. 6 numbers are selected randomly
  2. A target number is displayed.
  3. Panellists must use basic arithmetic to produce the target number from some/all of the 6 given numbers

Below on the left is the setup for a typical puzzle, and on the right are some attempts by panellists at a solution, with a correct solution shown on the RHS of the whiteboard

For this example problem the given numbers and target are:

  • Given numbers: 50, 9, 4, 5, 9, 3
  • Target: 952

The solution on the RHS of the whiteboard is:

((50 * 5) - 9 - 3) * 4
## [1] 952

Assumptions that are never really stated, but all puzzles seem to adhere by:

  • only using +, -, *, /
  • Intermediate results are always integers
  • Not necessary to use all the given numbers

Solution #2

  • Generate all possible expression trees
  • Build up expressions from the leaves, doing simple evaluations at each node
  • i.e. Never try and evaluate the full expression from scratch - always evaluate it as a simple operation of the values returned in the subtrees.
  • Uses memoisation to cache the results of subtrees so that similar subtrees are only ever evaluated once.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Generate and evaluate all possible expressions from the given numbers
#
# @param nums vector of integers
# @param integer_only only generate integer solutions?  default: TRUE
# 
# @return list with 2 elements. 'exprs' which is the character vector of all
#         possible expressions.  'values' which is the numeric vector of the
#         evaluation of each of those expressions
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
generate_exprs_ <- function(nums, integer_only = TRUE) {
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Recursive function termination condition - only 1 number given
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  if (length(nums) == 1L) {
    return(list(exprs = as.character(nums), values = nums))
  } 
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # For the given length of 'nums', what are all the possible ways
  # we could split these numbers into 2 groups?
  # See appendix for definition
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  splits <- all_splits[[length(nums)]]
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # This is where I'll be storing the solutions
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  exprs  <- character(0)
  values <- numeric(0)
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Evaluate every possible combination of numbers for every possible 
  # arithmetic op.  For non-commutative operations, need to evaluate a second
  # time with arguments in reverse order
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  for (split in splits) {
    
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # Generate all the possible subtrees from this node
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    lhs <- generate_exprs(nums[split[[1]]], integer_only) # use memoised version
    rhs <- generate_exprs(nums[split[[2]]], integer_only) # use memoised version
    
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # Build the expression string for each possible combination of 
    # left and right expression subtrees
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    L <- rep(lhs$exprs, times = length(rhs$exprs))
    R <- rep(rhs$exprs, each  = length(lhs$exprs))
    exprs <- c(
      exprs,
      paste0("(", L, " - ", R, ")"),
      paste0("(", L, " / ", R, ")"),
      paste0("(", L, " + ", R, ")"),
      paste0("(", L, " * ", R, ")"),
      paste0("(", R, " - ", L, ")"),
      paste0("(", R, " / ", L, ")")
    )
    
    
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # Perform each possible operation on each possible combination of 
    # left and right value subtrees
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    L <- rep(lhs$values, times = length(rhs$values))
    R <- rep(rhs$values, each  = length(lhs$values))
    values<- c(
      values,
      L - R,
      L / R,
      L + R,
      L * R,
      R - L,
      R / L
    )
  }
  
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Filter solutions to only keep unique solutions.
  # Filter out non-integer solutions if requested.
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  if (integer_only) {
    accept <- !duplicated(exprs) & is.finite(values) & values == round(values)
  } else {
    accept <- !duplicated(exprs)
  }
  
  list(exprs=exprs[accept], values=values[accept])
} 



#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Memoise the generation of expressions for any list of numbers
# This eliminates having to ever calculate the expressions for the same list
# of numbers a second time.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
generate_exprs <- memoise::memoise(generate_exprs_)



#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Recursively generate all possible expressions for a set of numbers.
#
# For a given list of numbers, generate all expressions for these numbers
# and all possible sub-sets of these numbers. this way if nums = c(1, 3, 4)
# and target = 12, the solutions will include (1 * 3 * 4) as well as (3 * 4)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
generate_all_exprs <- function(nums, integer_only = TRUE) {
  
  exprs  <- character(0)
  values <- numeric(0)
  
  if (length(nums) == 1L)  {
    return(list(exprs = as.character(nums), values = nums))
  }
  
  nums <- sort(nums)
  
  # Solve the sub-problems
  for (i in seq_along(nums)) {
    this_res <- generate_all_exprs(nums[-i], integer_only)
    exprs    <- c(exprs , this_res$exprs )
    values   <- c(values, this_res$values)
  }
  
  # Solve this problem
  this_res <- generate_exprs(nums, integer_only)
  exprs    <- c(exprs , this_res$exprs )
  values   <- c(values, this_res$values)
  
  
  accept <- !duplicated(exprs)
  
  list(exprs = exprs[accept], values = values[accept])
}



#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Solve the countown problem
#
# Generate all possible expressions with an integer result and then filter
# only for those which evaluate to the target number
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
solve_countdown <- function(nums, target) {
  res <- generate_all_exprs(sort(nums), integer_only = TRUE)
  res$exprs[res$values == target]
}
generate_all_exprs(1:2)
## $exprs
## [1] "2"       "1"       "(1 - 2)" "(1 + 2)" "(1 * 2)" "(2 - 1)" "(2 / 1)"
## 
## $values
## [1]  2  1 -1  3  2  1  2
generate_all_exprs(1:2, integer_only = FALSE)
## $exprs
## [1] "2"       "1"       "(1 - 2)" "(1 / 2)" "(1 + 2)" "(1 * 2)" "(2 - 1)"
## [8] "(2 / 1)"
## 
## $values
## [1]  2.0  1.0 -1.0  0.5  3.0  2.0  1.0  2.0
system.time({
  nums   <- c(50, 9, 4, 5, 9, 3)
  target <- 952
  res    <- solve_countdown(nums, target)
})
##    user  system elapsed 
##   5.878   0.313   6.192
system.time({
  target <- 404
  nums   <- c(1, 1, 1, 1, 1, 100)
  res    <- solve_countdown(nums, target)
})
##    user  system elapsed 
##   0.942   0.076   1.018
res
## [1] "((1 + 1) * ((1 + 1) * (1 + 100)))" "((1 + 1) * ((1 + 100) * (1 + 1)))"
## [3] "((1 + 100) * (1 + (1 + (1 + 1))))" "((1 + 100) * ((1 + 1) + (1 + 1)))"
## [5] "((1 + 100) * ((1 + 1) * (1 + 1)))"

Summary

  • Can generate all possible simple arithmetic expressions for 6 numbers in around ~10 seconds (if we limit the results such that must be an integer).
  • If we allow all floating point and NA/Inf expressions, then full generation of all arithmetic expressions for 6 numbers takes about < 1 minute.

Appendix

all_splits

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Split 'n' indices into all possible 2 group combinations 
# with 'ngroup' numbers in the first group
#
# @param n maximum index. 
# @param ngroup number of indices in the first group
# @return list of lists. each innermost list has 2 vectors of disjoint indicies
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
split_sets <- function(n, by) {
  mat <- combn(seq(n), by)
  if (by == n/2) {
    mat <- mat[, seq(ncol(mat)/2), drop = FALSE]
  }
  
  res <- apply(mat, 2, list)
  res <- lapply(res, function(x) {list(x[[1]], setdiff(seq(n), x[[1]]))})
  res
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Generate all possible split sets for the given n
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
all_split_sets <- function(n) {
  nn <- n - 1
  nn <- min(floor(n/2), n-1)
  seq(nn) %>% 
    purrr::map(~split_sets(n, by = .x)) %>%
    unlist(recursive = FALSE)
}


all_splits <- 1:6 %>% purrr::map(all_split_sets)