# 8 out of 10 cats does countdown - part 2

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

## 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
##   6.800   0.401   7.218
system.time({
target <- 404
nums   <- c(1, 1, 1, 1, 1, 100)
res    <- solve_countdown(nums, target)
})
##    user  system elapsed
##   1.204   0.120   1.346
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.

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