2
\$\begingroup\$

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!

\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

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.

\$\endgroup\$
2
  • \$\begingroup\$ Oh my, your comment about my usage of Maybe is very insightful. But if the problem statement requires the type signature to be what you see for solve, it doesn't leave me a lot of room for maneuvering. \$\endgroup\$
    – lanf
    Jun 23, 2023 at 1:17
  • \$\begingroup\$ I guess I was looking very specifically for a way to golf what I've written so that the solve' was not necessary. \$\endgroup\$
    – lanf
    Jun 23, 2023 at 1:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.