Digits Dilemma

 Posted on June 15, 2024  |  9 minutes  |  1860 words  |  Jonathan Carroll  |  Link to source

Another day, another short riddle to be solved with several programming languages! This one is nice because solving it doesn’t need a lot of code, but it uses some interesting aspects of evaluation.

I saw this post which isn’t new (it’s from 2022) that poses a nice problem to solve:

With the numbers 123456789, make them add up to 100. They must stay in the same order but you can use addition, subtraction, multiplication, division, brackets etc. All numbers must be used exactly once.

and demonstrates a solution in Haskell

import Control.Monad (forM)
import Language.Haskell.Interpreter

expressions :: [String]
expressions =
  let ops = [ '+', '-', '/', '*' ]
   in [ [ '1', a, '2', b, '3', c, '4', d, '5', e, '6', f, '7', g, '8', h, '9' ]
        | a <- ops, b <- ops
        , c <- ops, d <- ops
        , e <- ops, f <- ops
        , g <- ops, h <- ops
        ]

result = runInterpreter $ do
  setImports ["Prelude"]
  exprs <- forM expressions evaluate
  pure $ filter (\(_, a) -> a == "100") $ fromRight [] exprs
  where

I’m trying to learn Haskell this year, so it was a great opportunity try to follow along. I’m still working my way towards being able to run short snippets - the ghci tool for interactive use has a bit of a learning curve and doesn’t immediately let me use the imports (or I’m doing something wrong) so while I think I can follow the steps as presented, I can’t yet dig into them as interactively as I’d like.

The general idea, though, is to use a comprehension to expand all combinations of the allowed operators (+, -, /, and *) between the values 1 to 9. I’m somewhat familiar with comprehensions and played with them in my post
Pythagorean Triples with Comprehensions in several languages, including Haskell.

I wanted to see how I might go about this problem in R, and I knew I’d need to make some adjustments because R does not have comprehensions.

One way to get all the combinations of operators between the values is to use expand.grid() which generates all combinations of its inputs

expand.grid(1:3, letters[1:3])
##   Var1 Var2
## 1    1    a
## 2    2    a
## 3    3    a
## 4    1    b
## 5    2    b
## 6    3    b
## 7    1    c
## 8    2    c
## 9    3    c

Defining the operators as strings, I can generate a data.frame of the values and all combinations of operators between them

ops <- c("*", "+", "-", "/")
combos <- expand.grid(1, ops, 2, ops, 3, ops, 4, ops, 5, ops, 6, ops, 7, ops, 8, ops, 9)
head(combos)
##   Var1 Var2 Var3 Var4 Var5 Var6 Var7 Var8 Var9 Var10 Var11 Var12 Var13 Var14
## 1    1    *    2    *    3    *    4    *    5     *     6     *     7     *
## 2    1    +    2    *    3    *    4    *    5     *     6     *     7     *
## 3    1    -    2    *    3    *    4    *    5     *     6     *     7     *
## 4    1    /    2    *    3    *    4    *    5     *     6     *     7     *
## 5    1    *    2    +    3    *    4    *    5     *     6     *     7     *
## 6    1    +    2    +    3    *    4    *    5     *     6     *     7     *
##   Var15 Var16 Var17
## 1     8     *     9
## 2     8     *     9
## 3     8     *     9
## 4     8     *     9
## 5     8     *     9
## 6     8     *     9

This generates a lot of combinations - with 4 possible operators in 8 possible positions there are \(4^8\) = 65,536 combinations.

Pasting these numbers and operators together into expressions

exprs <- apply(combos, 1, \(x) paste0(x, collapse = ""))
head(exprs)
## [1] "1*2*3*4*5*6*7*8*9" "1+2*3*4*5*6*7*8*9" "1-2*3*4*5*6*7*8*9"
## [4] "1/2*3*4*5*6*7*8*9" "1*2+3*4*5*6*7*8*9" "1+2+3*4*5*6*7*8*9"

I get something I can evaluate as if I typed 1*2*3 into a console. I can get the results of evaluating those with

results <- sapply(exprs, \(x) eval(parse(text = x)))
head(results)
## 1*2*3*4*5*6*7*8*9 1+2*3*4*5*6*7*8*9 1-2*3*4*5*6*7*8*9 1/2*3*4*5*6*7*8*9 
##            362880            362881           -362879             90720 
## 1*2+3*4*5*6*7*8*9 1+2+3*4*5*6*7*8*9 
##            181442            181443

Now, I just need to see which of those produces a value of 100. Because sapply produced a vector with the expression itself as the name, I can extract the names of the results which are equal to 100

answers <- names(which(results == 100))
answers
##  [1] "1*2*3-4*5+6*7+8*9" "1+2+3-4*5+6*7+8*9" "1+2-3*4-5+6*7+8*9"
##  [4] "1-2*3-4-5+6*7+8*9" "1+2-3*4+5*6+7+8*9" "1-2*3-4+5*6+7+8*9"
##  [7] "1-2*3+4*5+6+7+8*9" "1*2*3+4+5+6+7+8*9" "1+2+3+4+5+6+7+8*9"
## [10] "1+2*3+4*5-6+7+8*9" "1+2*3*4*5/6+7+8*9" "1*2*3*4+5+6-7+8*9"
## [13] "1*2*3*4+5+6+7*8+9" "1-2+3*4*5-6+7*8-9" "1-2+3*4*5+6*7+8-9"

Any of those can easily be verified manually

1*2*3*4+5+6+7*8+9
## [1] 100

One thing I noticed here was that I have one more result than the Haskell post produces

length(answers)
## [1] 15

One of the answers stands out in that it contains a division, and sure enough this is the one that doesn’t appear in the Haskell post. I’m not quite sure why - I think the operator precedence is the same between R and Haskell, at least in terms of these expressions

3 / 2 + 1
## [1] 2.5
ghci> 3 / 2 + 1
2.5

But since I haven’t yet been able to actually run that Haskell code myself, I can’t verify those solutions.

My R solution to this puzzle is then

ops <- c("*", "+", "-", "/")
combos <- expand.grid(1, ops, 2, ops, 3, ops, 4, ops, 5, ops, 6, ops, 7, ops, 8, ops, 9)
exprs <- apply(combos, 1, \(x) paste0(x, collapse = ""))
results <- sapply(exprs, \(x) eval(parse(text = x)))
names(which(results == 100))

I did want to try a language which does have comprehensions - let’s try Julia!

Setting up the comprehension makes for a bit of a long line, but comes out okay

ops = ['+', '-', '*', '/']
## 4-element Vector{Char}:
##  '+': ASCII/Unicode U+002B (category Sm: Symbol, math)
##  '-': ASCII/Unicode U+002D (category Pd: Punctuation, dash)
##  '*': ASCII/Unicode U+002A (category Po: Punctuation, other)
##  '/': ASCII/Unicode U+002F (category Po: Punctuation, other)
exprs = ['1' * a * '2' * b * '3' * c * '4' * d * '5' * e * '6' * f * '7' * g * '8' * h * '9' 
         for a in ops, b in ops, c in ops, 
             d in ops, e in ops, f in ops, 
             g in ops, h in ops];
first(exprs, 10)
## 10-element Vector{String}:
##  "1+2+3+4+5+6+7+8+9"
##  "1-2+3+4+5+6+7+8+9"
##  "1*2+3+4+5+6+7+8+9"
##  "1/2+3+4+5+6+7+8+9"
##  "1+2-3+4+5+6+7+8+9"
##  "1-2-3+4+5+6+7+8+9"
##  "1*2-3+4+5+6+7+8+9"
##  "1/2-3+4+5+6+7+8+9"
##  "1+2*3+4+5+6+7+8+9"
##  "1-2*3+4+5+6+7+8+9"

That produces an array with many dimensions

size(exprs)
## (4, 4, 4, 4, 4, 4, 4, 4)

so it needs to be flattened into a vector with vec(). From there, it’s similar to the R approach and I can use a eval(Meta.parse()) pattern, keeping in mind that one can ‘broadcast’ scalar operations to vector operations with the dot (.) operator

results = eval.(Meta.parse.(vec(exprs)));
first(results, 10)
## 10-element Vector{Real}:
##  45
##  41
##  44
##  42.5
##  39
##  35
##  38
##  36.5
##  46
##  34

Finding the values equal to 100 is similar to the R approach

exprs[findall(results .== 100)]
## 15-element Vector{String}:
##  "1*2*3*4+5+6+7*8+9"
##  "1-2+3*4*5+6*7+8-9"
##  "1-2+3*4*5-6+7*8-9"
##  "1+2+3+4+5+6+7+8*9"
##  "1*2*3+4+5+6+7+8*9"
##  "1-2*3+4*5+6+7+8*9"
##  "1+2*3+4*5-6+7+8*9"
##  "1-2*3-4+5*6+7+8*9"
##  "1+2-3*4+5*6+7+8*9"
##  "1+2*3*4*5/6+7+8*9"
##  "1*2*3*4+5+6-7+8*9"
##  "1-2*3-4-5+6*7+8*9"
##  "1+2-3*4-5+6*7+8*9"
##  "1+2+3-4*5+6*7+8*9"
##  "1*2*3-4*5+6*7+8*9"

and again we see the 15 answers including the one with a division, confirming the R result.

This was a fun exploration - I don’t think I would want to try to solve it without code, but the code solutions were a great opportunity to use a few different languages.

I suspect there are a few different ways of solving this apart from this brute-force expanding of every combination, perhaps with a solver or something. If you have one, I’d love to see it. I thought @coolbutuseless had done something like this but the closest I could find was this post which is slightly different.

If you have comments, suggestions, or improvements, as always, feel free to use the comment section below, or hit me up on Mastodon.


devtools::session_info() 
## ─ Session info ───────────────────────────────────────────────────────────────
##  setting  value
##  version  R version 4.3.3 (2024-02-29)
##  os       Pop!_OS 22.04 LTS
##  system   x86_64, linux-gnu
##  ui       X11
##  language (EN)
##  collate  en_AU.UTF-8
##  ctype    en_AU.UTF-8
##  tz       Australia/Adelaide
##  date     2024-06-15
##  pandoc   3.1.11 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/x86_64/ (via rmarkdown)
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package     * version date (UTC) lib source
##  blogdown      1.18    2023-06-19 [1] CRAN (R 4.3.2)
##  bookdown      0.36    2023-10-16 [1] CRAN (R 4.3.2)
##  bslib         0.6.1   2023-11-28 [3] CRAN (R 4.3.2)
##  cachem        1.0.8   2023-05-01 [3] CRAN (R 4.3.0)
##  callr         3.7.3   2022-11-02 [3] CRAN (R 4.2.2)
##  cli           3.6.2   2023-12-11 [3] CRAN (R 4.3.2)
##  crayon        1.5.2   2022-09-29 [3] CRAN (R 4.2.1)
##  devtools      2.4.5   2022-10-11 [1] CRAN (R 4.3.2)
##  digest        0.6.34  2024-01-11 [3] CRAN (R 4.3.2)
##  ellipsis      0.3.2   2021-04-29 [3] CRAN (R 4.1.1)
##  evaluate      0.23    2023-11-01 [3] CRAN (R 4.3.2)
##  fastmap       1.1.1   2023-02-24 [3] CRAN (R 4.2.2)
##  fs            1.6.3   2023-07-20 [3] CRAN (R 4.3.1)
##  glue          1.7.0   2024-01-09 [3] CRAN (R 4.3.2)
##  htmltools     0.5.7   2023-11-03 [3] CRAN (R 4.3.2)
##  htmlwidgets   1.6.2   2023-03-17 [1] CRAN (R 4.3.2)
##  httpuv        1.6.12  2023-10-23 [1] CRAN (R 4.3.2)
##  icecream      0.2.1   2023-09-27 [1] CRAN (R 4.3.2)
##  jquerylib     0.1.4   2021-04-26 [3] CRAN (R 4.1.2)
##  jsonlite      1.8.8   2023-12-04 [3] CRAN (R 4.3.2)
##  JuliaCall     0.17.5  2022-09-08 [1] CRAN (R 4.3.3)
##  knitr         1.45    2023-10-30 [3] CRAN (R 4.3.2)
##  later         1.3.1   2023-05-02 [1] CRAN (R 4.3.2)
##  lifecycle     1.0.4   2023-11-07 [3] CRAN (R 4.3.2)
##  magrittr      2.0.3   2022-03-30 [3] CRAN (R 4.2.0)
##  memoise       2.0.1   2021-11-26 [3] CRAN (R 4.2.0)
##  mime          0.12    2021-09-28 [3] CRAN (R 4.2.0)
##  miniUI        0.1.1.1 2018-05-18 [1] CRAN (R 4.3.2)
##  pkgbuild      1.4.2   2023-06-26 [1] CRAN (R 4.3.2)
##  pkgload       1.3.3   2023-09-22 [1] CRAN (R 4.3.2)
##  prettyunits   1.2.0   2023-09-24 [3] CRAN (R 4.3.1)
##  processx      3.8.3   2023-12-10 [3] CRAN (R 4.3.2)
##  profvis       0.3.8   2023-05-02 [1] CRAN (R 4.3.2)
##  promises      1.2.1   2023-08-10 [1] CRAN (R 4.3.2)
##  ps            1.7.6   2024-01-18 [3] CRAN (R 4.3.2)
##  purrr         1.0.2   2023-08-10 [3] CRAN (R 4.3.1)
##  R6            2.5.1   2021-08-19 [3] CRAN (R 4.2.0)
##  Rcpp          1.0.11  2023-07-06 [1] CRAN (R 4.3.2)
##  remotes       2.4.2.1 2023-07-18 [1] CRAN (R 4.3.2)
##  rlang         1.1.3   2024-01-10 [3] CRAN (R 4.3.2)
##  rmarkdown     2.25    2023-09-18 [3] CRAN (R 4.3.1)
##  rstudioapi    0.15.0  2023-07-07 [3] CRAN (R 4.3.1)
##  sass          0.4.8   2023-12-06 [3] CRAN (R 4.3.2)
##  sessioninfo   1.2.2   2021-12-06 [1] CRAN (R 4.3.2)
##  shiny         1.7.5.1 2023-10-14 [1] CRAN (R 4.3.2)
##  stringi       1.8.3   2023-12-11 [3] CRAN (R 4.3.2)
##  stringr       1.5.1   2023-11-14 [3] CRAN (R 4.3.2)
##  urlchecker    1.0.1   2021-11-30 [1] CRAN (R 4.3.2)
##  usethis       2.2.2   2023-07-06 [1] CRAN (R 4.3.2)
##  vctrs         0.6.5   2023-12-01 [3] CRAN (R 4.3.2)
##  xfun          0.41    2023-11-01 [3] CRAN (R 4.3.2)
##  xtable        1.8-4   2019-04-21 [1] CRAN (R 4.3.2)
##  yaml          2.3.8   2023-12-11 [3] CRAN (R 4.3.2)
## 
##  [1] /home/jono/R/x86_64-pc-linux-gnu-library/4.3
##  [2] /usr/local/lib/R/site-library
##  [3] /usr/lib/R/site-library
##  [4] /usr/lib/R/library
## 
## ──────────────────────────────────────────────────────────────────────────────


rstats  julia  haskell 

See also