-
-
Save jml/cdb20d02cf1195c03f72 to your computer and use it in GitHub Desktop.
parts s = do | |
a <- [1..s-1] | |
b <- [1..s-a] | |
c <- [1..s-a-b] | |
d <- [1..s-a-b-c] | |
return [a, b, c, d] |
parts' :: (Integral a, Show a, Read a) => a -> [[a]]
parts' s = do
a <- f 1
b <- f . sum $ [a]
c <- f . sum $ [a, b]
d <- f . sum $ [a, b, c]
return [a, b, c, d]
where
f x = [1..s-x]
Here's a solution as a monadic unfold, in both fixed-length and unrestricted-length versions:
-- All sequences of n positive numbers summing to at most s.
partsOf :: (Enum s, Num s, Num n, Ord n) => n -> s -> [[s]]
n `partsOf` s = unfoldM step (n,s)
where step (n,s)
| 0 < n = [Just (s', (n-1,s-s')) | s' <- [1..s]]
| otherwise = [Nothing]
-- All sequences of positive numbers summing to at most s.
allPartsOf :: (Enum s, Num s, Ord s) => s -> [[s]]
allPartsOf s = unfoldM step s
where step s
| 0 < s = [Just (s', s-s') | s' <- [1..s]]
| otherwise = [Nothing]
ghci> 5 `partsOf` 5
[[1,1,1,1,1]]
ghci> 3 `partsOf` 5
[[1,1,1],[1,1,2],[1,1,3],[1,2,1],[1,2,2],[1,3,1],[2,1,1],[2,1,2],[2,2,1],[3,1,1]]
ghci> 1 `partsOf` 5
[[1],[2],[3],[4],[5]]
ghci> allPartsOf 4
[[1,1,1,1],[1,1,2],[1,2,1],[1,3],[2,1,1],[2,2],[3,1],[4]]
You can get unfoldM
from monad-extras, or you can derive it from unfoldr
like this:
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
unfoldr f b = next $ f b
where
next (Just (a, b')) = (a:) (next $ f b')
next Nothing = []
unfoldM :: Monad m => (b -> m (Maybe (a, b))) -> b -> m [a]
unfoldM f b = next =<< f b
where
next (Just (a, b')) = (a:) <$> (next =<< f b')
next Nothing = pure []
(I think this derivation of unfoldM
is quite cool: if you start with the right applicative-style definition of unfoldr
, you can get the monadic version of it with no changes to the body except for adjusting function applications and values to their lifted versions, where the types demand it.)
unfoldM
is the one from monad-extras, not from monad-loops. I just spent 15 minutes scratching my head trying to figure out how this could possibly work before checking hoogle a second time :)
That's right: the unfoldM
in monad-extras is the one that's a monadic version of unfoldr
.
The unfoldM
in monad-loops is more like a monadic, terminating repeat
. Perhaps a better name for it would have been repeatMaybeM?
Alright, here's my attempt at explaining the intuition behind the unfoldM
-based solution above, with a detour into unfoldr
too, as a mini-tutorial.
(This assumes some existing familiarity with the []
functor.)
1. Almost a solution: sequence
Observe that whenever you have this pattern:
do
a <- foo
b <- bar
c <- baz
...
return [a, b, c, ...]
then you can simplify it to the following if the expressions are independent:
sequence [foo, bar, baz, ...]
This is tantalizingly close to a solution for the puzzle: if we could define the right expressions for each element, and control the list's length, then we would have our solution.
The idea of controlling the length of a sequence
is close to what replicateM
does:
ghci> replicateM 3 [0..1] -- sequence [[0..1],[0..1],[0..1]]
[[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
ghci> replicateM 2 [0..1] -- sequence [[0..1],[0..1]]
[[0,0],[0,1],[1,0],[1,1]]
ghci> replicateM 1 [0..1] -- sequence [[0..1]]
[[0],[1]]
ghci> replicateM 0 [0..1] -- sequence []
[[]]
However, replicateM
only replicates identical copies of the same element, as the name suggests.
Can we fix the length like replicateM
, but vary the elements?
One approach we can try is to generate lists of the desired length, with elements close to the shape of the puzzle:
-- A list of length n, shaped like [[1..n],[1..n-1],...,[1..1]]
staircase :: (Enum n, Num n) => n -> [[n]]
staircase n =[[1..s] | s <- reverse [1..n]]
ghci> staircase 4
[[1,2,3,4],[1,2,3],[1,2],[1]]
ghci> staircase 3
[[1,2,3],[1,2],[1]]
We can sequence
these:
ghci> sequence (staircase 4) -- sequence [[1,2,3,4],[1,2,3],[1,2],[1]]
[[1,1,1,1],[1,1,2,1],[1,2,1,1],[1,2,2,1],[1,3,1,1],[1,3,2,1],[2,1,1,1],[2,1,2,1],[2,2,1,1],[2,2,2,1],[2,3,1,1],[2,3,2,1]
,[3,1,1,1],[3,1,2,1],[3,2,1,1],[3,2,2,1],[3,3,1,1],[3,3,2,1],[4,1,1,1],[4,1,2,1],[4,2,1,1],[4,2,2,1],[4,3,1,1],[4,3,2,1]]
ghci> sequence (staircase 3) -- sequence [[1,2,3],[1,2],[1]]
[[1,1,1],[1,2,1],[2,1,1],[2,2,1],[3,1,1],[3,2,1]]
ghci> sequence (staircase 2) -- sequence [[1,2],[1]]
[[1,1],[2,1]]
But now, we run into the fundamental limitation of sequence
mentioned before: once the elements are generated and passed to sequence
, each element represents an independent list of alternative values for that element. This means that the list of alternatives at each position is predetermined: any selection made for an element at one position cannot affect the list of alternative values for an element at another position.
By contrast, our problem defines the list of possible alternatives for each element in terms of the selection made for the previous element: starting with an initial sum, each element's selection is subtracted from it to get the remaining sum that the following element may range up to.
So, to solve the problem, we need a way to generate a list element by element, starting from a seed value (the initial sum), with each step generating a value from the seed (an integer between 1 and the sum) and passing along a modified seed (the remaining sum).
This is exactly what unfoldr
does for pure lists, and unfoldM
does for lists in the context of a monad.
Side-note: The above limitation is actually the key difference between the Applicative functor interface, which does not allow such dependencies between functor values, and the Monad interface, which does (via
join
or bind).Side-note 2: This difference is obscured by the fact that for historical reasons, the Prelude specialises the type of
sequence
toMonad
instead ofApplicative
(withsequenceA
being introduced separately). However, you can always think ofsequence
as an Applicative operation, not a Monad one.
2. Intermission: unfoldr
A quick refresher: wherefoldr
consumes a list by breaking down its structure to a summary value, unfoldr
produces a list by generating its structure from a seed value. Formally, the two functions are dual to each other.
The type of unfoldr
looks a bit strange, at first, compared to foldr
:
foldr :: (a -> b -> b) -> b -> [a] -> b
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
but this difference is mainly technical: Haskell does not have anonymous sum types, so the function uses Just (a, b)
and Nothing
as stand-ins to represent the choice between generating a cons or a nil at each step.
Digression: To see more clearly how
foldr
andunfoldr
are dual to each other, try definingfoldr
with the following variation of its usual type:foldr :: (Maybe (a, b) -> b) -> [a] -> b
Like foldr
, unfoldr
is widely useful for anything that produces lists, and many common functions can be defined in terms of it:
iterate :: (a -> a) -> a -> [a]
iterate f = unfoldr (\x -> Just (x, f x))
repeat :: a -> [a]
repeat x = unfoldr (\_ -> Just (x, undefined)) undefined
replicate :: (Num n, Ord n) => n -> a -> [a]
replicate n x = unfoldr next n
where
next i | 0 < i = Just (x, i-1)
| otherwise = Nothing
Even map
, which is usually presented as a foldr
(map f = foldr ((:) . f) []
), can also be formulated as an unfoldr
, which consumes the input list as it produces the output list:
map :: (a -> b) -> [a] -> [b]
map f = unfoldr next
where
next (x:xs) = Just (f x, xs)
next [] = Nothing
3. Counting down with unfoldr
Before tackling the main problem and unfoldM
, let's consider a simple but similar toy problem which can be solved with unfoldr
.
The problem is to generate countdown lists:
- Start from an arbitrary number
- Generate a list of descending integers
- Stop either when a target number like 0 is reached, or as a variation, after a fixed number of steps
Counting down to a target is easy enough:
countdown :: (Num s, Ord s) => s -> [s]
countdown s = unfoldr next s
where next s
| 0 <= s = Just (s, s-1)
| otherwise = Nothing
ghci> countdown 10
[10,9,8,7,6,5,4,3,2,1,0]
(Note how this is almost identical to replicate
, except for filling in the list elements with the count itself, rather than the fixed value.)
Counting a fixed number of counts from an arbitrary number is a bit trickier: we can no longer reuse the same number for both the current count and the number of steps left. However, we can keep track of both at the same time:
countdownsFrom :: (Num s, Num n, Ord n) => n -> s -> [s]
n `countdownsFrom` s = unfoldr next (n,s)
where next (n,s)
| 0 < n = Just (s, (n-1,s-1))
| otherwise = Nothing
ghci> 10 `countdownsFrom` 99
[99,98,97,96,95,94,93,92,91,90]
ghci> 10 `countdownsFrom` 5
[5,4,3,2,1,0,-1,-2,-3,-4]
(We can simplify this further by calculating the target to avoid keeping track of both numbers, but that's outside the scope of this explanation.)
4. Counting down with unfoldM
Earlier, I said that unfoldM
is like unfoldr
in the context of a monad, but what does this actually mean, intuitively?
Compare the types:
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
unfoldM :: Monad m => (b -> m (Maybe (a, b))) -> b -> m [a]
Compared to unfoldr
, unfoldM
adds m
to the generating function's result and the final result. This means that each generating step takes the current seed and returns the next step as a monadic value.
We can experiment with this by making a variation of countdown
that uses unfoldM
with IO actions to prompt the user for how much to count down by, at each step:
-- Helper: Prompt for user input.
prompt :: Read a => String -> IO a
prompt p = putStr (p ++ "? ") *> readLn
wonkyCountdown :: (Num s, Ord s, Read s, Show s) => s -> IO [s]
wonkyCountdown s = unfoldM next s
where next s
| 0 <= s = let count diff = Just (s, s-diff)
in count <$> prompt (show s)
| otherwise = Nothing <$ putStrLn "Done!"
ghci> wonkyCountdown 10
10? 1
9? -1
10? 4
6? 1
5? 2
3? 2
1? 2
Done!
[10,9,10,6,5,3,1]
ghci>
Note how the only change was to insert the relevant IO actions around the Just
and Nothing
results.
How about swapping IO
for []
? Instead of reading the amount from the user, we can list all possible amounts to count down by as alternative values:
multiCountdown :: (Enum s, Num s, Ord s) => s -> [[s]]
multiCountdown s = unfoldM next s
where next s
| 0 <= s = [Just (s, s-d) | d <- [1..s `max` 1]]
| otherwise = [Nothing]
(The max
is necessary to ensure we always count down by at least 1.)
This gives us a list of possible countdowns by non-zero increments:
ghci> multiCountdown 1
[[1,0]]
ghci> multiCountdown 2
[[2,1,0],[2,0]]
ghci> multiCountdown 3
[[3,2,1,0],[3,2,0],[3,1,0],[3,0]]
ghci> multiCountdown 4
[[4,3,2,1,0],[4,3,2,0],[4,3,1,0],[4,3,0],[4,2,1,0],[4,2,0],[4,1,0],[4,0]]
#5. The solution: Counting down differences
multiCountdown
looks very reminiscent of our puzzle solution.
In fact, it is the puzzle solution, if you take the differences between the countdown numbers.
With a tweak to the edge condition, and letting the value of each element be the difference rather than the current seed (or remaining sum), we can transform multiCountdown
into allPartsOf
:
allPartsOf :: (Enum s, Num s, Ord s) => s -> [[s]]
allPartsOf s = unfoldM next s
where next s
| 0 < s = [Just (d, s-d) | d <- [1..s]]
| otherwise = [Nothing]
Bonus solution: StateT and []
There's a different approach to this problem, using the StateT
monad transformer with []
.
This combination can be viewed as enriching each alternative value with a state, or as extending state actions to be "state multi-actions".
This lets lets us define a "multi-action" that reads the current sum, and then splits itself into alternatives, one for each possible selection and remaining sum:
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
part :: (Enum n, Num n) => StateT n [] n
part = do s <- get
d <- lift [1..s]
put (s-d)
return d
With this defined, we can implement partsOf
simply by repeating part
with replicateM
, and feeding it the initial sum:
-- We can simply repeat the the part action.
partsOf :: (Enum n, Num n) => Int -> n -> [[n]]
n `partsOf` s = replicateM n part `evalStateT` s
For allPartsOf
, we need something that conditionally repeats the action until the state (remaining sum) hits 0. We could implement this ourselves, but conveniently, monad-loops already has whileM
, which repeats a monadic value until a monadic condition is met:
import Control.Monad.Loops (whileM)
allPartsOf :: (Enum n, Num n, Ord n) => n -> [[n]]
allPartsOf s = whileM ((0 <) <$> get) part `evalStateT` s
Is it any easier to understand without do notation?