Solving the numbers puzzle in "8 out of 10 cats does Countdown"

8-out-of-10-cats.R

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

Revision Suggestion - dependendcy package management at the start:

#!/usr/bin/env Rscript

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# R Package Dependency Management - Check and install as required
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
pkg_deps <- c("dplyr")

for (pkgitem in pkg_deps) {
  if (! is.element(pkgitem, installed.packages()[,1])) {
    install.packages(pkgitem)
  }
}

library(dplyr)

Revision Suggestion - handling number csv and target as passed parameters on the command line:

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Main Program execution 
#
# Can pass CSV nums list and target on the command line
#
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
args = commandArgs(trailingOnly=TRUE)


if (length(args) == 0) {
  # Starter values - can be changed by command line args
  nums   <- c(50, 9, 4, 5, 9, 3)
  target <- 952 

  solve_countdown(nums, target)

} else if (length(args) == 2) {
  nums   <- c()
  target <- 0

  # Go through the args; a csv string -> nums(), value -> target
  for (i in 1:length(args)) {
    if (grepl(",", args[i])) {
      for (stritem in strsplit(args[i], ",")) {
        nums <- c(strtoi(stritem))
      }
    }
    else {
      target <- as.numeric(args[i])
    }
  }

  # Check for arg sanity
  if (target <= 0) {
    stop("Invalid Argument value for 'target'")
  }
  else if (length(nums) < 2) {
    stop("Invalid Argument values for 'nums'")
  }

  solve_countdown(nums, target)

} else {
  stop("Invalid Argument count - zero or two")
}