Pizza Hut math problem #1 in Haskell

Question

I'm currently attempting to learn Haskell after a fair history of imperative programming. When I saw the Pizza Hut Pi Day math problems, I thought the first one would be a good candidate for my Haskell experimenting. The question is:

I’m thinking of a ten-digit integer whose digits are all distinct. It happens that the number formed by the first n of them is divisible by n for each n from 1 to 10. What is my number?

And I came up with the following code:

module Main where                               
import System.Environment                       

import Data.List                                

pizza2 = [ x | x <- [1000000000..9999999999],   
            (x `div` (10 ^ 0)) `mod` (10) == 0, 
            (x `div` (10 ^ 1)) `mod` (9) == 0,  
            (x `div` (10 ^ 2)) `mod` (8) == 0,  
            (x `div` (10 ^ 3)) `mod` (7) == 0,  
            (x `div` (10 ^ 4)) `mod` (6) == 0,  
            (x `div` (10 ^ 5)) `mod` (5) == 0,  
            (x `div` (10 ^ 6)) `mod` (4) == 0,  
            (x `div` (10 ^ 7)) `mod` (3) == 0,   
            (x `div` (10 ^ 8)) `mod` (2) == 0,  
            (x `div` (10 ^ 9)) `mod` (1) == 0,  
            nub ( show x ) == show x]           

main :: IO ()                                   
main = do                                       
putStrLn (show (nub (pizza2)))              

To my suprise, this actually compiles, runs, and returns the correct result. However, due to my inexperience (I think), it takes about 9 minutes to run and I feel like it should take less than a minute on the long side and just a couple seconds on the short side.

Two questions:

1. Why does this take so long?
2. I really feel like all those extra conditions I wrote should be able to be abstracted into one condition, but I couldn't figure it out on my own. Any ideas on how to condense that into one, more abstract condition?

Answer 1

Any ideas on how to condense that into one, more abstract condition?

Assuming x is in scope, you can simplify those conditions like this:

all (\n -> (x `div` (10^n)) `mod` (10 - n) == 0) [0..9])

Where all is a method from Data.Foldable with type (a -> Bool) -> [a] -> Bool.

Here is a more efficient algorithm which, instead of checking the whole interval of numbers, extracts ten digits from 0..9 without replacement. The bad news it that it requires some knowledge of monads and monad transformers. It has been adapted very closely from this blog post by Justin Le.

import Control.Monad             (guard, replicateM)
import Control.Monad.Trans.State

select :: [a] -> [(a, [a])]
select []     = []
select (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- select xs]

pizza3 :: Integer
pizza3 = head . flip evalStateT [0..9] $ do
    x0 <- StateT select
    let x0' = x0
    x1 <- StateT select
    let x1' = x1 * 10
    x2 <- StateT select
    let x2' = x2 * 100
    x3 <- StateT select
    let x3' = x3 * 1000
    x4 <- StateT select
    let x4' = x4 * 10000
    x5 <- StateT select
    let x5' = x5 * 100000
    x6 <- StateT select
    let x6' = x6 * 1000000
    x7 <- StateT select
    let x7' = x7 * 10000000
    x8 <- StateT select
    let x8' = x8 * 100000000
    x9 <- StateT select
    let x9' = x9 * 1000000000
        total = x0' + x1' + x2' + x3' + x4' + x5' + x6' + x7' + x8' + x9' 
    guard (all (\n -> (total `div` (10^n)) `mod` (10 - n) == 0) [0..9])
    return total

This code uses a syntax called do-notation which, in the case of the lists, is similar to using list comprehensions with several generators.

The idea is that each select non-deterministically draws a digit from a list containing digits not taken by previous selects. The non-determinism is provided by the list monad, the "not taken by previous selects" memory is provided by the State monad.

guard is a function that "culls unwanted paths" for monads that have non-determinism, using a predicate.

Here is a more succint version of the code above that uses replicateM from Control.Monad to remove repetition:

pizza4 :: Integer
pizza4 = head . flip evalStateT [0..9] $ do
    digitlist <- replicateM 10 (StateT select)
    let total = sum (zipWith (*) digitlist (iterate (*10) 1)) 
    guard (all (\n -> (total `div` (10^n)) `mod` (10 - n) == 0) [0..9])
    return total

replicateM performs a monadic action n times (here the action is "sampling without replacement") and returns another monadic action whose value is a list of n samples.

Answer 2

Basically, you're testing a lot of paths you don't have to. It would probably be more efficient to find a 1-digit number that is divisible by 1, then use that digit to find a 2-digit number that is divisible by 2, then use those two digits to find a 3-digit number that is divisible by 3, then recursively backtrack if you run out of options at one level.

Here's some code to illustrate. It returns essentially instantly in my REPL. You call it by pizza 1 0 initially.

import Data.List ((\\))
import Data.Char (digitToInt, intToDigit)
import Data.Maybe (listToMaybe, mapMaybe)

pizza :: Integer -> Integer -> Maybe Integer

pizza 10 accum = Just (accum * 10)

pizza n accum =
  let usedDigits = map digitToInt $ show accum
      unusedDigits = map toInteger $ [1..9] \\ usedDigits
      previous = accum * 10
      divisibleDigits = filter (\digit -> (previous + digit) `mod` n == 0) unusedDigits
  in listToMaybe $ mapMaybe (\digit -> pizza (n + 1) (previous + digit)) divisibleDigits

However, for one-shot problems like these, your solution is fine. If you can't write a faster algorithm in less than 9 minutes (of your programmer time), you haven't actually saved any time.

Answer 3

Programmer time efficient optimization

The other answers give very big performance improvements but require very big efforts and code re-writing.

As Karl noted we should strive for simple changes that make the program considerably faster.

I found a way to achieve a \$> 10x\$ speed-up by a very minor and simple change:

I noted that (x `div` (10 ^ 0)) `mod` (10) == 0, is the same as x `mod` 10 == 0, so we can skip that condition and just go in steps of 10 in our range:

pizza2 = [ x | x <- [1000000000, 1000000010..9999999999],
            --- we skip the first condition, we already have steps of 10 
            (x `div` (10 ^ 1)) `mod` (9) == 0,  
            --- ... the rest is the same

The speed-up is even more than 10x because we also skip one conditional check.

Answer 4

This solution is slow because it is the most brute-force approach possible. You're checking all 10-digit numbers, discarding those that fail the uniqueness and the divisibility criteria. On the other hand, it is also the most straightforward code possible, and a more efficient solution could easily take more than 9 minutes to write. On the third hand, finding the answer by feeding the problem literally to the computer doesn't demonstrate any insight, and in my personal opinion takes the challenge out of the challenge.

By inspection, the 2nd, 4th, 6th, 8th, and 10th digits must be even. By elimination, the 1st, 3rd, 5th, 7th, and 9th digits must be odd. These constraints alone could reduce the search space by a factor of 1024. Furthermore, the last digit must be 0, and the 5th digit must be 5. If you hard-code those constraints as well, then the search space would be reduced by a factor of 25600.

Answer 5

If you care about optimization, use maths to simplify the problem before the search. Starting from the bottom.

(x / 1) mod 10 == 0

so you know the last digit is 0. This condition can then be discarded once you restrict generation to have the last digit as 0.

This basically simplifies the problem to a nine-digit problem.

(x / 10) mod 9 == 0

Numbers are divisible by 9 if the sum of all the individual digits is evenly divisible by 9.

http://www.aaamath.com/div66_x9.htm

So this doesn't tell us anything (assuming it's true for any order, which it is), and we can drop the condition.

(x / 100) mod 8 == 0

This means x can end in 0, 2, 4, 6, or 8. 0 is already used, so that only leaves 2, 4, 6 or 8.

x = ? ? ? ? ? ? ? even ? 0
    where
        even = [2, 4, 6, 8]

We can do the same for the even constraints

(x / 10000) mod 6 == 0
(x / 1000000) mod 4 == 0
(x / 100000000) mod 2 == 0

Giving

x = ? even ? even ? even ? even ? 0
    where
        even = [2, 4, 6, 8]

Thus the others are odd

x = odd even odd even odd even odd even odd 0

(x / 1000) mod 7 == 0 doesn't tell anything obvious yet, but keep it in mind.

(x / 10000) mod 6 == 0 tells us the value to that point is divisible by 3. Divisibility by 3 can be checked by saying the sum of its digits is congruent to 0 modulo 3.

x = odd even odd even odd even odd even odd 0
    -------------------------- ------------

The second underlined group's sum of digits must thus be also divisible by 3 (as both groups together have a digit sum divisible by 3). We also know the value is odd.

x = odd even odd even odd even (genOddDiv3 ((d8 + d9) mod 3)) d8∈even d9∈odd 0
    where
        even = [2, 4, 6, 8]
        odd = [1, 3, 5, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = [5]
        genOddDiv3 2 = [1, 7]

(x / 100000) mod 5 == 0 tells us the digit is 5.

x = odd even odd even 5 even (genOddDiv3 ((d8 + d9) mod 3)) d8∈even d9∈odd 0
    where
        even = [2, 4, 6, 8]
        odd = [1, 3, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = []
        genOddDiv3 2 = [1, 7]

The lack of solutions for genOddDiv3 restricts d8, but we can keep that in mind for later.

(x / 1000000) mod 4 == 0 tells us not all too much extra, but keep it in mind.

(x / 10000000) mod 3 == 0 tells us again that we have a divisibility constraint.

x = odd even odd even 5 even (genOddDiv3 ((d8 + d9) mod 3)) d8∈even d9∈odd 0
    ------------ -----------
    where
        even = [2, 4, 6, 8]
        odd = [1, 3, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = []
        genOddDiv3 2 = [1, 7]

Both underlined groups have a digit sum divisible by 3. This gives

x = (genOddDiv3 ((d2 + d3) mod 3)) d2∈even d3∈odd
    (genEvenDiv3 ((5 + d6) mod 3)) 5       d6∈even
    (genOddDiv3 ((d8 + d9) mod 3)) d8∈even d9∈odd
    0
    where
        even = [2, 4, 6, 8]
        odd = [1, 3, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = []
        genOddDiv3 2 = [1, 7]
        genEvenDiv3 0 = [6]
        genEvenDiv3 1 = [4]
        genEvenDiv3 2 = [2, 8]

The last two constraints again tell us nothing we didn't already know.

Which constraints haven't we entirely used?

(x / 100) mod 8 == 0
(x / 1000) mod 7 == 0
(x / 1000000) mod 4 == 0

Divisibility by 4 only depends on the last two values, so we can just list some things

00 04 08
12 16
20 24 28
32 36
40 44, 48
...

Namely, if the second digit is in [0, 4, 8], the first is even. If the second digit is in [2, 6], the first is odd. Since the first (d3) is odd, we know the second must be in [2, 6].

x = (genOddDiv3 ((d2 + d3) mod 3)) d2∈even d3∈odd
    (genD4 ((5 + d6) mod 3))       5       d6∈even
    (genOddDiv3 ((d8 + d9) mod 3)) d8∈even d9∈odd
    0
    where
        even = [2, 4, 6, 8]
        odd = [1, 3, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = []
        genOddDiv3 2 = [1, 7]
        genD4 0 = [6]
        genD4 1 = []
        genD4 2 = [2]

The same can be done for (x / 100) mod 8 == 0, which implies (x / 100) mod 4 == 0.

x = (genOddDiv3 ((d2 + d3) mod 3)) d2∈even   d3∈odd
    (genD4 ((5 + d6) mod 3))       5         d6∈even
    (genOddDiv3 ((d8 + d9) mod 3)) d8∈[2, 6] d9∈odd
    0
    where
        even = [2, 4, 6, 8]
        odd = [1, 3, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = []
        genOddDiv3 2 = [1, 7]
        genD4 0 = [6]
        genD4 1 = []
        genD4 2 = [2]

We can use genOddDiv3 1 = [] to filter d8 dependent on d9, and the fact both d8 and d4 are in [2, 6] to filter d2 and d6 to [4, 8]. We can do the same filtering on d2 too.

x = (genOddDiv3 ((d2 + d3) mod 3)) d2∈[4, 8]     d3∈odd
    (genD4 ((5 + d6) mod 3))       5             d6∈[4, 8]
    (genOddDiv3 ((d8 + d9) mod 3)) d8∈(genD8 d9) d9∈odd
    0
    where
        odd = [1, 3, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = []
        genOddDiv3 2 = [1, 7]

        genD8 1 = [2]
        genD8 3 = [2, 6]
        genD8 7 = [2]
        genD8 9 = [2, 6]

        genD4 0 = [6]
        genD4 1 = []
        genD4 2 = [2]

        genD2 1 = [4, 8]
        genD2 3 = [8]
        genD2 7 = [4, 8]
        genD2 9 = [8]

Then we can use specialize D4 on d6's possibilities, which shows us d6 = 4, d4 = 6. Thus d8 = 2 and d2 = 8.

x = (genOddDiv3 ((8 + d3) mod 3)) 8 d3∈odd
    6 5 4
    (genOddDiv3 ((2 + d9) mod 3)) 2 d9∈odd
    0
    where
        odd = [1, 3, 7, 9]
        genOddDiv3 0 = [3, 9]
        genOddDiv3 1 = []
        genOddDiv3 2 = [1, 7]

Then specialize the genOddDiv3s on their input.

x = (genD1 d3) 8 d3∈odd
    6 5 4
    (genD7 d9 ((2 + d9) mod 3)) 2 d9∈odd
    0
    where
        odd = [1, 3, 7, 9]

        genD1 1 = [3, 9]
        genD1 3 = [1, 7]
        genD1 7 = [3, 9]
        genD1 9 = [1, 7]

        genD9 = genD1

Our options are now easily enumerable:

x = 1836547290
x = 3816549270
x = 3876549210
x = 7836541290
x = 7896541230
x = 7896541230
x = 9816543270
x = 9876543210

and we can test each for divisibility by 7

183654 mod 7 = 2
381654 mod 7 = 0
387654 mod 7 = 1
783654 mod 7 = 4
789654 mod 7 = 5
789654 mod 7 = 5
981654 mod 7 = 2
987654 mod 7 = 3

So our only solution is

381654

Ergo the most efficient Haskell I can think of is

pizza = 3816549270