Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Solving the numbers puzzle in "8 out of 10 cats does Countdown"
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' 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()
}
nums <- c(50, 9, 4, 5, 9, 3)
target <- 952
solve_countdown(nums, target)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.