(One by) Four by Nine

The four nines puzzle asks which positive numbers can be obtained from arithmetic expressions involving four "9" digits and an assortment of operations, minimally "+", "-" (binary and unary), "×" and "/", also frequently "√" and sometimes "!" (factorial). I'll show how to find them by brute force. In this case, I'll forgo using factorials; this means that not every number under 100 can be so obtained. As it is, at 130-odd lines, this is a longish program.

Expressions are labeled trees, where type α is the type of labels and type β is the type of leaves:

type ('a, 'b) expr =
| Con of 'a * 'b
| Neg of 'a * ('a, 'b) expr
| Sqr of 'a * ('a, 'b) expr
| Add of 'a * ('a, 'b) expr * ('a, 'b) expr
| Sub of 'a * ('a, 'b) expr * ('a, 'b) expr
| Mul of 'a * ('a, 'b) expr * ('a, 'b) expr
| Div of 'a * ('a, 'b) expr * ('a, 'b) expr

Later I'll make clear what labels are useful for. For now, the simplest operation on an expression is extracting its label:

let label = function
| Con (l, _    )
| Neg (l, _    )
| Sqr (l, _    )
| Add (l, _, _ )
| Sub (l, _, _ )
| Mul (l, _, _ )
| Div (l, _, _ ) -> l

Note that this is not a recursive function; it just extracts the label of the root. Converting expression trees into algebraic syntax is a tedious exercise in unparsing a precedence operator grammar. In this case, since the leaves are of an arbitrary type, format needs a conversion function cnv:

let format cnv e =
  let buf = Buffer.create 10 in
  let rec go level e =
    let prf op prec e =
      Buffer.add_string buf op;
      if prec < level then Buffer.add_char buf '(';
      go prec e;
      if prec < level then Buffer.add_char buf ')'
    in
    let bin op prec e e' =
      if prec < level then Buffer.add_char buf '(';
      go prec e;
      Buffer.add_char   buf ' ';
      Buffer.add_string buf op;
      Buffer.add_char   buf ' ';
      go prec e';
      if prec < level then Buffer.add_char buf ')'
    in match e with
    | Con (_, x    ) -> Buffer.add_string buf (cnv x)
    | Neg (_, e    ) -> prf "-" 10 e
    | Sqr (_, e    ) -> prf "\xe2\x88\x9a" 10 e
    | Add (_, e, e') -> bin "+"  1 e e'
    | Sub (_, e, e') -> bin "-"  2 e e'
    | Mul (_, e, e') -> bin "*"  5 e e'
    | Div (_, e, e') -> bin "/"  6 e e'
  in go 0 e; Buffer.contents buf

The inner function prf formats prefix operators with precedence prec, while bin formats binary operators. In both cases, if op's binding power prec is less than the current precedence level, the whole expression is surrounded by parentheses. Note that I use the UTF-8 representation of the radical sign U+221A; who said that OCaml doesn't do Unicode?

If expressions are labeled with their values, they can be evaluated in constant time with label; to avoid losing precision, I use rational labels. If any expression is out of range, I use the "fraction" 1/0, infinity_ratio, as a sentinel. For this to work with OCaml ratios, I must turn off error checking on null denominators:

let () = Arith_status.set_error_when_null_denominator false

let infinity_ratio = Ratio.(inverse_ratio (ratio_of_int 0))

How to compute the square root of a fraction? If both the numerator and denominator are positive perfect squares, the answer is clear. In any other case, I signal failure via infinity_ratio:

let sqrt_ratio r =
  let open Ratio in
  let open Big_int in
  match sign_ratio r with
  | -1 -> infinity_ratio
  |  0 -> r
  |  1 ->
    let r1, r2 = numerator_ratio r, denominator_ratio r in
    let q1, q2 = sqrt_big_int   r1, sqrt_big_int     r2 in
    let s1, s2 = square_big_int q1, square_big_int   q2 in
    if eq_big_int r1 s1 && eq_big_int r2 s2
      then div_big_int_ratio q1 (ratio_of_big_int q2)
      else infinity_ratio
  |  _ -> assert false

Low-level but straightforward. Now smart constructors make sure that every expression is correctly labeled with its value:

let con n    = Con (Ratio.ratio_of_int        n            , n    )
and neg e    = Neg (Ratio.minus_ratio  (label e)           , e    )
and sqr e    = Sqr (      sqrt_ratio   (label e)           , e    )
and add e e' = Add (Ratio.add_ratio    (label e) (label e'), e, e')
and sub e e' = Sub (Ratio.sub_ratio    (label e) (label e'), e, e')
and mul e e' = Mul (Ratio.mult_ratio   (label e) (label e'), e, e')
and div e e' = Div (Ratio.div_ratio    (label e) (label e'), e, e')
and abs e    =
  let r = label e in
  if Ratio.sign_ratio r != -1 then e else
  Neg (Ratio.minus_ratio r, e)

The stage is set for generating all the expressions. If nines size generates all the expressions using size nines, the recursion schema it obeys is something like this:

  if size == 1 then [   9] else
  if size == 2 then [  99] @ mix (nines 1) (nines 1) else
  if size == 3 then [ 999] @ mix (nines 2) (nines 1) @ mix (nines 1) (nines 2) else
  if size == 4 then [9999] @ mix (nines 3) (nines 1) @ mix (nines 2) (nines 2) @ mix (nines 1) (nines 3) else...

where mix is a hypothetical function that merges two lists of expressions using all the possible binary operators. In each case, the constant 10^size - 1 = 99…9 is the base of the recursion, which proceeds by building all binary trees of a given size by partitioning size in two summands. OK, maybe it is simpler to show the actual code than trying to explain it in English. A small function generates the number having its n digits equal to d:

let rec rep d n = if n == 0 then 0 else d + 10 * (rep d (pred n))

(Yes, the same code can solve the four fours puzzle, or the nine nines puzzle, or…) Another basic function generates a list of integers in a given range:

let range i j =
  let rec go l i j =
    if i > j then l else go (j :: l) i (pred j)
  in go [] i j

(This one is tail recursive just because.) Now, given an expression e, I will count it as valid by adding it to the list es of expressions if it is finite and positive. Furthermore, if it is valid and it has a rational square root, I will count the latter as valid too:

let with_root e es =
  let open Ratio in
  let e = abs e in
  if null_denominator (label e)
  || sign_ratio (label e) == 0 then es else
  let q = sqr e in
  if null_denominator (label q) then e :: es else q :: e :: es

Finally, the workhorse:

let rec puzzle digit size =
  List.fold_right (fun i ->
    let j = size - i in
    List.fold_right (fun e0 ->
      List.fold_right (fun e1 ->
        List.fold_right (fun op ->
          with_root (op e0 e1)
        ) [add; sub; mul; div]
      ) (puzzle digit j)
    ) (puzzle digit i)
  ) (range 1 (size - 1))
  (with_root (con (rep digit size)) [])

It looks more complicated than it is, really; just a list comprehension in a different shape that forces one to read it from the outside in, alas. It all starts with the constant "dd… d", together with_(its)root if it is valid, as a seed for the list of expressions. Then for each i in the range from 1 to size - 1, it recursively builds solutions e0 of size i and e1 of size j = size - i. For each binary operation op, it builds the expression op e0 e1 and adds it to the resulting list of solutions, together with_(its)root if they are valid.

Almost done! The problem is that there could be many possible expressions for a given number; it would be best to find just one exemplar for it. I've written about grouping lists in another era:

let rec group ?(by=(=)) =
  let rec filter e l = match l with
  | [] -> [], []
  | x :: xs ->
    if not (by e x) then [], l else
    let gs, ys = filter e xs in
    x :: gs, ys
  in function
  | [] -> []
  | x :: xs ->
    let gs, ys = filter x xs in
    (x :: gs) :: group ~by ys

A bit of syntax will let me build a filtering pipeline to select the best candidates:

let (|>) x f = f x

Best in this case means that, out of all the expressions evaluating to a given integer, I prefer the one having the shortest representation. Now from all expressions I filter those that have integral value, decorate the expression as a string with its value, sort them and group them by value and select the first:

let fournines =
  let cmp (n, s) (n', s') =
    let c = Pervasives.compare n n' in
    if c != 0 then c else
    let c = Pervasives.compare (String.length s) (String.length s') in
    if c != 0 then c else
    Pervasives.compare s s'
  in puzzle 9 4
  |> List.filter (fun e ->  Ratio.is_integer_ratio (label e))
  |> List.map    (fun e -> (Ratio.int_of_ratio (label e), format string_of_int e))
  |> List.sort cmp
  |> group ~by:(fun (n, _) (n', _) -> n == n')
  |> List.map List.hd

Very operational. It only remains to format the list to standard output:

let () = List.iter (fun (n, s) -> Printf.printf "%4d = %s\n" n s) fournines

Behold, in all its glory, the solution to the puzzle:

1	1 =	99 / 99
2	2 =	99 / 9 - 9
3	3 =	(9 + 9 + 9) / 9
4	4 =	9 / 9 + 9 / √9
5	5 =	9 - 9 / 9 - √9
6	6 =	9 * 9 / 9 - √9
7	7 =	9 - (9 + 9) / 9
8	8 =	99 / 9 - √9
9	9 =	√(99 - 9 - 9)
10	10 =	(99 - 9) / 9
11	11 =	(9 + 9) / 9 + 9
12	12 =	(9 + 99) / 9
13	13 =	9 + 9 / 9 + √9
14	14 =	99 / 9 + √9
15	15 =	9 + 9 - 9 / √9
16	17 =	9 + 9 - 9 / 9
17	18 =	99 - 9 * 9
18	19 =	9 + 9 + 9 / 9
19	20 =	9 + 99 / 9
20	21 =	9 + 9 + 9 / √9
21	24 =	99 / √9 - 9
22	26 =	9 * √9 - 9 / 9
23	27 =	9 * 9 * √9 / 9
24	28 =	9 * √9 + 9 / 9
25	30 =	(99 - 9) / √9
26	32 =	(99 - √9) / √9
27	33 =	99 * √9 / 9
28	34 =	(99 + √9) / √9
29	36 =	9 + 9 + 9 + 9
30	39 =	9 * √9 + 9 + √9
31	42 =	9 + 99 / √9
32	45 =	9 * √9 + 9 + 9
33	51 =	(9 + 9) * √9 - √9
34	54 =	9 * 9 - 9 * √9
35	57 =	(9 + 9) * √9 + √9
36	63 =	9 * 9 - 9 - 9
37	69 =	9 * 9 - 9 - √9
38	72 =	99 - 9 * √9
39	75 =	9 * 9 - 9 + √9
40	78 =	9 * 9 - 9 / √9
41	80 =	9 * 9 - 9 / 9
42	81 =	99 - 9 - 9
43	82 =	9 * 9 + 9 / 9
44	84 =	9 * 9 + 9 / √9
45	87 =	99 - 9 - √9
46	90 =	(9 + 9 / 9) * 9
47	93 =	99 - 9 + √9
48	96 =	99 - 9 / √9
49	98 =	99 - 9 / 9
50	99 =	9 * 99 / 9
51	100 =	9 / 9 + 99
52	102 =	9 / √9 + 99
53	105 =	9 + 99 - √9
54	108 =	99 + √(9 * 9)
55	111 =	999 / 9
56	117 =	9 + 9 + 99
57	126 =	9 * √9 + 99
58	135 =	(9 + 9 - √9) * 9
59	144 =	(9 + √9) * (9 + √9)
60	153 =	(9 + 9) * 9 - 9
61	159 =	(9 + 9) * 9 - √9
62	162 =	9 * 9 + 9 * 9
63	165 =	(9 + 9) * 9 + √9
64	171 =	(9 + 9) * 9 + 9
65	180 =	9 * 9 + 99
66	189 =	(9 + 9 + √9) * 9
67	198 =	99 + 99
68	216 =	(9 * 9 - 9) * √9
69	234 =	9 * 9 * √9 - 9
70	240 =	9 * 9 * √9 - √9
71	243 =	(9 + 9 + 9) * 9
72	246 =	9 * 9 * √9 + √9
73	252 =	9 * 9 * √9 + 9
74	270 =	(99 - 9) * √9
75	288 =	99 * √9 - 9
76	294 =	99 * √9 - √9
77	297 =	9 * 99 / √9
78	300 =	99 * √9 + √9
79	306 =	9 + 99 * √9
80	324 =	(9 + 99) * √9
81	333 =	999 / √9
82	486 =	(9 + 9) * 9 * √9
83	594 =	(9 - √9) * 99
84	648 =	(9 * 9 - 9) * 9
85	702 =	(9 * 9 - √9) * 9
86	720 =	9 * 9 * 9 - 9
87	726 =	9 * 9 * 9 - √9
88	729 =	9 * 9 * √(9 * 9)
89	732 =	9 * 9 * 9 + √9
90	738 =	9 * 9 * 9 + 9
91	756 =	(9 * 9 + √9) * 9
92	810 =	(99 - 9) * 9
93	864 =	(99 - √9) * 9
94	882 =	9 * 99 - 9
95	888 =	9 * 99 - √9
96	891 =	99 * √(9 * 9)
97	894 =	9 * 99 + √9
98	900 =	9 * 99 + 9
99	918 =	(99 + √9) * 9
100	972 =	(9 + 99) * 9
101	990 =	999 - 9
102	996 =	999 - √9
103	1002 =	999 + √9
104	1008 =	9 + 999
105	1188 =	(9 + √9) * 99
106	1458 =	(9 + 9) * 9 * 9
107	1782 =	(9 + 9) * 99
108	2187 =	9 * 9 * 9 * √9
109	2673 =	9 * 99 * √9
110	2997 =	999 * √9
111	6561 =	9 * 9 * 9 * 9
112	8019 =	9 * 9 * 99
113	8991 =	9 * 999
114	9801 =	99 * 99
115	9999 =	9999

(The table is built out of the actual output to Mac OS Terminal. The Unicode characters are printed perfectly.) Using factorials to fill in the gaps is left as an exercise to the reader (it is not simple).