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

, while `prec``bin`

formats binary operators. In both cases, if

's binding power `op`

is less than the current precedence `prec`

, the whole expression is surrounded by parentheses. Note that I use the UTF-8 representation of the radical sign `level``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,

, as a sentinel. For this to work with OCaml `infinity_ratio``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 `

generates all the expressions using `size`

nines, the recursion schema it obeys is something like this:`size`

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

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 `size``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 "`d``d`… `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

, it recursively builds solutions `size` - 1`e0` of size `i` and `e1` of size `j` =

. For each binary operation `size` - `i``op`, it builds the expression

and adds it to the resulting list of solutions, together `op` `e0` `e1``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 | 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).

## 2 comments:

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

@Gabriel: Yes I do, in

abs. But for every expression usingNegthere is a shorter one with the same value, so no solution uses it.Post a Comment