|
| 1 | +-- Returns a _map_ where the keys are initial letters of words in the puzzle. |
| 2 | +-- These letters cannot be mapped to digit zero. |
| 3 | +getLeadingDigits = (str) -> |
| 4 | + {c, true for c in str\gmatch '%f[%u].'} |
| 5 | + |
| 6 | +-- Returns an ordered list of the last letters of each word in the puzzle. |
| 7 | +getLastDigits = (str) -> |
| 8 | + [word\sub(-1) for word in str\gmatch '%u+'] |
| 9 | + |
| 10 | +-- Returns a list of the letters in the puzzle, prioritizing: |
| 11 | +-- a) last letters |
| 12 | +-- b) most frequently occurring letters |
| 13 | +extractUniqueLetters = (str, lastLetters) -> |
| 14 | + alreadySeen, rest = {}, {} |
| 15 | + for c in *lastLetters |
| 16 | + alreadySeen[c] = (alreadySeen[c] or 0) + 1 |
| 17 | + for c in str\gmatch '%u' |
| 18 | + if not alreadySeen[c] |
| 19 | + rest[c] = (rest[c] or 0) + 1 |
| 20 | + |
| 21 | + orderedKeys = (freq) -> |
| 22 | + keys = [k for k, _ in pairs freq] |
| 23 | + table.sort keys, (a, b) -> freq[a] > freq[b] |
| 24 | + keys |
| 25 | + |
| 26 | + all = {} |
| 27 | + all[#all + 1] = c for c in *orderedKeys(alreadySeen) |
| 28 | + all[#all + 1] = c for c in *orderedKeys(rest) |
| 29 | + all |
| 30 | + |
| 31 | +-- Does the mapping solve the puzzle? |
| 32 | +isValid = (map, str) -> |
| 33 | + eqn = str\gsub '%a', (c) -> map[c] |
| 34 | + numbers = [tonumber num for num in eqn\gmatch '%d+'] |
| 35 | + sum = 0 |
| 36 | + sum += numbers[i] for i = 1, #numbers - 1 |
| 37 | + sum == numbers[#numbers] |
| 38 | + |
| 39 | +-- Do the numbers in the last column add up? |
| 40 | +-- * Return nil if not all the letters have been mapped |
| 41 | +-- * Otherwise return true or false |
| 42 | +isLastColumnValid = (map, lastLetters) -> |
| 43 | + return nil if not map[lastLetters[#lastLetters]] |
| 44 | + sum = 0 |
| 45 | + for i = 1, #lastLetters - 1 |
| 46 | + return nil if not map[lastLetters[i]] |
| 47 | + sum += map[lastLetters[i]] |
| 48 | + (sum % 10) == map[lastLetters[#lastLetters]] |
| 49 | + |
| 50 | +-- Does a key-value table contain a given falue |
| 51 | +containsValue = (t, value) -> |
| 52 | + for key, val in pairs t |
| 53 | + if val == value |
| 54 | + return true |
| 55 | + false |
| 56 | + |
| 57 | +-- -------------------------------------------------------------------------- |
| 58 | +solveAlphametics = (equation) -> |
| 59 | + leadingLetters = getLeadingDigits equation |
| 60 | + lastLetters = getLastDigits equation |
| 61 | + variables = extractUniqueLetters equation, lastLetters |
| 62 | + |
| 63 | + backtrack = (assignment, index) -> |
| 64 | + if index > #variables |
| 65 | + return if isValid(assignment, equation) then assignment else nil |
| 66 | + |
| 67 | + currentVar = variables[index] |
| 68 | + start = if leadingLetters[currentVar] then 1 else 0 |
| 69 | + |
| 70 | + for digit = start, 9 |
| 71 | + if not containsValue assignment, digit |
| 72 | + assignment[currentVar] = digit |
| 73 | + constraint = isLastColumnValid assignment, lastLetters |
| 74 | + if constraint == nil or constraint == true |
| 75 | + result = backtrack assignment, index + 1 |
| 76 | + return result if result |
| 77 | + assignment[currentVar] = nil |
| 78 | + |
| 79 | + nil -- no solution found |
| 80 | + |
| 81 | + backtrack {}, 1 |
| 82 | + |
| 83 | +{ |
| 84 | + solve: solveAlphametics |
| 85 | +} |
0 commit comments