Solve a letter digit substitution game in Haskell

Question

I am working on a Haskell problem from exercism, which is a learn-to-code website.

The problem statement is as follows.

Write a function to solve alphametics puzzles.

Alphametics is a puzzle where letters in words are replaced with numbers.

For example SEND + MORE = MONEY:

  S E N D   
  M O R E +
----------- 
M O N E Y 

Replacing these with valid numbers gives:

  9 5 6 7   
  1 0 8 5 +
----------- 
1 0 6 5 2 

This is correct because every letter is replaced by a different number and the words, translated into numbers, then make a valid sum.

Each letter must represent a different digit, and the leading digit of a multi-digit number must not be zero.

Write a function to solve alphametics puzzles.

You can solve this exercise with a brute force algorithm, but this will possibly have a poor runtime performance. Try to find a more sophisticated solution. Hint: You could try the column-wise addition algorithm that is usually taught in high school.

Here is my WIP solution. I would like to know how to shorten this up. I feel it's unnecessarily verbose.

module Alphametics (solve) where

import Data.List ((\\))
import Data.List.NonEmpty (NonEmpty)

import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Maybe as MB

solve' :: NonEmpty String -> Maybe [(Char, Int)]
solve' terms = findFirstSolution . zipLettersAndDigits . filterLeadingZeroes . L.permutations $ [0 .. 9]
  where
    initials    = L.nub . MB.catMaybes . NE.toList . NE.map MB.listToMaybe $ terms
    nonInitials = L.nub (concat terms) \\ initials
    letters     = initials ++ nonInitials
    n           = length initials
    findFirstSolution = L.find (`solves` terms)
    zipLettersAndDigits = map (zip letters)
    filterLeadingZeroes = filter noZerosPriorTo
    noZerosPriorTo p = 0 `notElem` take n p

solve :: String -> Maybe [(Char, Int)]
solve puzzle = solve' =<< NE.nonEmpty terms
  where
    terms = filter (all C.isUpper) . words $ puzzle

solves :: [(Char, Int)] -> NonEmpty String -> Bool
solves cmap terms = (sum <$> mapM termToInt (NE.init terms)) == termToInt (NE.last terms)
  where
    termToInt :: [Char] -> Maybe Int
    termToInt xs = fromDigits <$> mapM (`lookup` cmap) xs

    fromDigits :: [Int] -> Int
    fromDigits = L.foldl' (\n x -> n * 10 + x) 0

In particular, I'd like to avoid splitting the solve function into solve and solve', but I don't know how to inline solve' without just sticking it in a where clause, which isn't really any nicer. Seems like there should be a way to perform this bind without a separate function. Also, just general advice would be lovely, thanks!

Answer 1

There's no particular reason to want to not have a solve', except maybe that it's hard to give it a good name. If you're worried about clutter; putting it in a where clause is fine. solve already has a where, and there's no need to nest wheres, initials etc can be declared at the same level as solve'.

Each letter must represent a different digit, and the leading digit of a multi-digit number must not be zero.

There's an obnoxious edge case hidden here: If one of the terms is a single character, then that (leading!) character can be zero.

That's frustrating because already a lot of your complexity comes from trying to avoid solutions that involve illegal leading zeros. If you're going to keep working on this solution, I would suggest packaging the illegal-leading-zeros test as it's own function, and applying it later in the logic, after solves. The performance difference should be small either way, and I think it will read better.

Similarly, separate the business of parsing/validating the equation itself from the process of finding solutions. You're kinda already doing this with NonEmpty, but it's not clearly enforced that the constituent words will be non-empty, and it'd read clearer (and be easier to unpack arguments) if you had a designated data type for the equations.

I notice that Maybe is doing a lot of work. That's not ideal; if you get back Nothing, does that mean that the provided text wasn't a valid problem, or that no solution could be found? In the definition of solves, what would it mean for both sides of the == to be Nothing? (I don't actually know; I just think the situation smells bad.) I haven't thought too much about exactly how to fix it, but you have other options for representing failure; empty-list, Left, and error may help.

All that said, if you have a working brute-force solution, it's probably time to consider the final lines of the prompt, and start looking for something more performant.