Project Euler Problem 50 in Haskell

Question

The prime 41, can be written as the sum of six consecutive primes:

41 =わ 2 +たす 3 +たす 5 +たす 7 +たす 11 +たす 13 This is the longest sum of consecutive primes that adds to a prime below one-hundred.

The longest sum of consecutive primes below one-thousand that adds to a prime, contains 21 terms, and is equal to 953.

Which prime, below one-million, can be written as the sum of the most consecutive primes?

My solution (very fast):

asFarAsPossibleCondition :: (a -> Bool) -> [a] -> Maybe [a]
asFarAsPossibleCondition _ [] = Nothing
asFarAsPossibleCondition f xs = if f $ last xs then Just xs else asFarAsPossibleCondition f $ init xs
maxPrimeSum :: Int -> Int
maxPrimeSum n = snd $ maximumBy (comparing fst) series
 where
 series = map (\x -> (length x, last x)) $ mapMaybe checkSeries [0..10]
 checkSeries x = asFarAsPossibleCondition (isPrime) $ takeWhile (<n) $ scanl1 (+) $ drop x primes

asFarAsPossibleCondition looks for the last element in a list that satisfies a condition then returns that list up to that point (e.g. asFarAsPossibleCondition (<5) [1..10] -> Just [1,2,3,4]. (Note that it differs from takeWhile, since takeWhile will start at the beginning of the list and stops as soon as it encounters an element that does not satisfy the condition. My function starts at the end of the list and looks for the last element that satisfies the condition, regardless of whether there are elements before that that don't satisfy the condition, e.g. asFarAsPossibleCondition (<5) [1,2,3,4,5,6,7,8,9,10,4] -> Just [1,2,3,4,5,6,7,8,9,10,4]. This is useful to check a list of consecutive prime sums (e.g. [2, 5, 10, ...]) and get the longest one that adds to a prime, for instance:

last $ fromJust $ asFarAsPossibleCondition isPrime $ scanl1(+) $ take 20 primes
281 

This is the highest consecutive prime sum that results in a prime number that you can get with x<=20 prime numbers starting from 2 (2+たす3+たす5+たす7+たす11+たす13+たす17+たす19+たす23+たす29+たす31+たす37+たす41+たす43 =わ 281).

To start from the next prime, you simply drop the first prime, and so forth, e.g.

last $ fromJust $ asFarAsPossibleCondition isPrime $ scanl1(+) $ take 20 $ drop 1 primes
499

This is the highest consecutive prime sum that results in a prime number that you can get with x<=20 prime numbers starting from 3.

The rest is fairly obvious; it checks for each starting prime the greatest prime below 1,000,000, gets the length and the prime it adds up to, then gets the prime with the maximum length.

Any advice is welcome, specifically on:

• the use of Maybe (I'm just learning about this); is it correct? Justified? ...
• how to determine on how many items that I should map the checkSeries function on. ([0..10] was sufficient, but that was simply because I got lucky).
• is there a builtin that does what my asFarAsPossibleCondition function does?

• rubik: By using scanl you create sums of consecutive primes starting from 2. The problem text says nowhere that all the sums should start from 2. I think that's your problem.
• rubik: Also, I don't think that filter isPrime is very efficient. Since you already have a list of primes, you could check if a number is present or not.

Answer 1

Here is my approach:

First some imports:

 {-# LANGUAGE BangPatterns #-}
 module Euler50
 where
 import Math.NumberTheory.Primes
 import qualified Data.IntSet as Set
 import Data.List
 import Debug.Trace

We use the arithmoi library to get the primes:

 myPrimes :: [Int]
 myPrimes = map fromIntegral $ takeWhile (< 1000000) primes
 myPrimeSet :: Set.IntSet
 myPrimeSet = Set.fromList myPrimes
 myIsPrime :: Int -> Bool
 myIsPrime p = Set.member p myPrimeSet

To solve the problem, let's first define a function to produce consecutive sums of a list:

 consecutiveSums0 :: [Int] -> [(Int,Int)]
 consecutiveSums0 ps = scanl step (0,0) ps
 where step (!n,!total) p = (n+1, total+p)

For example, consecutiveSums0 [2,3,5,7] will produce the list:

[ (0,0), (1,2), (2,5), (3,10), (4,17) ]

It will be useful to be able to specify a starting value for the accumulator, so we'll define:

 consecutiveSums :: (Int,Int) -> [Int] -> [(Int,Int)]
 consecutiveSums start ps = scanl step start ps
 where step (!n,!total) p = (n+1, total+p)

Next, we filter out only the prime sums which are less than 1000000:

 primeSums :: (Int,Int) -> [Int] -> [ (Int,Int) ]
 primeSums start ps = filter (myIsPrime . snd ) $ takeWhile ( (<1000000) . snd ) $ consecutiveSums start ps

A naive solution to the problem involves repeatedly calling primeSums on the tails of our list of primes:

 solve0 = maximum $ concat $ map (primeSums (0,0)) (tails myPrimes)

However, there are 78498 primes less than 1000000 and this will examine approximate 78498^2/2 sums which will take too long.

A better solution involves keeping track of the best solution found so far and using that to enforce the minimal size of any better solution. We can stop once the minimal size constraint forces the total of any better solution to be greater than 1000000.

Our loop will have this structure:

 loop :: [Int] -- current list of primes
 -> (Int,Int) -- best solution so far (n, total)
 -> (Int,Int) -- best solution

The idea is that loop ps b1 will compute a new best solution b2 and then call loop (tail ps) b2 which will compute a new best b3 and call loop (tail (tail ps)) b3 etc. The iteration will stop when either the primes list is exhausted or the above stopping condition holds.

An easy case:

 loop [] best = best -- prime list has been exhausted

We include this just to trace the execution of the function - it has no effect on the computation:

 loop (p:_) best | trace msg False = undefined
 where msg = "--- p = " ++ show p ++ " best: " ++ show best

The main definition is:

 loop ps best@(n,total) = 
 let (as, bs) = splitAt (n+1) ps -- better solution must have at least n+1 primes
 total0 = sum as
 in
 if total0 >= 1000000
 then best
 else let best' = maximum $ [best] ++ primeSums (n+1, total0) bs
 in
 loop (tail ps) best'

To kick everything off:

 solution = loop myPrimes (0,0)

which results in the followin output:

*Euler50> solution
--- p = 2 best: (0,0)
--- p = 3 best: (536,958577)
--- p = 5 best: (536,958577)
--- p = 7 best: (539,978037)
--- p = 11 best: (543,997651)
(543,997651)

So the longest sum begins at 7 and has length 543 and has sum 997651. Solving the problem only involves looking at sums which start from the first five primes.