Why does my Alphametics Solution Stall on the 199 Addends Test?

Learn
1

The Alphametics puzzle requires solving what value each letter has in some arithmetic puzzle.

My implementation. The general strategy was to rapidly generate all possible paths and prune them as they proved themselves impossible using column addition*.

I can solve the base tests on the exercise but the large one with 199 addends runs indefinitely and never finds an answer.

I found this solution which I really like, however one thing I noticed is that my solution is quite a bit faster for the first 9 tests, but fails miserably on the 199 addends test.

Case { description = "puzzle with ten letters and 199 addends"
              , puzzle      = "THIS + A + FIRE + THEREFORE + FOR + ALL + HISTORIES + I + TELL + A + TALE + THAT + FALSIFIES + ITS + TITLE + TIS + A + LIE + THE + TALE + OF + THE + LAST + FIRE + HORSES + LATE + AFTER + THE + FIRST + FATHERS + FORESEE + THE + HORRORS + THE + LAST + FREE + TROLL + TERRIFIES + THE + HORSES + OF + FIRE + THE + TROLL + RESTS + AT + THE + HOLE + OF + LOSSES + IT + IS + THERE + THAT + SHE + STORES + ROLES + OF + LEATHERS + AFTER + SHE + SATISFIES + HER + HATE + OFF + THOSE + FEARS + A + TASTE + RISES + AS + SHE + HEARS + THE + LEAST + FAR + HORSE + THOSE + FAST + HORSES + THAT + FIRST + HEAR + THE + TROLL + FLEE + OFF + TO + THE + FOREST + THE + HORSES + THAT + ALERTS + RAISE + THE + STARES + OF + THE + OTHERS + AS + THE + TROLL + ASSAILS + AT + THE + TOTAL + SHIFT + HER + TEETH + TEAR + HOOF + OFF + TORSO + AS + THE + LAST + HORSE + FORFEITS + ITS + LIFE + THE + FIRST + FATHERS + HEAR + OF + THE + HORRORS + THEIR + FEARS + THAT + THE + FIRES + FOR + THEIR + FEASTS + ARREST + AS + THE + FIRST + FATHERS + RESETTLE + THE + LAST + OF + THE + FIRE + HORSES + THE + LAST + TROLL + HARASSES + THE + FOREST + HEART + FREE + AT + LAST + OF + THE + LAST + TROLL + ALL + OFFER + THEIR + FIRE + HEAT + TO + THE + ASSISTERS + FAR + OFF + THE + TROLL + FASTS + ITS + LIFE + SHORTER + AS + STARS + RISE + THE + HORSES + REST + SAFE + AFTER + ALL + SHARE + HOT + FISH + AS + THEIR + AFFILIATES + TAILOR + A + ROOFS + FOR + THEIR + SAFE == FORTRESSES"
              , expected    = Just [('A', 1), ('E', 0), ('F', 5), ('H', 8), ('I', 7),
                                    ('L', 2), ('O', 6), ('R', 3), ('S', 4), ('T', 9)]
              }

I suspect* that my issue is something to do with strictness/laziness but I donā€™t have the skill/knowledge needed to evaluate that claim.

Could any one help point me in the right direction to begin debugging this?

Thanks in advance.

1 Like
2

It looks like the link to your solution is missing.

1 Like
3

Ah my apologies, the one in the OP and this one should work!

1 Like
4

Ok, I think Iā€™ve spotted the problem.

In your solution, you generate every possible combination of mapping Map Char Int for the alphabets appearing at the least significant digit, verify them, and goes next least significant digit and repeat.

The hardest test case has many (all?) kinds of the alphabets used at their first digits. Which means your algorithm does no better than a brute-force for this particular test case, and the additional cost of doing bookkeeping for column-wise guessing multiplies.

Try it on the ā€œhardā€ but simple problem like this:

Case { description = "Every alphabets on the first column"
              , puzzle      = "A+B+C+D+E+F+G+H+I=AJ"
              , expected    = Nothing
              }
1 Like
5

Sorry, there might be another one. Quoting your code:

type PossibleChars = Map.Map Char [Int]

setCharVariants :: Char -> PossibleChars -> Maybe [PossibleChars]
setCharVariants = {- omit -}

setAllCharVariants :: String -> PossibleChars -> Maybe [PossibleChars]
setAllCharVariants inpString charMap = go inpString [charMap]
    where
        go "" charMapList   = pure charMapList
        go (s:str) charMapList  = traverse (setCharVariants s) charMapList >>= go str . concat

As far as I can tell, the purpose of setAllCharVariants is to generate a list of all candidates of PossibleChars maps such that every character in inpString has only one possible digit among their original possibilities.

The number of such maps is around n * (n-1) * ... * (n-m+1) where n is the number of unused digits and m is the number of distinct characters in inpString. Implemented correctly, this list can be generated by time proportional to the length of the output.

But your implementation of setAllCharVarints has few problems. Firstly, it does some unnecessary works. You can remove duplicate characters and characters already determined to one digit from inpString first.

And more importantly, it actually has to create the entire list of candidate maps on the memory, which can be huge. Idiomatically, the list can be generated lazily.

The offender here is traverse (setCharVariants _). It is traversing the list of maps using Maybe Applicative, and before you get any one result of the traverse, it must have been going through every element of the list and recorded the result of setCharVariants in memory.

1 Like
6

Thank you very much @viercc, I really appreciate this.

Looking at this again with fresh eyes, Iā€™ve been able to condense most of the Maybe [PossibleChars] to just [PossibleChars].

Iā€™ve also changed setCharVariants to do a little less work:

setCharVariants :: Char -> PossibleChars -> [PossibleChars]
setCharVariants c charMap = let lis = Map.lookup c charMap
                             in maybe [] (map (updateMap charMap c)) lis

setAllCharVariants :: String -> PossibleChars -> [PossibleChars]
setAllCharVariants "" cmap = pure cmap
setAllCharVariants (s:str) charMap = (setCharVariants s) charMap >>= setAllCharVariants (delete s str)

validAdd :: String -> Char -> Int -> PossibleChars -> [(Int, PossibleChars)]
validAdd cs resChar carry charMap = let 
    as = fromMaybe [] $ traverse (\x -> fmap ((,) x) <$> x `Map.lookup` charMap) cs
    resVals = fromMaybe [] $ resChar `Map.lookup` charMap

    in [ ( c, (traceShowId toReturn) ) |
        v1 <- sequence as,
        let (vals, c, resDig) = let (car,dig) = (`divMod` 10) . (carry +) $ sum (map snd v1)
                                 in (,,) v1 car dig,
        resDig `elem` resVals,
        let updateResDig = updateMap charMap resChar resDig,
        let toReturn = foldr (\(ch, v) mp -> updateMap mp ch v) updateResDig vals
        ]

This is the desired purpose :smiley:

And I can see why it breaks now, thank you :slight_smile: I have a small clue as to why I am generating extra lists: Iā€™m only checking to see if the digits of a certain column add up to the result digit, but I donā€™t have a way to properly check that each digit is correct until Iā€™ve generated the full map, most of the times with errors. Worst of all, I can end up generating many copies of the same listā€¦interesting.

ghci> solve "A + A + A + A + A + A + A + A + A + A + A + B == BCC"
fromList [(' ',[0]),('A',[1]),('B',[9]),('C',[0])]
fromList [(' ',[0]),('A',[2]),('B',[8]),('C',[0])]
fromList [(' ',[0]),('A',[3]),('B',[7]),('C',[0])]
fromList [(' ',[0]),('A',[4]),('B',[6]),('C',[0])]
fromList [(' ',[0]),('A',[6]),('B',[4]),('C',[0])]
fromList [(' ',[0]),('A',[7]),('B',[3]),('C',[0])]
fromList [(' ',[0]),('A',[8]),('B',[2]),('C',[0])]
fromList [(' ',[0]),('A',[9]),('B',[1]),('C',[0])]
fromList [(' ',[0]),('A',[9]),('B',[1]),('C',[0])]
fromList [(' ',[0]),('A',[9]),('B',[1]),('C',[0])]
Just [('A',9),('B',1),('C',0)]

Unfortunately the 199 addends still takes quite a while :smiley:. I was thinking that if I passed the 10 unique character test, I could pass the 10 character + 199 addends test but Iā€™m still unlucky so far :D.

EDIT: I added a traceShowId onto the toReturn in the validAdd function and it shows me brute force behaviour you said in #4. Most notably the ā€˜Sā€™ value ticks up the slowest.

I also tried it on your "A+B+C+D+E+F+G+H+I == AJ" example and that traceShowId doesnā€™t print anything to terminal (at least in the time Iā€™m willing to wait for it: ~30seconds).

1 Like