|
| 1 | +fun solve (puzzle: string): string = |
| 2 | + let |
| 3 | + (* Tokenize: words and "=" retained; "+" and spaces are separators *) |
| 4 | + val tokens = String.tokens (fn c => c = #" " orelse c = #"+") puzzle |
| 5 | + |
| 6 | + val nColumns = foldl (fn (t, m) => Int.max (String.size t, m)) 0 tokens |
| 7 | + |
| 8 | + fun isWord token = Char.isAlpha (String.sub (token, 0)) |
| 9 | + |
| 10 | + (* Letter info: weight vector has per-column coefficients, rank is rightmost column *) |
| 11 | + type info = {letter: char, leading: int, weight: int vector, rank: int} |
| 12 | + |
| 13 | + (* Build info for a given letter by scanning all tokens *) |
| 14 | + fun letterInfo (ch: char): info option = |
| 15 | + let |
| 16 | + (* Is ch the leading letter of a non-trivial word? *) |
| 17 | + val leading = |
| 18 | + if List.exists (fn t => |
| 19 | + isWord t andalso String.size t > 1 andalso String.sub (t, 0) = ch) tokens |
| 20 | + then 1 else 0 |
| 21 | + |
| 22 | + (* Per-column weight coefficients *) |
| 23 | + fun weightAt col = |
| 24 | + let |
| 25 | + fun processToken (token, (sign, sum)) = |
| 26 | + if not (isWord token) then (~sign, sum) |
| 27 | + else |
| 28 | + let val len = String.size token |
| 29 | + in |
| 30 | + if col < len andalso String.sub (token, len - 1 - col) = ch |
| 31 | + then (sign, sum + sign) |
| 32 | + else (sign, sum) |
| 33 | + end |
| 34 | + in #2 (foldl processToken (1, 0) tokens) end |
| 35 | + |
| 36 | + val weight = Vector.tabulate (nColumns, weightAt) |
| 37 | + |
| 38 | + (* Rightmost column where ch appears *) |
| 39 | + val rank = Vector.foldli (fn (i, w, r) => |
| 40 | + if w <> 0 then Int.min (i, r) else r) nColumns weight |
| 41 | + in |
| 42 | + if rank = nColumns then NONE |
| 43 | + else SOME { |
| 44 | + letter = ch, |
| 45 | + leading = leading, |
| 46 | + weight = weight, |
| 47 | + rank = rank |
| 48 | + } |
| 49 | + end |
| 50 | + |
| 51 | + (* Assemble letter infos for A-Z, sorted by rank *) |
| 52 | + fun sortByRank infos = |
| 53 | + let |
| 54 | + fun insert (x: info, []) = [x] |
| 55 | + | insert (x, (y: info) :: ys) = |
| 56 | + if #rank x <= #rank y then x :: y :: ys |
| 57 | + else y :: insert (x, ys) |
| 58 | + in foldl (fn (e, acc) => insert (e, acc)) [] infos end |
| 59 | + |
| 60 | + val letters: info list = |
| 61 | + sortByRank (List.mapPartial letterInfo |
| 62 | + (List.tabulate (26, fn i => chr (Char.ord #"A" + i)))) |
| 63 | + |
| 64 | + (* Mapping: associates each letter with its assigned digit *) |
| 65 | + type mapping = (char * int) list |
| 66 | + |
| 67 | + fun lookup (_, []: mapping) = 0 |
| 68 | + | lookup (ch, (c, digit) :: rest) = if c = ch then digit else lookup (ch, rest) |
| 69 | + |
| 70 | + fun isClaimed (claimed, d) = |
| 71 | + Word.andb (claimed, Word.<< (0w1, Word.fromInt d)) <> 0w0 |
| 72 | + |
| 73 | + fun claim (claimed, d) = |
| 74 | + Word.orb (claimed, Word.<< (0w1, Word.fromInt d)) |
| 75 | + |
| 76 | + (* Sum of weight[col] * digit for all letters *) |
| 77 | + fun columnSum (col, mapping) = |
| 78 | + foldl (fn ({letter, weight, ...}: info, sum) => |
| 79 | + if col < Vector.length weight |
| 80 | + then sum + Vector.sub (weight, col) * lookup (letter, mapping) |
| 81 | + else sum) 0 letters |
| 82 | + |
| 83 | + (* Check column and advance, or finish *) |
| 84 | + fun advanceColumn (remaining, col, claimed, carry, mapping) = |
| 85 | + let val colSum = carry + columnSum (col, mapping) |
| 86 | + in |
| 87 | + if colSum mod 10 <> 0 then NONE |
| 88 | + else if col + 1 < nColumns then |
| 89 | + search (remaining, col + 1, claimed, colSum div 10, mapping) |
| 90 | + else if colSum = 0 then SOME mapping |
| 91 | + else NONE |
| 92 | + end |
| 93 | + |
| 94 | + (* Search: assign digits to letters column by column *) |
| 95 | + and search (remaining, col, claimed, carry, mapping) = |
| 96 | + case remaining of |
| 97 | + [] => advanceColumn ([], col, claimed, carry, mapping) |
| 98 | + | (letter :: rest) => |
| 99 | + if #rank letter > col then |
| 100 | + advanceColumn (remaining, col, claimed, carry, mapping) |
| 101 | + else |
| 102 | + let |
| 103 | + fun tryDigit digit = |
| 104 | + if digit > 9 then NONE |
| 105 | + else if isClaimed (claimed, digit) then tryDigit (digit + 1) |
| 106 | + else |
| 107 | + case search (rest, col, claim (claimed, digit), |
| 108 | + carry, (#letter letter, digit) :: mapping) of |
| 109 | + SOME m => SOME m |
| 110 | + | NONE => tryDigit (digit + 1) |
| 111 | + in tryDigit (#leading letter) end |
| 112 | + |
| 113 | + (* Convert puzzle string by substituting digits from mapping *) |
| 114 | + fun substitute mapping = |
| 115 | + String.implode (map (fn c => |
| 116 | + if Char.isAlpha c then chr (Char.ord #"0" + lookup (c, mapping)) |
| 117 | + else c) (String.explode puzzle)) |
| 118 | + in |
| 119 | + case search (letters, 0, 0w0, 0, []) of |
| 120 | + SOME m => substitute m |
| 121 | + | NONE => raise Fail "no solution" |
| 122 | + end |
0 commit comments