Instantly share code, notes, and snippets.

# coolbutuseless/8-out-of-10-cats.R Created Feb 2, 2019

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)