mikefc

8 out of 10 cats does Countdown

“8 out of 10 cats does Countdown” is a UK panel comedy show in which they play games with words and numbers while also telling rude jokes and generally mucking about. It’s an adults-only version of the much more sedate “Countdown” show.

The ‘Countdown’ number puzzle

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

Finding all solutions by recursive backtracking

My solution:

  • Build every possible expression by nesting from right-to-left/inner-to-outer sub-expressions
  • Abandon the expression early if it ever evaluates to a result that is not an integer
  • Takes ~5 seconds to find all solutions to a puzzle from Countdown
  • The code is on github if you felt like having a go.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Inner recursive routine for solving Countdown numbers puzzle
#'
#' @param nums What numbers are left to select from?
#' @param value the current calculated value
#' @param expr the current readable expression
#' @param verbose output solutions as they are found? default: FALSE
#'
#' @return Character vector of solutions if any are found, otherwise NULL
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
solve_inner <- function(nums, value, expr = value, target, verbose = FALSE) {
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Recursion termination conditions:
  #  1 -  Target number has been achieved
  #  2 -  Target number not achieved, and no more numbers to use
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  if (value == target) {
    if (verbose) {
      cat(expr, "\n")
    }
    return(expr)
  } else if (length(nums) == 0L) {
    return()
  }
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # 'all_res' will accumulate all solutions
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  all_res <- c()
  
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Generate all possible arithmetic expressions from the current state
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  for (op in c('+', '-', '*', '/')) {
    for(num_idx in seq_along(nums)) {
      
      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      # Evaluate expression, and if it's still an integer result, then recurse
      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      new_value <- switch(
        op,
        '+' = nums[num_idx] + value,
        '-' = nums[num_idx] - value,
        '*' = nums[num_idx] * value,
        '/' = ifelse(nums[num_idx] %% value == 0L, nums[num_idx] %/% value, NA_integer_)
      )
      
      if (!is.na(new_value)) {
        res <- solve_inner(
          nums    = nums[-num_idx], 
          value   = new_value, 
          expr    = paste("(", nums[num_idx], ' ', op, ' ', expr, ")", sep = ''),
          target  = target,
          verbose = verbose
        )
        if (!is.null(res)) { all_res <- c(all_res, res) }
      }    
      
      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      # For non-commutative operations, also recurse with arguments swapped
      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      if (op %in% c('-', '/')) {
        new_value <- switch(
          op,
          '-' = value - nums[num_idx],
          '/' = ifelse(value && nums[num_idx] == 0L, value %/% nums[num_idx], NA_integer_)
        )
        
        if (!is.na(new_value)) {
          res <- solve_inner(
            nums    = nums[-num_idx], 
            value   = new_value, 
            expr    = paste("(", expr, ' ', op, ' ', nums[num_idx], ")", sep = ''),
            target  = target,
            verbose = verbose
          )
          if (!is.null(res)) { all_res <- c(all_res, res) }
        }    
      }
    } # num_idx loop
  }   # op loop
  
  all_res 
}




#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Solve the countdown numbers puzzle for the given set of numbers and target
#'
#' @param nums integer vector
#' @param target target number (integer)
#' @param verbose output solutions as they are found? default: FALSE
#'
#' @return Character vector of solutions if any are found, otherwise NULL
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
solve_countdown <- function(nums, target, verbose = FALSE) {
  nums   <- as.integer(nums)
  target <- as.integer(target)
  seq_along(nums) %>% 
    purrr::map(~solve_inner(nums[-.x], value = nums[.x], target = target, verbose = verbose)) %>%
    purrr::flatten_chr() %>%
    unique()
}

A small example

nums   <- c(2, 3, 4, 5)
target <- 11 
solve_countdown(nums, target)
##  [1] "(5 + (4 + 2))"       "(4 + (5 + 2))"       "(5 + (3 * (4 - 2)))"
##  [4] "(5 - (3 * (2 - 4)))" "(5 + (3 * 2))"       "(3 + (4 * 2))"      
##  [7] "((4 + (5 * 2)) - 3)" "(4 - (3 - (5 * 2)))" "(4 + ((5 * 2) - 3))"
## [10] "(5 + (3 * (4 / 2)))" "(5 + (2 * 3))"       "((5 * 3) - 4)"      
## [13] "(5 + (2 + 4))"       "(2 + (5 + 4))"       "(3 + (2 * 4))"      
## [16] "(4 + (2 + 5))"       "(2 + (4 + 5))"       "((4 + (2 * 5)) - 3)"
## [19] "(4 - (3 - (2 * 5)))" "(4 + ((2 * 5) - 3))" "((3 * 5) - 4)"

An example from the show

This is the example from the show at the top of this post. The second solution in the results matches the answer given on the show.

Finding all solutions takes about 5 seconds on my machine.

nums   <- c(50, 9, 4, 5, 9, 3)
target <- 952 
solve_countdown(nums, target)
##  [1] "((5 * ((4 * 50) - 9)) - 3)"       "(4 * (((5 * 50) - 9) - 3))"      
##  [3] "(((4 * ((5 * 50) - 9)) - 9) - 3)" "(((4 * ((5 * 50) - 9)) - 3) - 9)"
##  [5] "(4 * (((5 * 50) - 3) - 9))"       "(4 * ((3 * (9 * 9)) - 5))"       
##  [7] "(4 * ((9 * (5 + (3 * 9))) - 50))" "(4 * ((9 * (3 * 9)) - 5))"       
##  [9] "((5 * ((50 * 4) - 9)) - 3)"       "(4 * (((50 * 5) - 9) - 3))"      
## [11] "(((4 * ((50 * 5) - 9)) - 9) - 3)" "(((4 * ((50 * 5) - 9)) - 3) - 9)"
## [13] "(4 * (((50 * 5) - 3) - 9))"       "(4 * ((9 * (5 + (9 * 3))) - 50))"
## [15] "(4 * ((9 * (9 * 3)) - 5))"

An impossible puzzle

Sometimes the target number is impossible to achieve

solve_countdown(c(50, 2, 6, 5, 1, 5), 959)
## character(0)

Future

  • Could easily adapt to find:
    • closest result to given target if no exact result exists
    • results within some threshold distance of the target
    • include fractional intermediate results
    • non-integer targets and given numbers
  • Code is on github
  • Ideas for speeding this up are welcomed.
  • Alternate solution techniques are extremely welcomed! e.g.
    • Is this type of program solvable via ompr?
    • Could you just generate all possible expressions as strings in one go, and then evaluate them all?