I have the following function that convert a list of counts to a discrete probability density function:
freq2prob l = [ (curr / (sum l))) | curr <- l ]
Unfortunately (sum l) is computed for each of the l elements making the computational complexity unnecessarily high.
What is the most concise, elegant, "haskellic" way to deal with this?
It's simple:
freq2prob l = [ curr / s | let s = sum l, curr <- l ]
you can put it outside the list comprehension as well: freq2prob l = let s = sum l in [ curr / s | curr <- l ] (notice the in). This is effectively the same computation.
That is because the first is essentially translated into
freq2prob :: (Fractional a) => [a] -> [a]
freq2prob l = [ curr / s | let s = sum l, curr <- l ]
= do
let s = sum l
curr <- l
return (curr / s)
= let s=sum l in
l >>= (\curr -> [curr / s])
-- concatMap (\curr -> [curr / s]) l
-- map (\curr -> curr / s) l
and the second, obviously, to the same code,
freq2prob l = let s = sum l in [ curr / s | curr <- l ]
= let s = sum l in
do
curr <- l
return (curr / s)
= let s=sum l in
l >>= (\curr -> [curr / s])
We can use a let statement or a where clause for this:
freq2prob l = let s = sum l in
[ curr / s | curr <- l ]
or
freq2prob l = [ curr / s | curr <- l ]
where s = sum l
but it would be more idiomatic to use a higher order function than list comprehension, since you're doing the same thing to each element:
freq2prob l = map (/sum l) l
The sum l in the dividing function (/sum l) will only be evaluated once.
This is because when evaluating map f xs, the compiler doesn't make the elementary mistake of creating multiple copies of the function f to be evaluated separately; it's a thunk that will be pointed to by every occurrence where it's needed.
As a simple and blunt test, we can investigate crude timing stats in ghci for whether it's noticeably faster to use the same function repeatedly or slightly different function each time. First I'll check whether the results of sums are usually cached in ghci:
ghci> sum [2..10000000]
50000004999999
(8.31 secs, 1533723640 bytes)
ghci> sum [2..10000000]
50000004999999
(8.58 secs, 1816661888 bytes)
So you can see it wasn't cached, and that there's a little variance in these crude stats.
Now let's multiply by the same complicated thing every time:
ghci> map (* sum [2..10000000]) [1..10]
[50000004999999,100000009999998,150000014999997,200000019999996,250000024999995,300000029999994,350000034999993,400000039999992,450000044999991,500000049999990]
(8.30 secs, 1534499200 bytes)
So (including a little variance, it took almost exactly the same time to multiply ten numbers by sum [2..10000000] using map than multiplying a single one. Multiplying ten pairs of numbers takes hardly any time at all. So ghci (an interpreter, not even an optimising compiler) didn't introduce multiple copies of the same calculation.
This isn't because ghci is clever, it's because lazy evaluation, a nice feature of pure functional programming, never does more work than necessary. In a most programming languages it would be hard to optimise away passing a lengthy calculation around all over the place instead of saving its result in a variable.
Now let's compare that with doing a slightly different calculation each time, where we add up slightly fewer numbers as we go.
ghci> map (\x -> sum [x..10000000]) [1..10]
[50000005000000,50000004999999,50000004999997,50000004999994,50000004999990,50000004999985,50000004999979,50000004999972,50000004999964,50000004999955]
(77.98 secs, 16796207024 bytes)
Well, that took roughly ten times as long, as we expected, because now we're asking it to do a different thing every time. I can verify for you that this paused for each number, whereas when we didn't change the expensive-to-calculate number, it was only evaluated once, and the pause was before the first number and the rest appeared rapidly.
Related
I run out of memory trying to run moderate inputs such as this:
variation_models 15 25
also running higher numbers for ncars seems to make a huge difference in speed and memory usage.
The slowdown is expected (there are more things to compare), but the exponential increase of memory usage doesn't make sense to me
import Control.Monad
orderedq f [] = True
orderedq f (x:[]) = True
orderedq f (x:y:zs) = f x y && orderedq f (y:zs)
num_orderedq = orderedq (<=)
adds_up_to n xs = n == sum xs
both_conditions f g xs = f xs && g xs
variation_models ncars nlocations =
filter (both_conditions (adds_up_to nlocations) num_orderedq) $ replicateM ncars [1..nlocations-ncars+1]
What is causing the large difference in memory usage? replicateM?
I think you've seen elsewhere that your specific problem (creating ordered lists of integers that sum to a given number) is better solved using an alternative algorithm, rather than filtering a huge list of lists of integers.
However, getting back to your original issue, it is possible to construct an equivalent of:
replicateM p [1..n]
that runs in exponential time (of course) but constant space.
The problem is that this expression is more or less equivalent to the recursion:
badPower 0 _ = pure []
badPower p n = [x:xs | x <- [1..n], xs <- badPower (p-1) n]
So, in the list comprehension, for each selected x, the whole list badPower (p-1) n needs to be re-generated from the start. GHC, sensibly enough, decides to keep badPower (p-1) n around so it doesn't need to be recomputed each time. So, the badPower p n call needs the entire badPower (p-1) n list kept in memory, which already accounts for n^(p-1) elements and exponential memory use, even without considering badPower (p-2) n, etc.
If you just flip the order of the implicit loops around:
goodPower 0 _ = pure []
goodPower p n = [x:xs | xs <- goodPower (p-1) n, x <- [1..n]]
That fixes the problem. Even though the list goodPower (p-1) n is "big", we take it's first element, use it n times for each value of x and then can discard it and move to the next element. So, goodPower (p-1) n can be garbage collected as it's used.
Note that goodPower generates the elements in a different order than badPower, with the first coordinate of the lists varying fastest, instead of the last. (If this matters, you can map reverse $ goodPower .... While reverse is "slow", it's only being applied to short lists here.)
Anyway, the following program runs (practically) forever, but does so in constant space:
power :: Int -> [a] -> [[a]]
power 0 _ = [[]]
power p lst = [x:xs | xs <- power (p-1) lst, x <- lst ]
main = do
print $ length (power 15 [1..11])
replicateM :: Applicative m => Int -> m a -> m [a]
When 'm' is [], monad join implementation will make replicateM build all permutations of n elements from the list elements. The number of such permutations is written P(n,k), and is equal to n!/(n-k)!. This is where the exponential growth come from.
I wrote a solution for a very simple practice problem:
Calculate the number of grains of wheat on a chessboard given that the number on each square doubles. Write code that shows how many grains are on a given square, and the total number of grains on the chessboard.
The function must return a Maybe Integer and return Nothing if the input is less than 1 or greater than 64.
square :: Integer -> Maybe Integer
square n = if (n < 1 || n > 64) then Nothing else Just (2^(pred n))
total :: Integer
total = sum (fmap sum (map square [1..64]))
I tried to apply fmap sum to some test output of map square (list of Maybe Integer) in GHCI and was surprised to discover it returns the list of integers (sans Just) rather than their sum. So in the solution above I apply sum a second time to actually get the sum.
I would like to understand conceptually why this is the case: in other words why is sum behaving like a converter for Maybe Ints to Ints in this context instead of adding things?
I've solved some similar exercises relying on helper functions to avoid complications of doing computation on Maybe values, and perhaps in this case I should just calculate the value of total without utilizing square, i.e.:
total = sum [2^n | n <- [0..63]]
However since I'd already written a useful function my first instinct was to reuse it, which led to some unforeseen behavior.
Let's look at the type of sum:
sum :: (Foldable t, Num a) => t a -> a
Often, for a beginner, this is simplified by assuming that t ~ [], so that we instead use sum as
sum :: Num a => [a] -> a
If we try to use sum at this type in your example, we will get a type error, because you have a list of Maybe numbers, not a list of numbers. Instead you write fmap sum [Just 1], specializing sum and fmap to:
sum :: Maybe Integer -> Integer
fmap :: (Maybe Integer -> Integer) -> [Maybe Integer] -> [Integer]
So the question isn't really "why isn't sum adding things", so much as "how can sum have a meaningful definition when given a single Maybe Integer?"
One way to answer that question, if you're not familiar with how to interpret sum as working on Foldable or how Maybe is foldable, is to just try implementing it yourself. There's really only one reasonable implementation:
sum :: Maybe Integer -> Integer
sum Nothing = 0
sum (Just x) = x
Right? Someone asked you "what's the total of the numbers in here", and then gave you either zero or one number. Pretty easy to add up. That's exactly how sum works for Maybe, except that it goes through Foldable instead of being specialized to Maybe.
After this, of course it's easy: you've turned your [Maybe Integer] into an [Integer], and of course summing that gets you the sum of the non-Nothing entries.
Let's look at an example.
map square [0..2] = [Nothing, Just 1, Just 2]
fmap sum (map square [0..2]) = [sum Nothing, sum (Just 1), sum (Just 2)]
Since Maybe is a Foldable container, it makes sense to calculate the sum of its elements:
sum Nothing = 0
sum (Just a) = a
So
fmap sum (map square [0..2]) = [0, 1, 2]
Now I don't know what you were actually hoping to do with the Maybes, but this is why you got what you got.
One thing worth internalising; when you map a function over a list1, the result is always going to be a list with the same number of elements. The function will be applied to each element of the list individually; it cannot combine them into a single summary value. That's just not what fmap does.
So with that principle in mind, we know that fmap sum squares (where squares = map square [1..64]) cannot possibly result in the sum of squares. It's going to be [ sum (square 1), sum (square 2), ... , sum (square 64) ]. We will then need to apply sum again to that whole list, if we want to actually add them up.
That just leaves an explanation for what sum (square 1) etc is actually doing (i.e. what sum does when applied to Maybe values). The proper type for sum is sum :: (Foldable t, Num a) => t a -> a. Foldable is basically the type-class of structures that you can scan for 0 or more elements in order (essentially: those you can convert to a list). All sum does is add up the elements that are there, however many there are (and use 0 as a "starting value" in case there are no elements). Maybe has a Foldable instance; it always has 0 or 1 elements, and sum can add those up just as well as it can add up lists that happen to have only 0 or 1 elements.
Of course the effect of summing zero-or-one numbers is just that the result is 0 if there were zero inputs and equal the input number if there was one. + never actually gets called for this "sum", which makes it feel a little pointless. But sum didn't know that; it works for any Foldable, regardless of how many elements they contain. And Maybe didn't know that it would end up being used to "sum without actually adding"; it just implemented Foldable so that any other function that wants to scan a variable number of elements out of a structure can scan Maybes.
If you think it's silly, just don't use sum for that job; use fromMaybe 0 instead.
1 You can generalise this to other functors beyond lists; when you fmap a function over a data structure, the result will have exactly the same structure as the input. Only the "leaf nodes" will be different.
First of all, the fmap in
total = sum (fmap sum (map square [1..64]))
is just map:
total = sum ( map sum (map square [1..64]))
and the maps compose by composing their mapping functions,
total = sum ( map (sum . square) [1..64] )
and a map applies its function to each element of the list,
total = sum [sum (square x) | x <- [1..64] ]
while a composed function finds its result in steps,
total = sum [sum y | x <- [1..64], y <- [square x] ]
whereas the inner sum is working with the result of square, namely, a Maybe number,
total = sum [ n | x <- [1..64], Just n <- [square x] ]
= sum [ n | x <- [1..64], Just n <- list (square x) ]
where list y = [y]
and turning sum y into just n works because sum finds a sum and 0 is its identity, so adding a 0 is the same as not adding anything at all. Meaning, the Just n pattern match fails when square produces a Nothing (which in our case is never, but never mind that) so that x which causes it is skipped over.
total = sum [ n | x <- [1..64], n <- maybeToList (square x) ]
= sum [ n | x <- [1..64], n <- case (square x) of
Just n -> [n]
Nothing -> [] ]
But again, we know that this never happens, and all this repackaging of the same number is all for naught, so in the end your code is equivalent to
total = sum [ n | x <- [1..64], Just n <- [Just (2^(x-1))] ]
= sum [ n | x <- [1..64], n <- [ 2^(x-1) ] ]
= sum [ 2^(x-1) | x <- [1..64] ]
just as you intended.
Seeing is better than believing (well, remembering / imagining, which is needed when using higher order functions ... unless of course one has an eidetic memory so for them believing is seeing). It might even give us new ideas for further code simplification, some transformations, and, eventually, maybe even some computational optimizations:
total = sum [ 2^x | x <- [0..63] ]
= sum [ product (replicate x 2) | x <- [0..63] ]
= sum $ [ product (replicate 0 2) ]
++ [ product (replicate x 2) | x <- [1..63] ]
= sum $ [ product [] ]
++ [ 2 * product (replicate (x-1) 2) | x <- [1..63] ]
= sum $ [ 1 ]
++ [ 2 * product (replicate x 2) | x <- [0..62] ]
= sum [1] + sum ( [2*n0] ++
[ 2 * product (replicate x 2) | x <- [1..62] ] )
where { n0=1 }
= n0 + sum [n1] + sum( [2*n1] ++
[ 2 * product (replicate x 2) | x <- [2..62] ] )
where { n0=1 ; n1=2*n0 }
= n0 + n1 + n2 + sum( [2*n2] ++
[ 2 * product (replicate x 2) | x <- [3..62] ] )
where { n0=1 ; n1=2*n0 ; n2=2*n1 }
= ....
= sum . take 64 $ iterate (2*) 1
And there they are again, the 64 squares of the chess board, and the first single grain of rice, which is doubled, and doubled again, as we ago along the squares.
I run out of memory trying to run moderate inputs such as this:
variation_models 15 25
also running higher numbers for ncars seems to make a huge difference in speed and memory usage.
The slowdown is expected (there are more things to compare), but the exponential increase of memory usage doesn't make sense to me
import Control.Monad
orderedq f [] = True
orderedq f (x:[]) = True
orderedq f (x:y:zs) = f x y && orderedq f (y:zs)
num_orderedq = orderedq (<=)
adds_up_to n xs = n == sum xs
both_conditions f g xs = f xs && g xs
variation_models ncars nlocations =
filter (both_conditions (adds_up_to nlocations) num_orderedq) $ replicateM ncars [1..nlocations-ncars+1]
What is causing the large difference in memory usage? replicateM?
I think you've seen elsewhere that your specific problem (creating ordered lists of integers that sum to a given number) is better solved using an alternative algorithm, rather than filtering a huge list of lists of integers.
However, getting back to your original issue, it is possible to construct an equivalent of:
replicateM p [1..n]
that runs in exponential time (of course) but constant space.
The problem is that this expression is more or less equivalent to the recursion:
badPower 0 _ = pure []
badPower p n = [x:xs | x <- [1..n], xs <- badPower (p-1) n]
So, in the list comprehension, for each selected x, the whole list badPower (p-1) n needs to be re-generated from the start. GHC, sensibly enough, decides to keep badPower (p-1) n around so it doesn't need to be recomputed each time. So, the badPower p n call needs the entire badPower (p-1) n list kept in memory, which already accounts for n^(p-1) elements and exponential memory use, even without considering badPower (p-2) n, etc.
If you just flip the order of the implicit loops around:
goodPower 0 _ = pure []
goodPower p n = [x:xs | xs <- goodPower (p-1) n, x <- [1..n]]
That fixes the problem. Even though the list goodPower (p-1) n is "big", we take it's first element, use it n times for each value of x and then can discard it and move to the next element. So, goodPower (p-1) n can be garbage collected as it's used.
Note that goodPower generates the elements in a different order than badPower, with the first coordinate of the lists varying fastest, instead of the last. (If this matters, you can map reverse $ goodPower .... While reverse is "slow", it's only being applied to short lists here.)
Anyway, the following program runs (practically) forever, but does so in constant space:
power :: Int -> [a] -> [[a]]
power 0 _ = [[]]
power p lst = [x:xs | xs <- power (p-1) lst, x <- lst ]
main = do
print $ length (power 15 [1..11])
replicateM :: Applicative m => Int -> m a -> m [a]
When 'm' is [], monad join implementation will make replicateM build all permutations of n elements from the list elements. The number of such permutations is written P(n,k), and is equal to n!/(n-k)!. This is where the exponential growth come from.
I'm using Project Euler to learn Haskell. I'm new at Haskell and am having a lot of trouble coming up with an algorithm that doesn't take an absurd amount of time. I'm estimating that the program here would take 14 gigayears to arrive at the solution.
The problem:
Which prime, below one-million, can be written as the sum of the most
consecutive primes?
Here's my source. I've left out isPrime. I've posted it because it's far too inefficient to solve the problem. I think the issue lies with the slicedChains and primeChains calls, but I'm not sure what it is. I've resolved this before with C++. But for whatever reason, the efficient solution seems beyond me in Haskell.
Edit: I've included isPrime.
import System.Environment (getArgs)
import Data.List (nub,maximumBy)
import Data.Ord (comparing)
isPrime :: Integer -> Bool
isPrime 1 = False
isPrime 2 = True
isPrime x
| any (== 0) (fmap (x `mod`) [2..x-1]) = False
| otherwise = True
primeChain :: Integer -> [Integer]
primeChain x = [ n | n <- 1 : 2 : [3,5..x-1], isPrime n ]
slice :: [a] -> [Int] -> [a]
slice xs args = take (to - from + 1) (drop from xs)
where from = head args
to = last args
subsequencesOfSize :: Int -> [a] -> [[a]]
subsequencesOfSize n xs = let l = length xs
in if n>l then [] else subsequencesBySize xs !! (l-n)
where
subsequencesBySize [] = [[[]]]
subsequencesBySize (x:xs) = let next = subsequencesBySize xs
in zipWith (++) ([]:next) (map (map (x:)) next ++ [[]])
slicedChains :: Int -> [Integer] -> [[Integer]]
slicedChains len xs = nub [x | x <- fmap (xs `slice`) subseqs, length x > 1]
where subseqs = [x | x <- (subsequencesOfSize 2 [1..len]), (last x) > (head x)]
primeSums :: Integer -> [[Integer]]
primeSums x = filter (\ns -> sum ns == x) chain
where xs = primeChain x
len = length xs
chain = slicedChains len xs
compLength :: [[a]] -> [a]
compLength xs = maximumBy (comparing length) xs
cleanSums :: [Integer] -> [[Integer]]
cleanSums xs = fmap (compLength) filtered
where filtered = filter (not . null) (fmap primeSums xs)
main :: IO()
main = do
args <- getArgs
let arg = read (head args) :: Integer
let xs = primeChain arg
print $ maximumBy (comparing length) $ cleanSums xs
Your basic problem is that you are not pruning your search space based on the best solution you have found so far.
I can tell this just from the fact that you are using maximumBy to find the longest sequence.
For instance, if during your search your find a consecutive sequence of 4 primes whose sum is a prime < 10^6, you don't have to examine any sequence which begins with a prime greater than 250000.
To do this kind of pruning you have to keep track of the solution found so far and interleave the testing of candidate sequences with their generation so that the best solution found so far can stop the search early.
Update
There are several inefficiencies in slicedChains. Haskell lists are implemented a linked lists. This video is pretty good overview of linked lists and how they differ from arrays: (link)
The following expressions in your code are going to be problematic w.r.t. efficiency:
* nub has quadratic running time
* length x > 1 - the complexity of length is O(n) where n is the length of the list. A better way to write this is:
lengthGreaterThan1 :: [a] -> Bool
lengthGreaterThan1 (_:_:_) = True
lengthGreaterThan1 _ = False
* subsequencesOfSize 2 [1..len] may be more succinctly written:
[ [a,b] | a <- [1..len], b <- [a+1..len] ]
and this will also ensure that a < b.
* The take and drop calls in slice are also O(n)
* In primeSums the call to primeChain will regenerate essentially the same list over and over again resulting in a lot of multiple calls to isPrime. A better approach is to define primeChain like this:
allPrimes = filter isPrime [1..]
primeChain x = takeWhile (<= x) allPrimes
The list allPrimes will be generated once, and primeChain simply takes prefixes of that list.
* primeSums x is charged with finding sequences whose sum is exactly x, but it looks at a lot of sequences that can't possibly work. For instance, primeSums 31 will examine:
11 + 13 + 17, 11 + 13 + 17 + 23, 11 + 13 + 17 + 23 + 29,
17 + 19, 17 + 19 + 23, 17 + 19 + 23 + 29,
19 + 23, 19 + 23 + 29
23 + 29
even though it's pretty obvious that none of these sums could equal 31.
So the first thing you need is a good data structure: Once you find a sequence of length n you don't care about sequences of shorter length, so your primary needs are: (1) tracking the sum, (2) tracking the primes in the set, (3) removing the least element, (4) adding a new greatest element. The key is amortization, where a big cost is paid infrequently enough that you can pretend it is a small cost per procedure. The data structure looks like this:
data Queue x = Q [x] [x]
q_empty (Q [] []) = True
q_empty _ = False
q_headtails (Q (x:xs) rest) = (x, Q xs rest)
q_headtails (Q [] xs) = case reverse xs of y:ys -> (y, Q ys [])
[] -> error "End of queue."
q_append el (Q beg end) = Q beg (el:end)
So deconstructing the list is possible, but sometimes triggers an O(n) operation, but that's OK because when it does, we won't have to do it for another n steps, so it averages out to one operation per step. (You might also want to do it with a spine-strict list.)
To save on length operations and summing the items of the list you probably want to cache those, too:
type Length = Int
type Sum = Int
type Prime = Int
data PrimeSeq = PS Length Sum (Queue Prime)
headTails (PS len sum q) = (x, PS (len - 1) (sum - x) xs)
where (x, xs) = q_headtails q
append x (PS len sum xs) = PS (len + 1) (sum + x) (q_append x xs)
The algorithm for these looks like:
Cache a copy of the PrimeSeq you're starting with
Keep adding primes to it and testing primality until you get to 10^6.
If you find a new prime with a longer sequence, replace the cache.
Whenever you run into 10^6, revert to the cache, pull a prime off the front of the queue, then repeat as needed.
Your prime generation is quadratic (isPrime 101 tests rem 101 100 == 0 even though 10 is the biggest number by which 101 needs to be tested -- and actually 7 is enough).
Yet even with it, a simple enough list-based code finds the answer in under 2 seconds (on an Intel Core i7 2.5 GHz, interpreted in GHCi). And with the code corrected to take advantage of the above mentioned optimization (and additionally, testing by primes only), it takes 0.1s.
Also, f x | t = False | otherwise = True is the same as f x = not t.
We are asked by the PE site not to give you even a hint.
But in general, the key to efficiency in Haskell, thanks to its laziness, is being generative with as small a duplication of effort as possible. As one example, instead of calculating each slice of a list in isolation starting anew, we can produce the bunch of them together as part of one process,
slices :: Int -> [a] -> [[a]]
slices n = map (take n) . iterate tail -- sequence of list's slices of length n each
Another principle is, try to solve a more general problem, of which yours is an instance.
Having written such a function, we can play with it by trying out different values for its parameters, from smaller to the bigger ones, for an exploratory style of problem solving. We're told about 21 consecutive primes. What about 22 of them? 27? 1127 of them? ... and I've said enough about this already.
If it starts taking too much time, we can assess the full solution's needed run time by empirical orders of growth analysis.
Though the solution is found quickly enough with your unoptimized isPrime code, the exploratory process can be prohibitively slow with it, but it is fast enough with the optimized code:
primes :: [Int]
primes = 2 : filter isPrime [3,5..]
isPrime n = and [rem n p > 0 | p <- takeWhile ((<= n).(^2)) primes]
I am trying to do problem 254 in project euler and arrived at this set of functions and refactor in Haskell:
f n = sum $ map fac (decToList n)
sf n = sum $ decToList (f n)
g i = head [ n | n <- [1..], sf n == i]
sg i = sum $ decToList (g i)
answer = sum [ sg i | i <- [1 .. 150] ]
Where:
f (n) finds the sum of the factorials of each digit in n
sf (n) is the sum of the digits in the result of f (n)
g (i) is the smallest integer solution for sf (i). As there can be many results for sf (i)
sg (i) is the sum of the digits in the result of g (i)
But not long into running the compiled version of this script, it sucked up all my RAM. Is there a better way to implement the function g (i)? If so what can they be and how could I go about it?
EDIT:
Just out of clarity, my functions for:
fac is :
`fac 0 = 1`
`fac n = n * fac (n-1)`
decToList which makes a number into a list:
decToList1 x = reverse $ decToList' x
where
decToList' 0 = []
decToList' y = let (a,b) = quotRem y 10 in [b] ++ decToList' a
Although I did since update them to Yairchu's solution for optimisation sake.
The memory problem might lie in decToList or fac.
I ran it with
fac = product . enumFromTo 1
decToList = map (read . return) . show
main = print answer
And it didn't come near to sucking all my RAM, it did not finish, though.
btw: I suspect an advanced project Euler problem to be harder than that. therefore this algorithm won't do.