Countdown to 2018

Here’s a fun puzzle for the new year from Alex Bellos:

Fill in the blanks so that this equation makes arithmetical sense: $$10\ 9\ 8\ 7\ 6\ 5\ 4\ 3\ 2\ 1 = 2018$$ You are allowed to use only the four basic arithmetical operations: $+$, $-$, $\times$, $\div$. But brackets can be used wherever needed.

So how do we approach this problem? The instructions tell us that we can use brackets whenever we need, so we are not merely choosing which operator goes between each pair of number.

Well, first we can estimate just how hard this problem is. How many potential expressions are there with 9 operators and arbitrary bracketing? There are four choices of operators for each of the nine blanks, so that’s $4^9=262\,144$. The possible bracketings of $n$ factors is the Catalan number $C_{n-1}$, which in our case is $C_9=4\,862$. Thus the total number expressions is $262\,144\times4\,862=1\,274\,544\,128$.1 This seems low enough that brute force is a reasonable approach, so let’s try that.

To brute force the solution, we will need to enumerate all the possible operators and bracketings. The operators seem simple enough, but how exactly do we enumerate the bracketings? The simplest way is to use reverse Polish notation.

Reverse Polish Notation

Reverse Polish notation (RPN) is an alternative mathematical notation where the operator follows its operands. Thus $2+1$ would be written $2\ 1\ +$, and $3 \times 2 + 1$ would be written $3\ 2\ \times\ 1\ +$. More precisely, the operator always follows its last operand. It’s kind of like a reverse LISP where the operator is at the end instead of the beginning: ((3 2 *) 1 +).

Most interesting for our purposes is how RPN handles bracketing: it doesn’t need them. Instead, the ordering of the operators and operands makes the order of operations explicit. For instance, $(3+2)\times 1$ is $3\ 2\ +\ 1\ \times$ while $3+(2\times 1)$ is $3\ 2\ 1\ \times\ +$.

So enumerating all of the possible expressions in RPN seems promising. But first, we’ll need a way to evaluate RPN expressions:

data Operator
  = Add
  | Sub
  | Mult
  | Div
  deriving (Show, Eq)

data Token
  = Number Rational
  | Op Operator
  deriving (Show, Eq)

type RpnTokens = [Token]

type Stack a = [a]

eval :: RpnTokens -> Maybe Rational
eval = fmap head . foldM f []
    f stack (Number n) = Just $ (n : stack)
    f (b:a:stack) (Op op) =
      case op of
        Add -> Just $ (a + b) : stack
        Sub -> Just $ (a - b) : stack
        Mult -> Just $ (a * b) : stack
        Div ->
          if b == 0
            then Nothing
            else Just $ (a / b) : stack

The evaluator is just a straightforward left fold that operates on a list of tokens, each of which is either a number or an operator. We use the Rational type here to get exact precision and avoid floating point rounding errors in exchange for giving up some computation speed.

Using the Maybe type here lets us return Nothing if we try to divide by zero. It also stops the calculation from proceeding further so we don’t need to worry about how Nothing interacts with the other operations.

Enumerating Everything

Before we can start enumerating all the possibilities, we need to think about what are and are not valid expressions that we can enumerate.

To satisfy the rules of the puzzle, the order of the digits must stay fixed. In RPN, this means that regardless of the placement of the operators, the numbers are always shown in the same order.

Next, we can observe that something like $3\ +\ 2\ 1\ -$ is not a valid expression because the $+$ needs two operands, but there is only one on its left. We also want to disallow things like $3\ 2\ +\ 1$, since this produces two operands with no final operator to combine them. The rule here is that for any initial sequence of tokens, the count of numbers must exceed the count of operators. Otherwise we would have an operator that is missing an operand.

Finally, there are ten digits and nine operators, so we have 19 tokens total.

Those are the only three rules we need! To do the enumeration, we take advantage of the list type as an applicative functor representing “nondeterministic” computation.2 When we apply a list to another list, we get a new list with the each of the elements of the first list applied to each of the elements of the second list.

(:) <$> [8,9] <*> [[1,1,1], [2,2,2], [3,3,3]]
-- Result: [[8,1,1,1],[8,2,2,2],[8,3,3,3],[9,1,1,1],[9,2,2,2],[9,3,3,3]]

This is very convenient because it lets us build the expressions token by token like so:

generate :: [Int] -> [RpnTokens]
generate numbers = f numbers 0 0
    totalLength = 2 * (length numbers) - 1
    operators = [Op Add, Op Sub, Op Mult, Op Div]
    f ns numNumbers numOps
      | numNumbers + numOps == totalLength = [[]]
      | numNumbers > numOps + 1 =
        if null ns
          then opNext
          else numberNext ++ opNext
      | otherwise = numberNext
        n' = Number . fromIntegral . head $ ns
        numberNext = (:) <$> [n'] <*> f (tail ns) (numNumbers + 1) numOps
        opNext = (:) <$> operators <*> f ns numNumbers (numOps + 1)

Our generate function takes any list of numbers and produces a list of all the possible RPN expressions that satisfy our three rules. We use numNumbers and numOps to keep track of how many numbers and operators we have already used so that we always have more numbers than operators. If we run out of numbers to use, then we fill the rest of the expression with only operators.

Note that the otherwise case occurs when numNumbers == numOps + 1 and numNumbers + numOps < totalLength, which implies that numNumbers is less than length numbers, so can always use numberNext. In other words we’re never out of numbers in this case.

The numberNext part is where we use the fact that list is an applicative functor. We just tack the current number onto the output and then recurse. The recursive call is going to return a list of potential suffixes, to each one of which we will prepend n' and then return ourselves. The opNext part works in a very similar way.

Before proceeding, we should sanity check this algorithm. Is it enumerating exactly the number of expressions that we expect? Let’s try some examples:

length . generate $ [4,3,2,1]
-- 320 = 4^3 * C_3 = 64 * 5

length . generate $ [5,4,3,2,1]
-- 3584 = 4^4 * C_4 = 256 * 14

length . generate $ [6,5,4,3,2,1]
-- 43008 = 4^5 * C_5 = 1024 * 42

Looks good!

Solving the Problem

Now that we have all the pieces in place, actually getting a solution (or all the solutions) is pretty simple. In fact, it’s actually easier to start with finding all the solutions and then to use Haskell’s laziness to only compute the first one.

main = do
  let solutions =
        filter ((== Just 2018) . eval) . generate . reverse $ [1 .. 10]
  putStrLn . display . head $ solutions

display :: RpnTokens -> String
display = head . foldl' go [""]
    go stack (Number n) = (show . (round :: Rational -> Int) $ n) : stack
    go (b:a:stack) (Op op) =
      case op of
        Add -> ("(" ++ a ++ "+" ++ b ++ ")") : stack
        Sub -> ("(" ++ a ++ "-" ++ b ++ ")") : stack
        Mult -> ("(" ++ a ++ "*" ++ b ++ ")") : stack
        Div -> ("(" ++ a ++ "/" ++ b ++ ")") : stack

As a bonus, we include a little function that converts the list of RPN tokens into infix notation for readability.

And if we run this, we get an answer. Happy (10-(9-((8*(7*(6*(5-(4-(3+2))))))+1)))!

You can find the full code for this solution here. For a different take on this puzzle, Peter Norvig’s approach is here.

  1. Actually this overcounts the number of “unique” expressions depending on how we define uniqueness. For instance, $(1+2)+3=1+(2+3)$ would be counted twice using this approach even though the associativity of addition makes them equal. For our purposes, the upper bound we calculated is good enough for brute force, so we don’t need to worry about it.
  2. Perhaps enumerative computation would be a better term, but nondeterministic is the standard terminology in Haskell (see Typeclassopedia).
January 1, 2018