Functor Design Pattern in Haskell - haskell

I apologize for not coming up with a good title for this question. I'm having some trouble expressing what I need. I have a simple problem in Haskell and I am wondering what the best approach is to solve it.
Let's say I have a list of numbers: [-3,2,1,2]. I want to return the value with the highest absolute value. That is, I want to return -3. So I want:
f = maximum . map abs
The problem is, of course, that this returns the calculated value (3) and not the original value (-3).
I could figure out a way of doing this, maybe mapping the original list to a tuple of (originalValue, calculatdValue), finding the tuple whose snd is returned by my function (maximum) and then return fst of that tuple.
But this seems like a lot of "plumbing" for a simple problem like this, and I wonder if there is some abstraction I'm missing that solves this. That is, there is this generally procedure I do all the time, and I want some way of neatly doing it:
I want to take a list of items.
I want to map them to a certain value (let's say the absolute value)
Then I want to select one based on some criteria (let's say I want the maximum or maybe the minimum).
But then I want to return the original value. (If the list was [-3,2,1,2] and I want to return the value with the highest abs, then I would return -3).
Is there a library function for this? Is there a functor or a monad for this?
I think I want a function with the signature:
f :: ([b] -> b) -> (a -> b) -> [a] -> a
i.e.
f maximum abs [-3,2,1,2]
This feels very "functory" to me or maybe "monadic".

Use maximumBy which takes a comparison function. You can then pass some function that compares the way you want.
maximumBy (compare `on` abs)

Stop...hoogle time!
So you've got a list of stuff [a]. And you want to end up with just one of those a. You also want to compare elements of this list in some special way (not their natural ordering), in order to determine which comes first. This is the tricky part, but you should be able to see that what I've described is a function of the form a -> a -> Ordering.
Put it all together:
(a -> a -> Ordering) -> [a] -> a
And hoogle it. maximumBy and minimumBy are the first hits :) Hoogle can be a powerful asset when you learn to use it. (See augustss's answer for details on how to use maximumBy in this case)

Another way to do it, if the conversion is a bit expensive:
maximumWith :: (Ord b) => (a -> b) -> [a] -> a
maximumWith f = snd . maximumBy (compare `on` fst) . map (f &&& id)
This type is similar to GHC.Exts's sortWith, which gives us another way to do it:
maximumWith :: (Ord b) => (a -> b) -> [a] -> a
maximumWith f = head . sortWith (Down . f)
We can define a minimumWith similarly:
minimumWith :: (Ord b) => (a -> b) -> [a] -> a
minimumWith f = head . sortWith f
A look at the source for sortWith reveals that it's implemented by sortBy, so it lacks the caching that the first definition for maximumWith had.
This, obviously calls for some benchmarking:
module Main where
import Control.Arrow ((&&&))
import Data.List (sortBy)
import Data.Function (on)
import GHC.Exts (sortWith)
import Criterion.Main
sortWith :: (Ord b) => (a -> b) -> [a] -> [a]
sortWith f = map snd . sortBy (compare `on` fst) . map (f &&& id)
badFib :: Int -> Int
badFib 0 = 1
badFib 1 = 1
badFib n = badFib (n - 1) + badFib (n - 2)
main = defaultMain [ bench "GHC.Exts.sortWith" $ nf (GHC.Exts.sortWith badFib) [0..20]
, bench "Main.sortWith" $ nf (Main.sortWith badFib) [0..20]
]
The results on my laptop:
benchmarking GHC.Exts.sortWith
collecting 100 samples, 12 iterations each, in estimated 1.504415 s
bootstrapping with 100000 resamples
mean: 1.264608 ms, lb 1.260519 ms, ub 1.270248 ms, ci 0.950
std dev: 24.42169 us, lb 19.21734 us, ub 31.50275 us, ci 0.950
found 8 outliers among 100 samples (8.0%)
5 (5.0%) high mild
3 (3.0%) high severe
variance introduced by outliers: 0.996%
variance is unaffected by outliers
benchmarking Main.sortWith
collecting 100 samples, 50 iterations each, in estimated 1.516733 s
bootstrapping with 100000 resamples
mean: 305.9089 us, lb 304.0602 us, ub 310.9257 us, ci 0.950
std dev: 14.41005 us, lb 6.680240 us, ub 30.26940 us, ci 0.950
found 18 outliers among 100 samples (18.0%)
9 (9.0%) high mild
9 (9.0%) high severe
variance introduced by outliers: 0.999%
variance is unaffected by outliers

If you are trying to have something ordered and compared by a projection always, rather than just at a specific usage (in which case see augustss's answer), then use a newtype wrapper:
newtype AbsInt = AbsInt Int
instance Eq AbsInt where
AbsInt x == AbsInt y = abs x == abs y
instance Ord AbsInt where
compare (AbsInt x) (AbsInt y) = compare x y
Now, for example:
maximum [AbsInt 1, AbsInt 10, AbsInt (-50)] = AbsInt (-50)
Presumably you would be working with AbsInt as your objects of study, so you wouldn't be writing those AbsInts everywhere.
The more operations you need on AbsInt, the more boilerplate you need. However if you just want to "pass through" some instances, GHC has an extension GeneralizedNewtypeDeriving that allows that; eg.:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
newtype AbsInt = AbsInt Int
deriving (Num)
Now AbsInt behaves like an Int with regard to arithmetic, but (given the instances above) by absolute values with regard to comparison. Also note that the Num instance gives you the ability to use literals, so:
(maximum [1,2,-3] :: AbsInt) = AbsInt (-3)

I believe something along the lines of the following should work.
foldl abs_max (head xs) xs
where abs_max x y = if (abs x) > (abs y) then x else y
Looking beyond the task at hand you could generalize it by abstracting out the comparison function and passing it in later.

Here is something I cooked up. It's kind of meh, because it requires (Eq b)
selectOn :: (Eq b) => ([b] -> b) -> (a -> b) -> [a] -> a
selectOn reducer f list = head $ filter (\x -> f(x) == k ) list
where k = reducer $ map f list
And then:
selectOn maximum abs [1,2,-3]
Or:
selectOn sum id [-3, 0, 3]
I guess I can generalize compare on and get the exact same effect.

Related

Using recursion schemes in Haskell for solving change making problem

I'm trying to understand histomorphisms from this blog on recursion schemes. I'm facing a problem when I'm running the example to solve the change making problem as mentioned in the blog.
Change making problem takes the denominations for a currency and tries to find the minimum number of coins required to create a given sum of money. The code below is taken from the blog and should compute the answer.
{-# LANGUAGE DeriveFunctor #-}
module Main where
import Control.Arrow ( (>>>) )
import Data.List ( partition )
import Prelude hiding (lookup)
newtype Term f = In {out :: f (Term f)}
data Attr f a = Attr
{ attribute :: a
, hole :: f (Attr f a)
}
type CVAlgebra f a = f (Attr f a) -> a
histo :: Functor f => CVAlgebra f a -> Term f -> a
histo h = out >>> fmap worker >>> h
where
worker t = Attr (histo h t) (fmap worker (out t))
type Cent = Int
coins :: [Cent]
coins = [50, 25, 10, 5, 1]
data Nat a
= Zero
| Next a
deriving (Functor)
-- Convert from a natural number to its foldable equivalent, and vice versa.
expand :: Int -> Term Nat
expand 0 = In Zero
expand n = In (Next (expand (n - 1)))
compress :: Nat (Attr Nat a) -> Int
compress Zero = 0
compress (Next (Attr _ x)) = 1 + compress x
change :: Cent -> Int
change amt = histo go (expand amt)
where
go :: Nat (Attr Nat Int) -> Int
go Zero = 1
go curr#(Next attr) =
let given = compress curr
validCoins = filter (<= given) coins
remaining = map (given -) validCoins
(zeroes, toProcess) = partition (== 0) remaining
results = sum (map (lookup attr) toProcess)
in length zeroes + results
lookup :: Attr Nat a -> Int -> a
lookup cache 0 = attribute cache
lookup cache n = lookup inner (n - 1) where (Next inner) = hole cache
Now if you evaluate change 10 it will give you 3.
Which is... incorrect because you can make 10 using 1 coin of value 10.
So I considered maybe it's solving the coin change problem, which finds the maximum number of ways in which you can make the given sum of money. For e.g. you can make 10 in 4 ways with { 1, 1, ... 10 times }, { 1, 1, 1, 1, 5}, { 5, 5 }, { 10 }.
So what is wrong with this piece of code? Where is it going wrong in solving the problem?
TLDR
The above piece of code from this blog on recursion schemes is not finding minimum or maximum ways to change a sum of money. Why is it not working?
I put some more thought into encoding this problem with recursion schemes. Maybe there's a good way to solve the unordered problem (i.e., considering 5c + 1c to be different from 1c + 5c) using a histomorphism to cache the undirected recursive calls, but I don't know what it is. Instead, I looked for a way to use recursion schemes to implement the dynamic-programming algorithm, where the search tree is probed in a specific order so that you're sure you never visit any node more than once.
The tool that I used is the hylomorphism, which comes up a bit later in the article series you're reading. It composes an unfold (anamorphism) with a fold (catamorphism). A hylomorphism uses ana to build up an intermediate structure, and then cata to tear it down into a final result. In this case, the intermediate structure I used describes a subproblem. It has two constructors: either the subproblem is solved already, or there is some amount of money left to make change for, and a pool of coin denominations to use:
data ChangePuzzle a = Solved Int
| Pending {spend, forget :: a}
deriving Functor
type Cent = Int
type ChangePuzzleArgs = ([Cent], Cent)
We need a coalgebra that turns a single problem into subproblems:
divide :: Coalgebra ChangePuzzle ChangePuzzleArgs
divide (_, 0) = Solved 1
divide ([], _) = Solved 0
divide (coins#(x:xs), n) | n < 0 = Solved 0
| otherwise = Pending (coins, n - x) (xs, n)
I hope the first three cases are obvious. The last case is the only one with multiple subproblems. We can either use one coin of the first listed denomination, and continue to make change for that smaller amount, or we can leave the amount the same but reduce the list of coin denominations we're willing to use.
The algebra for combining subproblem results is much simpler: we simply add them up.
conquer :: Algebra ChangePuzzle Int
conquer (Solved n) = n
conquer (Pending a b) = a + b
I originally tried to write conquer = sum (with the appropriate Foldable instance), but this is incorrect. We're not summing up the a types in the subproblem; rather, all the interesting values are in the Int field of the Solved constructor, and sum doesn't look at those because they're not of type a.
Finally, we let recursion schemes do the actual recursion for us with a simple hylo call:
waysToMakeChange :: ChangePuzzleArgs -> Int
waysToMakeChange = hylo conquer divide
And we can confirm it works in GHCI:
*Main> waysToMakeChange (coins, 10)
4
*Main> waysToMakeChange (coins, 100)
292
Whether you think this is worth the effort is up to you. Recursion schemes have saved us very little work here, as this problem is easy to solve by hand. But you may find reifying the intermediate states makes the recursive structure explicit, instead of implicit in the call graph. Anyway it's an interesting exercise if you want to practice recursion schemes in preparation for more complicated tasks.
The full, working file is included below for convenience.
{-# LANGUAGE DeriveFunctor #-}
import Control.Arrow ( (>>>), (<<<) )
newtype Term f = In {out :: f (Term f)}
type Algebra f a = f a -> a
type Coalgebra f a = a -> f a
cata :: (Functor f) => Algebra f a -> Term f -> a
cata fn = out >>> fmap (cata fn) >>> fn
ana :: (Functor f) => Coalgebra f a -> a -> Term f
ana f = In <<< fmap (ana f) <<< f
hylo :: Functor f => Algebra f b -> Coalgebra f a -> a -> b
hylo alg coalg = ana coalg >>> cata alg
data ChangePuzzle a = Solved Int
| Pending {spend, forget :: a}
deriving Functor
type Cent = Int
type ChangePuzzleArgs = ([Cent], Cent)
coins :: [Cent]
coins = [50, 25, 10, 5, 1]
divide :: Coalgebra ChangePuzzle ChangePuzzleArgs
divide (_, 0) = Solved 1
divide ([], _) = Solved 0
divide (coins#(x:xs), n) | n < 0 = Solved 0
| otherwise = Pending (coins, n - x) (xs, n)
conquer :: Algebra ChangePuzzle Int
conquer (Solved n) = n
conquer (Pending a b) = a + b
waysToMakeChange :: ChangePuzzleArgs -> Int
waysToMakeChange = hylo conquer divide
The initial confusion with the blog post was because it was pointing to a different problem in the wikipedia link.
Retaking a look at change, it's trying to find the number of "ordered" ways of making change for a given value. This means that the ordering of coins matters. The correct value of change 10 should be 9.
Coming back to the problem, the main issue is with the implementation of the lookup method. The key point to note is that lookup is backwards i.e to calculate the contribution of a denomination to the sum it should be passed as argument to the lookup and not it's difference with the given value.
-- to find contribution of 5 to the number of ways we can
-- change 15. We should pass the cache of 15 and 5 as the
-- parameters. So the cache will be unrolled 5 times to
-- to get the value from cache of 10
lookup :: Attr Nat a -- ^ cache
-> Int -- ^ how much to roll back
-> a
lookup cache 1 = attribute cache
lookup cache n = lookup inner (n - 1) where (Next inner) = hole cache
The complete solution is described in this issue by #howsiwei.
Edit: Base on discussion in the comments this can be solved using histomorphisms but with a few challenges
It can be solved using histomorphisms but the cache and functor types will need to be more complex to hold more state. Namely -
The cache will need to keep a list of permitted denominations for a particular amount this will allow us eliminate overlap
The harder challenge is to come up with a functor that can order all the information. Nat will not be sufficient because it cannot distinguish between different values of a complex cache type.
I see two problems with this program. One of them I know how to fix, but the other apparently requires more knowledge of recursion schemes than I have.
The one I can fix is that it's looking up the wrong values in its cache. When given = 10, of course validCoins = [10,5,1], and so we find (zeroes, toProcess) = ([0], [5,9]). So far so good: we can give a dime directly, or give a nickel and then make change for the remaining five cents, or we can give a penny and change the remaining nine cents. But then when we write lookup 9 attr, we're saying "look 9 steps in history to when curr = 1", where what we meant was "look 1 step into history to when curr = 9". As a result we drastically undercount in pretty much all cases: even change 100 is only 16, while a Google search claims the right result is 292 (I haven't verified this today by implementing it myself).
There are a few equivalent ways to fix this; the smallest diff would be to replace
results = sum (map (lookup attr)) toProcess)
with
results = sum (map (lookup attr . (given -)) toProcess)
The second problem is: the values in the cache are wrong. As I mentioned in a comment on the question, this counts different orderings of the same denominations as separate answers to the question. After I fix the first problem, the lowest input where this second problem manifests is 7, with the incorrect result change 7 = 3. If you try change 100 I don't know how long it takes to compute: much longer than it should, probably a very long time. But even a modest value like change 30 yields a number that's much larger than it should be.
I don't see a way to fix this without a substantial algorithm rework. Traditional dynamic-programming solutions to this problem involve producing the solutions in a specific order so you can avoid double-counting. i.e., they first decide how many dimes to use (here, 0 or 1), then compute how to make change for the remaining amounts without using any dimes. I don't know how to work that idea in here - your cache key would need to be larger, including both the target amount and also the allowed set of coins.

What is the connection between primitive recursion and catamorphisms?

Using the following catamorphism for natural numbers I can implement various arithmetic algorithms whithout having to deal with recursion:
cataNat :: b -> (b -> b) -> Natural -> b
cataNat zero succ = go
where
go n = if (n <= 0) then zero else succ (go (n - 1))
fib :: Natural -> Natural
fib = fst . cataNat (0, 1) (\(a, b) -> (b, a + b))
cataNat looks similar to primitive recursion to me. At least each application of it seems garuanteed to terminate, no matter which combination of zero and succ is provided. With each iteration the overall problem is decomposed by the smallest/simplest problem instance. So even if it is technically not primitive recursion it seems to be equally expressive. If this is true it would mean that a catamorphism is not enough to express general recursion. We would probably need a hylomorphism for that. Is my reasoning correct, that is, does the equivalence hold for any type of catamorphism, not just for natural numbers?
Primitive recursion corresponds directly to a paramorphism.
You're correct that a catamorphism has equivalent theoretical power to a paramorphism, but they can be different in important ways in operational terms. For an example, let's go to lists instead of Nats.
cata :: b -> (a -> b -> b) -> [a] -> b
cata = flip foldr -- I'm lazy, but this argument order makes a bit more sense for this example
para :: b -> (a -> [a] -> b -> b) -> [a] -> b
para z _ [] = z
para z f (x:xs) = f x xs (para z f xs)
-- Removes the first element from the list which is equal to the other argument
delete1 :: Eq a => a -> [a] -> [a]
delete1 x xs = cata (const []) (\el k found -> if not found && el == x then k True else el : k found) xs False
-- Removes the first element from the list which is equal to the other argument
delete2 :: Eq a => a -> [a] -> [a]
delete2 x xs = para [] (\el raw processed -> if el == x then raw else el : processed) xs
Look at how awkward delete1 is, compared to delete2. Not only do you have to contort your logic by making the result of cata a function, but there's a very real operational cost, too. You have to traverse everything in the list after finding a matching element, and re-create all the (:) constructors. That can have a noticeable cost in efficiency. In comparison, delete2, when it finds the target element, can just use the existing tail of the list for the remainder, without even looking at it. Of course, most uses of foldr (real world, not this example) don't produce a function and don't want access to the unprocessed tail of the list. For them, the catamorphism is going to be slightly more efficient simply because of passing around less data.
So in terms of theoretical power, they're equivalent. In operational terms, each has a use, though catamorphisms are a lot more common.
For some expansion of the idea in more general terms, see the recursion-schemes library. It uses a rather different-looking formulation of the idea so that it can abstract over data types with different shapes, instead of needing a different type for cata/para for each data type they can be applied to. But it really is just an alternate way of packing up the same ideas, and other kinds of morphisms are covered as well, including much more niche (or even possibly useless) ones.

Apply map, but only for temporary use

Given a function:
func :: [Int] -> Int
func x = minimum (map (+5) x)
And an input: func [1,10].
I'm trying to get the output 1, as 1+5 is lower than 1+10, however, I can only work out how to output the value after the mapping function has been applied, whereas I only want the mapping to apply to my minimum usage and the output to be one of the original inputs.
How can I use a map temporarily, until I've found what I wanted, then return the pre-mapped version of that value?
There are several ways, but the best is probably to use Data.List.minimumBy. It takes a function that can compare two elements, then finds the smallest element using that comparison function. It's pretty much purpose built for your situation. It's type is
> :type minimumBy
minimumBy :: (a -> a -> Ordering) -> [a] -> a
Where
> :info Ordering
data Ordering = LT | EQ | GT -- Defined in 'GHC.Types'
-- A bunch of instances that don't really matter here
so Ordering is just a basic sum type with three no-argument constructors. Their names are pretty self explanatory, so all you need to do is pass it a function that returns one of these values:
comparer :: Int -> Int -> Ordering
comparer x y = ...
I'll leave the implementation to you. You can then use it as
func x = minimumBy comparer x
Or simply
func = minimumBy comparer
use minimumBy (comparing f) (where f would be (+5) for your example)
minimumBy :: (a -> a -> Ordering) -> [a] -> a
comparing :: Ord a => (b -> a) -> b -> b -> Ordering
An option is to use a custom comparison function and minimumBy, as other commented. Note that in this case your transformation (+5) will be called twice for each element in the list (roughly). E.g.
[4,3,2,1]
leads to
compare 4 3 => compare (4+5) (3+5) => compare 9 8 => GT
compare 3 2 => compare (3+5) (2+5) => compare 8 7 => GT
compare 2 1 => compare (2+5) (1+5) => compare 8 7 => GT
Note that (3+5),(2+5) are computed twice, above.
If the operation is expensive, and simply (+5) it may be beneficial to resort to a different approach. We can pre-compute the modified values while keeping the original ones if we build a list of pairs:
map (\x -> (expensive x, x)) [4,3,2,1]
Above, function expensive plays the role of (+5) in the original code. We can then take the minimum as follows:
snd $ minimumBy (comparing fst) $ map (\x -> (expensive x, x)) [4,3,2,1]
or even
snd $ minimum $ map (\x -> (expensive x, x)) [4,3,2,1]
The latter is slightly less general in that it requires that the list [4,3,2,1] is made of comparable elements, while the former only assumes that expensive produces something comparable.
However, note that the latter will not just return a random element of the list [4,3,2,1] which minimizes expensive, but it will be the minimum such element. That is, when expensive x == expensive y, the minimum function will break the tie comparing x and y directly. The former makes no such guarantee.

Directly generating specific subsets of a powerset?

Haskell's expressiveness enables us to rather easily define a powerset function:
import Control.Monad (filterM)
powerset :: [a] -> [[a]]
powerset = filterM (const [True, False])
To be able to perform my task it is crucial for said powerset to be sorted by a specific function, so my implementation kind of looks like this:
import Data.List (sortBy)
import Data.Ord (comparing)
powersetBy :: Ord b => ([a] -> b) -> [a] -> [[a]]
powersetBy f = sortBy (comparing f) . powerset
Now my question is whether there is a way to only generate a subset of the powerset given a specific start and endpoint, where f(start) < f(end) and |start| < |end|. For example, my parameter is a list of integers ([1,2,3,4,5]) and they are sorted by their sum. Now I want to extract only the subsets in a given range, lets say 3 to 7. One way to achieve this would be to filter the powerset to only include my range but this seems (and is) ineffective when dealing with larger subsets:
badFunction :: Ord b => b -> b -> ([a] -> b) -> [a] -> [[a]]
badFunction start end f = filter (\x -> f x >= start && f x <= end) . powersetBy f
badFunction 3 7 sum [1,2,3,4,5] produces [[1,2],[3],[1,3],[4],[1,4],[2,3],[5],[1,2,3],[1,5],[2,4],[1,2,4],[2,5],[3,4]].
Now my question is whether there is a way to generate this list directly, without having to generate all 2^n subsets first, since it will improve performance drastically by not having to check all elements but rather generating them "on the fly".
If you want to allow for completely general ordering-functions, then there can't be a way around checking all elements of the powerset. (After all, how would you know the isn't a special clause built in that gives, say, the particular set [6,8,34,42] a completely different ranking from its neighbours?)
However, you could make the algorithm already drastically faster by
Only sorting after filtering: sorting is O (n · log n), so you want keep n low here; for the O (n) filtering step it matters less. (And anyway, number of elements doesn't change through sorting.)
Apply the ordering-function only once to each subset.
So
import Control.Arrow ((&&&))
lessBadFunction :: Ord b => (b,b) -> ([a]->b) -> [a] -> [[a]]
lessBadFunction (start,end) f
= map snd . sortBy (comparing fst)
. filter (\(k,_) -> k>=start && k<=end)
. map (f &&& id)
. powerset
Basically, let's face it, powersets of anything but a very small basis are infeasible. The particular application “sum in a certain range” is pretty much a packaging problem; there are quite efficient ways to do that kind of thing, but you'll have to give up the idea of perfect generality and of quantification over general subsets.
Since your problem is essentially a constraint satisfaction problem, using an external SMT solver might be the better alternative here; assuming you can afford the extra IO in the type and the need for such a solver to be installed. The SBV library allows construction of such problems. Here's one encoding:
import Data.SBV
-- c is the cost type
-- e is the element type
pick :: (Num e, SymWord e, SymWord c) => c -> c -> ([SBV e] -> SBV c) -> [e] -> IO [[e]]
pick begin end cost xs = do
solutions <- allSat constraints
return $ map extract $ extractModels solutions
where extract ts = [x | (t, x) <- zip ts xs, t]
constraints = do tags <- mapM (const free_) xs
let tagged = zip tags xs
finalCost = cost [ite t (literal x) 0 | (t, x) <- tagged]
solve [finalCost .>= literal begin, finalCost .<= literal end]
test :: IO [[Integer]]
test = pick 3 7 sum [1,2,3,4,5]
We get:
Main> test
[[1,2],[1,3],[1,2,3],[1,4],[1,2,4],[1,5],[2,5],[2,3],[2,4],[3,4],[3],[4],[5]]
For large lists, this technique will beat out generating all subsets and filtering; assuming the cost function generates reasonable constraints. (Addition will be typically OK, if you've multiplications, the backend solver will have a harder time.)
(As a side note, you should never use filterM (const [True, False]) to generate power-sets to start with! While that expression is cute and fun, it is extremely inefficient!)

Haskell: turning a non-infinite list into an infinite one + laziness (euler 391)

I've written the following Haskell code to produce a list where the nth element is the number of 1s in writing 1..n as binary numbers (it's related to euler 391, incidentally):
buildList :: a -> (a -> a) -> [a]
buildList start f = start : buildList (f start) f
differences :: [[Int]]
differences = buildList [0] (\x -> x ++ map (+1) x)
sequenceK' :: Int -> [Int]
sequenceK' n = tail $ scanl (+) 0 (last $ take n differences)
which results in sequenceK' n giving a list of 2^(n-1) elements.
This question has two parts:
a) Why does the time taken to compute head $ sequenceK' n increase with n? -- due to ghc's laziness, I would expect the time to remain more or less constant.
b) Is it possible to define an infinite version of this list so that I can do things like take and takeWhile without having to worry about the value of the parameter passed to sequenceK'?
a) Because you're calling last $ take n differences, which has to do more work the bigger n is.
b) Yep, it's possible. The least-thinking solution is to just take the earliest element we see at each particular depth:
*Main> take 20 . map head . transpose $ differences
[0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3]
The better solution is to generate only the meaningful bits. We can do this by observing the following equality:
differences' = 1 : (differences' >>= \x -> [x, x+1])
Actually, this is slightly off, as you can probably guess:
*Main> take 20 differences'
[1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3]
But it's easily fixed by just tacking a 0 on front.

Resources