14.3 Solve 24

Let’s first review the helper functions we created.

# single step operation
cal <- function(x, y, op){ 
  switch(op, x + y, x - y, x * y, x / y, y - x, y / x)
}
# multi-step operations
num_op <- function(num, op, n_nums = length(num)){
sol <- num
for(step in 1:(n_nums-1))
  sol[step + 1] <- cal(sol[step], num[step+1], op[step])
return(sol)
}
# multi-step operations, the "pair" shape (n1 op n2) op (n3 op n4), only for 4 numbers
num_op_pair <- function(num, op){
  left <- cal(num[1], num[2], op[1])
  right <- cal(num[3], num[4], op[2])
  final <- cal(left, right, op[3])
  c(left, right, final)
}
# print a single step
print_op <- function(x, y, z, op){
  switch(op, paste(x, "+", y, "=", z)
           , paste(x, "-", y, "=", z)
           , paste(x, "*", y, "=", z)
           , paste(x, "/", y, "=", z)
           , paste(y, "-", x, "=", z)
           , paste(y, "/", x, "=", z)
         )
}
# print multi-steps (the solution)
print_sol <- function(nums, sol, op){
  sol <- round(sol, 3)        #Only keep 3 digits to make it better looking.
  n_nums <- length(sol)
  for(step in 1:(n_nums-1)){
  cat(print_op(sol[step], nums[step+1], sol[step + 1], op[step]), "\n")
  }
}
# print multi-steps for the "pair" shape (n1 op n2) op (n3 op n4)
print_sol_pair <- function(nums, sol, op){
  sol <- round(sol, 3)
  cat(print_op(nums[1], nums[2], sol[1], op[1]), "\n")
  cat(print_op(nums[3], nums[4], sol[2], op[2]), "\n")
  cat(print_op(sol[1], sol[2], sol[3], op[3]), "\n")
}

Before assembling the final function, let’s check whether the num_op() search from Section 14.2 can reach every way of combining four numbers. In num_op(), each step combines the running result with the next number, so the four numbers always get combined in the shape ((n1 op n2) op n3) op n4. But there is another natural way to parenthesize four numbers: combine the first two, combine the last two, and then combine those two results, i.e. (n1 op n2) op (n3 op n4). Consider the input 5, 5, 5, 5. It turns out that \((5 \times 5) - (5 / 5) = 24\), but num_op() can never produce this solution, no matter which permutation or operator sequence we try, because it needs two independent two-number results before they are combined. To make sure our solver does not miss solutions like this one, we add a second helper function, num_op_pair(), that computes this alternative “pair” shape, together with a matching print function, print_sol_pair(). Both simply reuse cal() and print_op(), the same building blocks we already have.

With all the preparations, we are ready to present the final function to solve 24. In the solve_24() function, the first argument nums contains the numbers, goal is the target value with default 24, and n_sols_max represents the maximum number of solutions to search for, with a default value of 3. When there are exactly four input numbers, the function checks both the chain shape (via num_op()) and the pair shape (via num_op_pair()) for every permutation and operator sequence, since together these two shapes cover every possible way of parenthesizing four numbers.

solve_24 <- function(nums, goal = 24, n_sols_max = 3){
require(gtools)
n_nums <- length(nums)

nums_perm <- unique(permutations(n_nums, n_nums, nums, set = FALSE))  #generate all number permutations 

n_ops <- 6
op_mat <- permutations(n_ops, n_nums-1, repeats.allowed = TRUE) #generate all operator sequences
op_mat <- op_mat[op_mat[,1]<=4, ] #remove redundant ones
n_sols <- 0  #initialize the number of solutions to be 0
for(i in 1:nrow(nums_perm))  
for(j in 1:nrow(op_mat)){ #loop over all possible operator sequences
  num_cur <- nums_perm[i, ] #get the current permutation
  op_cur <- op_mat[j, ] #get the current operator sequence
  sol <- num_op(num_cur, op_cur) #get the steps for the chain shape
  if(isTRUE(abs(sol[n_nums] - goal) < 1e-5 & all(sol >= 0))){ #check if it is a solution
    n_sols <- n_sols + 1 #increase the solution counter
    cat("Solution #", n_sols, "\n")
    print_sol(num_cur, sol, op_cur) #print the solution
  }
  if(n_sols >= n_sols_max){
    return(invisible(NULL))
  }
  if(n_nums == 4){ #also check the (n1 op n2) op (n3 op n4) pair shape
    sol_pair <- num_op_pair(num_cur, op_cur)
    #isTRUE() guards against NA/NaN, which can arise here (e.g. 0/0)
    #since left and right are independently computed, unlike the chain shape
    if(isTRUE(abs(sol_pair[3] - goal) < 1e-5 & all(sol_pair >= 0))){ #check if it is a solution
      n_sols <- n_sols + 1 #increase the solution counter
      cat("Solution #", n_sols, "\n")
      print_sol_pair(num_cur, sol_pair, op_cur) #print the solution
    }
    if(n_sols >= n_sols_max){
      return(invisible(NULL))
    }
  }
  }
if(n_sols == 0){ #fail to find a solution
  cat("Solution not exist!")
}

}

Now, we are reading to look at some examples.

solve_24(1:4)
#> Solution # 1 
#> 1 + 2 = 3 
#> 3 + 3 = 6 
#> 6 * 4 = 24 
#> Solution # 2 
#> 1 * 2 = 2 
#> 2 * 3 = 6 
#> 6 * 4 = 24 
#> Solution # 3 
#> 1 * 2 = 2 
#> 3 * 4 = 12 
#> 2 * 12 = 24
solve_24(c(1, 5, 5, 5))
#> Solution # 1 
#> 1 / 5 = 0.2 
#> 5 - 0.2 = 4.8 
#> 4.8 * 5 = 24
solve_24(c(3, 7, 3, 7))
#> Solution # 1 
#> 3 / 7 = 0.429 
#> 0.429 + 3 = 3.429 
#> 3.429 * 7 = 24
solve_24(c(3, 8, 3, 8))
#> Solution # 1 
#> 8 / 3 = 2.667 
#> 3 - 2.667 = 0.333 
#> 8 / 0.333 = 24
solve_24(c(2, 5, 5, 5))
#> Solution not exist!
solve_24(c(5, 5, 5, 5))
#> Solution # 1 
#> 5 * 5 = 25 
#> 5 / 5 = 1 
#> 25 - 1 = 24 
#> Solution # 2 
#> 5 * 5 = 25 
#> 5 / 5 = 1 
#> 25 - 1 = 24 
#> Solution # 3 
#> 5 / 5 = 1 
#> 5 * 5 = 25 
#> 25 - 1 = 24

The last example, c(5, 5, 5, 5), is exactly the case that motivated adding the pair shape earlier: solve_24() now correctly finds \((5 \times 5) - (5 / 5) = 24\), a solution that the chain shape alone could never reach.

Note that the function is more powerful than merely solving 24. It contains two extensions.

  1. The target value can be any number, for example, 25, or 100.
  2. The input can contain more or less than 4 numbers. Keep in mind that the pair shape only applies when there are exactly 4 numbers; for other input lengths, solve_24() searches the chain shape only.

Let’s look at two interesting examples.

solve_24(c(12, 13, 23, 25, 25), n_sols_max = 1)
#> Solution # 1 
#> 12 + 13 = 25 
#> 25 * 23 = 575 
#> 575 + 25 = 600 
#> 600 / 25 = 24
solve_24(11:16, 100, n_sols_max = 1)
#> Solution # 1 
#> 11 * 12 = 132 
#> 132 + 13 = 145 
#> 145 - 14 = 131 
#> 131 - 15 = 116 
#> 116 - 16 = 100

There are other possible extensions of the function we wrote. For example, you can add additional possible operators (e.g. the exponentiation ^, the factorial !) by changing the cal() and print_op as well as some constants in the solve_24() function.

Buy Me A Coffee