By: Jonathan Carroll
Re-posted from: https://jcarroll.com.au/2024/06/15/digits-dilemma/
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-07-06
## pandoc 3.2 @ /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.1 2023-03-23 [1] CRAN (R 4.3.3)
## 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 [1] CRAN (R 4.3.3)
## 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 [1] CRAN (R 4.3.3)
## magrittr 2.0.3 2022-03-30 [1] CRAN (R 4.3.3)
## 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 [1] CRAN (R 4.3.3)
## 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.4 2024-06-04 [1] CRAN (R 4.3.3)
## 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 [1] CRAN (R 4.3.3)
## 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
##
## ──────────────────────────────────────────────────────────────────────────────
