## 2011-12-30

### (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 `ratio`s, 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  @ 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 10size - 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 `con`stant "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 `group`ing 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 2 1 = 99 / 99 2 = 99 / 9 - 9 3 = (9 + 9 + 9) / 9 4 = 9 / 9 + 9 / √9 5 = 9 - 9 / 9 - √9 6 = 9 * 9 / 9 - √9 7 = 9 - (9 + 9) / 9 8 = 99 / 9 - √9 9 = √(99 - 9 - 9) 10 = (99 - 9) / 9 11 = (9 + 9) / 9 + 9 12 = (9 + 99) / 9 13 = 9 + 9 / 9 + √9 14 = 99 / 9 + √9 15 = 9 + 9 - 9 / √9 17 = 9 + 9 - 9 / 9 18 = 99 - 9 * 9 19 = 9 + 9 + 9 / 9 20 = 9 + 99 / 9 21 = 9 + 9 + 9 / √9 24 = 99 / √9 - 9 26 = 9 * √9 - 9 / 9 27 = 9 * 9 * √9 / 9 28 = 9 * √9 + 9 / 9 30 = (99 - 9) / √9 32 = (99 - √9) / √9 33 = 99 * √9 / 9 34 = (99 + √9) / √9 36 = 9 + 9 + 9 + 9 39 = 9 * √9 + 9 + √9 42 = 9 + 99 / √9 45 = 9 * √9 + 9 + 9 51 = (9 + 9) * √9 - √9 54 = 9 * 9 - 9 * √9 57 = (9 + 9) * √9 + √9 63 = 9 * 9 - 9 - 9 69 = 9 * 9 - 9 - √9 72 = 99 - 9 * √9 75 = 9 * 9 - 9 + √9 78 = 9 * 9 - 9 / √9 80 = 9 * 9 - 9 / 9 81 = 99 - 9 - 9 82 = 9 * 9 + 9 / 9 84 = 9 * 9 + 9 / √9 87 = 99 - 9 - √9 90 = (9 + 9 / 9) * 9 93 = 99 - 9 + √9 96 = 99 - 9 / √9 98 = 99 - 9 / 9 99 = 9 * 99 / 9 100 = 9 / 9 + 99 102 = 9 / √9 + 99 105 = 9 + 99 - √9 108 = 99 + √(9 * 9) 111 = 999 / 9 117 = 9 + 9 + 99 126 = 9 * √9 + 99 135 = (9 + 9 - √9) * 9 144 = (9 + √9) * (9 + √9) 153 = (9 + 9) * 9 - 9 159 = (9 + 9) * 9 - √9 162 = 9 * 9 + 9 * 9 165 = (9 + 9) * 9 + √9 171 = (9 + 9) * 9 + 9 180 = 9 * 9 + 99 189 = (9 + 9 + √9) * 9 198 = 99 + 99 216 = (9 * 9 - 9) * √9 234 = 9 * 9 * √9 - 9 240 = 9 * 9 * √9 - √9 243 = (9 + 9 + 9) * 9 246 = 9 * 9 * √9 + √9 252 = 9 * 9 * √9 + 9 270 = (99 - 9) * √9 288 = 99 * √9 - 9 294 = 99 * √9 - √9 297 = 9 * 99 / √9 300 = 99 * √9 + √9 306 = 9 + 99 * √9 324 = (9 + 99) * √9 333 = 999 / √9 486 = (9 + 9) * 9 * √9 594 = (9 - √9) * 99 648 = (9 * 9 - 9) * 9 702 = (9 * 9 - √9) * 9 720 = 9 * 9 * 9 - 9 726 = 9 * 9 * 9 - √9 729 = 9 * 9 * √(9 * 9) 732 = 9 * 9 * 9 + √9 738 = 9 * 9 * 9 + 9 756 = (9 * 9 + √9) * 9 810 = (99 - 9) * 9 864 = (99 - √9) * 9 882 = 9 * 99 - 9 888 = 9 * 99 - √9 891 = 99 * √(9 * 9) 894 = 9 * 99 + √9 900 = 9 * 99 + 9 918 = (99 + √9) * 9 972 = (9 + 99) * 9 990 = 999 - 9 996 = 999 - √9 1002 = 999 + √9 1008 = 9 + 999 1188 = (9 + √9) * 99 1458 = (9 + 9) * 9 * 9 1782 = (9 + 9) * 99 2187 = 9 * 9 * 9 * √9 2673 = 9 * 99 * √9 2997 = 999 * √9 6561 = 9 * 9 * 9 * 9 8019 = 9 * 9 * 99 8991 = 9 * 999 9801 = 99 * 99 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).

#### 2 comments:

Gabriel said...

You don't use Neg at all, do you?

Matías Giovannini said...

@Gabriel: Yes I do, in abs. But for every expression using Neg there is a shorter one with the same value, so no solution uses it.