Today I had two maps I needed to combine: consMaps :: Map k a -> Map k b -> Map k (a, b). Seeing nothing in Data.Map, I set out to implement this and came up with something unexpectedly ugly:
consMaps :: Map k a -> Map k b -> Map k (a, b)
consMaps ma mb = mapMapMaybe g (Map.unionWith f a' b')
where
a' :: Map k (Maybe (Maybe a, Maybe b))
a' = fmap (\a -> Just (Just a, Nothing)) ma
b' :: Map k (Maybe (Maybe a, Maybe b))
b' = fmap (\b -> Just (Nothing, Just b)) mb
f :: Maybe (Maybe a, Maybe b) -> Maybe (Maybe a, Maybe b) -> Maybe (Maybe a, Maybe b)
f (Just (Just a, _)) (Just (_, Just b)) = Just (Just a, Just b)
f (Just (_, Just b)) (Just (Just a, _)) = Just (Just a, Just b)
-- f (Just a, Just b) _ = Just (a, b) -- impossible in this context
-- f _ (Just a, Just b) = Just (a, b) -- impossible in this context
f _ _ = Nothing
g :: Maybe (Maybe a, Maybe b) -> Maybe (a, b)
g (Just (Just a, Just b)) = Just (a, b)
g _ = Nothing
mapMapMaybe :: (a -> Maybe b) -> Map k a -> Map k b
mapMapMaybe f mp = snd (mapEither (maybe (Left ()) Right . f) mp)
Am I missing something? Is this as good as this gets?
It looks like your consMaps implementation, with the signature you've given, is just
consMaps :: Map k a -> Map k b -> Map k (a, b)
consMaps = intersectionWith (,)
If instead you wanted a Map k (Maybe a, Maybe b), I might write that as
consMaps :: Map k a -> Map k b -> Map k (Maybe a, Maybe b)
consMaps ma mb = unionWith combine ma' mb' where
ma' = fmap (\ a -> (Just a, Nothing)) ma
mb' = fmap (\ b -> (Nothing, Just b)) mb
combine (a, _) (_, b) = (a, b)
If you want Map (a, b) out then use the other answer (intersectionWith). If you want a Map (Maybe a, Maybe b) then that specialized function won't work. Instead, containers has a merge function, which covers "basically all" ways to combine Maps. It takes three strategies: what to do if a key is only in the left map, what to do if a key is only in the right map, and what to do if a key is in both. The strategies are built using helper functions. The idea is that merge does exactly one traversal of the inputs, so is more efficient than e.g. mapping the inputs and then combining.
import Data.Map.Merge.Lazy
catMaps :: Ord k => Map k a -> Map k b -> Map k (Maybe a, Maybe b)
catMaps = merge left right both
where left = mapMissing $ \_ a -> (Just a, Nothing)
right = mapMissing $ \_ b -> (Nothing, Just b)
both = zipWithMatched $ \_ a b -> (Just a, Just b)
Note that the "right" type for the output in this version is actually Map k (These a b), where These models "inclusive or":
data These a b = This a | That b | These a b
theseMaps :: Ord k => Map k a -> Map k b -> Map k (These a b)
theseMaps = merge left right both
where left = mapMissing $ const This
right = mapMissing $ const That
both = zipWithMatched $ const These
Related
I'm a newbe in functional programming, and I'm trying to solve the following exercise;
Given the type
type Cont r a = (a -> r) -> r
Implement the following higher-order function
mapReader :: (a -> b) -> (Cont r a) -> Cont r b
The first step would be to simplify the types, which gives:
mapReader :: (a -> b) -> ((a -> r) -> r) -> (b -> r) -> r
Next, define the parameters that need to be provided in this function. These parameters are three functions so we get
mapReader :: (a -> b) -> ((a -> r) -> r) -> (b -> r) -> r
mapReader f g h = _1
From here, we can define the following types:
f :: a -> b
g :: (a -> r) -> r
h :: b -> r
_1 :: r
But now I'm stuck. There are two functions that result in r, and one of them contains another function (a -> r). How can I start defining r? Any hints are much appreciated!
We have
f :: a -> b
g :: (a -> r) -> r
h :: b -> r
and we need
_1 :: r
There are two ways we can make r: g and h.
Let's try using h. h takes an argument of type b. The only way to get one of those is using f. f takes an argument of type a, and ... we don't have any way to get one of those.
So now let's try using g instead:
mapReader f g h = g _2
We're told
_2 :: a -> r
Since we're constructing a function, we can apply lambda abstraction as usual:
mapReader f g h = g (\a -> _3)
a :: a
_3 :: r
But wait ... now we have an a, so we can go back to our first attempt:
mapReader f g h = g (\a -> h (f a))
Or, more compactly,
mapReader f g h = g (h . f)
What if instead of going back to the first attempt we did it the second way again?
mapReader' f g h =
g (\a1 -> g (\a2 -> _4))
_4 :: r
You could go this way forever, but you could also stop here in two different ways:
mapReader2 f g h =
g (\_ -> g (h . f))
mapReader3 f g h =
g (\a1 -> g (\_ -> h (f a1)))
Oy! These are three different functions that all have the same type, and as shown this approach can be used to generate an infinite family of functions! How can you decide which one you want? You have to consider the intention. g's argument is the continuation, so you want to compose a function with what you're passing g, not call g multiple times. So mapReader is the "correct" answer.
More precisely, mapReader is supposed to map morphisms for the continuation functor. That requires in particular that
mapReader id = id
That is,
mapReader id g h = g (h . id)
= g h
That's unconditionally true for the correct definition, but not for any of the others.
Start by looking at what you can do with the three arguments.
You can compose f and h: h . f :: a -> r.
You can apply g to h . f: g (h . f) :: r.
So you could simply say that mapReader f g h = g (h . f). There's not enough information here to specify what r is; it depends entirely on what
arguments g and h are given to mapReader.
So you have
f :: a -> b
h :: b -> r
g :: (a -> r) -> r
There's also the forward functional composition operator,
(>>>) :: (a -> b) -> (b -> r) -> (a -> r)
and the reversed application operator,
(&) :: t -> (t -> r) -> r
so that
f >>> h :: ......... -- what?
and
(f >>> h) & g :: ......... -- what else?
Can you come up with the definitions of (>>>) and (&), just from their types?
Let me get you started on the first one.
(>>>) :: (a -> b) -> (b -> r) -> (a -> r)
means that
(>>>) (f :: a -> b) :: (b -> r) -> (a -> r)
(>>>) (f :: a -> b) (g :: b -> r) :: (a -> r)
(>>>) (f :: a -> b) (g :: b -> r) (x :: a) :: r
So again we write them down
f :: a -> b
g :: b -> r
x :: a
f x :: b
g (f x) :: ....
And that's that.
The most important rule that we used here, is
x :: a
f :: a -> r
f x :: r
map2_Maybe :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
map2_Maybe f Nothing _ = Nothing
map2_Maybe f (Just a) Nothing = Nothing
map2_Maybe f (Just a) (Just b) = Just ((f a) b)
-- Or: map2_Maybe f (Just a) mb = fmap (f a) mb
map2_Either :: (a -> b -> c) -> Either e a -> Either e b -> Either e c
map2_Either f (Left e) _ = Left e
map2_Either f (Right a) (Left e) = Left e
map2_Either f (Right a) (Right b) = Right (f a b)
-- Or: map2_Either f (Right a) eb = fmap (f a) eb
In these two examples, Is ((f a) b) the same as (f a b) since every function in Haskell can only take one argument?
Yes, they are exactly the same.
Haskell transposes (f a b) into ((f a) b). It's called currying. It does that to all functions by default but can be overridden.
add = (+)
(add 1 2) -- becomes -- ((add 1) 2) -- upon execution.
Both return 3. The result of a function is its value.
Curried functions are natural.
add1 = add 1
add1 2 -- also returns 3
lens offers holesOf, which is a somewhat more general and powerful version of this hypothetical function:
holesList :: Traversable t
=> t a -> [(a, a -> t a)]
Given a container, holesList produces a list of elements of the container along with functions for replacing those elements.
The type of holesList, like that of the real holesOf, fails to capture the fact that the number of pairs produced will equal the number of elements of the container. A much more beautiful type, therefore, would be
holes :: Traversable t
=> t a -> t (a, a -> t a)
We could implement holes by using holesList to make a list and then traversing in State to slurp the elements back in. But this is unsatisfactory for two reasons, one of which has practical consequences:
The slurping code will have an unreachable error call to handle the case where the list runs empty before the traversal is complete. This is disgusting, but probably doesn't matter much to someone using the function.
Containers that extend infinitely to the left, or that bottom out on the left, won't work at all. Containers that extend very far to the left will be very inefficient to handle.
I'm wondering if there's any way around these problems. It's quite possible to capture the shape of the traversal using something like Magma in lens:
data FT a r where
Pure :: r -> FT a r
Single :: a -> FT a a
Map :: (r -> s) -> FT a r -> FT a s
Ap :: FT a (r -> s) -> FT a r -> FT a s
instance Functor (FT a) where
fmap = Map
instance Applicative (FT a) where
pure = Pure
(<*>) = Ap
runFT :: FT a t -> t
runFT (Pure t) = t
runFT (Single a) = a
runFT (Map f x) = f (runFT x)
runFT (Ap fs xs) = runFT fs (runFT xs)
Now we have
runFT . traverse Single = id
traverse Single makes a tree full of elements along with the function applications needed to build them into a container. If we replace an element in the tree, we can runFT the result to get a container with that element replaced. Unfortunately, I am stuck: I don't know what the next step might look like.
Vague thoughts: adding another type parameter might help change element types. The Magma type does something like this, and it goes back at least as far as Zemyla's comment on Van Laarhoven's blog post about FunList.
Your existing solution calls runMag once for every branch in the tree defined by Ap constructors.
I haven't profiled anything, but as runMag is itself recursive, this might slow things down in a large tree.
An alternative would be to tie the knot so you're only (in effect) calling runMag once for the entire tree:
data Mag a b c where
One :: a -> Mag a b b
Pure :: c -> Mag a b c
Ap :: Mag a b (c -> d) -> Mag a b c -> Mag a b d
instance Functor (Mag a b) where
fmap = Ap . Pure
instance Applicative (Mag a b) where
pure = Pure
(<*>) = Ap
holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes = \t ->
let m :: Mag a b (t b)
m = traverse One t
in fst $ go id m m
where
go :: (x -> y)
-> Mag a (a, a -> y) z
-> Mag a a x
-> (z, x)
go f (One a) (One _) = ((a, f), a)
go _ (Pure z) (Pure x) = (z, x)
go f (Ap mg mi) (Ap mh mj) =
let ~(g, h) = go (f . ($j)) mg mh
~(i, j) = go (f . h ) mi mj
in (g i, h j)
go _ _ _ = error "only called with same value twice, constructors must match"
I have not managed to find a really beautiful way to do this. That might be because I'm not clever enough, but I suspect it is an inherent limitation of the type of traverse. But I have found a way that's only a little bit ugly! The key indeed seems to be the extra type argument that Magma uses, which gives us the freedom to build a framework expecting a certain element type and then fill in the elements later.
data Mag a b t where
Pure :: t -> Mag a b t
Map :: (x -> t) -> Mag a b x -> Mag a b t
Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
One :: a -> Mag a b b
instance Functor (Mag a b) where
fmap = Map
instance Applicative (Mag a b) where
pure = Pure
(<*>) = Ap
-- We only ever call this with id, so the extra generality
-- may be silly.
runMag :: forall a b t. (a -> b) -> Mag a b t -> t
runMag f = go
where
go :: forall u. Mag a b u -> u
go (Pure t) = t
go (One a) = f a
go (Map f x) = f (go x)
go (Ap fs xs) = go fs (go xs)
We recursively descend a value of type Mag x (a, a -> t a) (t (a, a -> t a)) in parallel with one of type Mag a a (t a) using the latter to produce the a and a -> t a values and the former as a framework for building t (a, a -> t) from those values. x will actually be a; it's left polymorphic to make the "type tetris" a little less confusing.
-- Precondition: the arguments should actually be the same;
-- only their types will differ. This justifies the impossibility
-- of non-matching constructors.
smash :: forall a x t u.
Mag x (a, a -> t) u
-> Mag a a t
-> u
smash = go id
where
go :: forall r b.
(r -> t)
-> Mag x (a, a -> t) b
-> Mag a a r
-> b
go f (Pure x) _ = x
go f (One x) (One y) = (y, f)
go f (Map g x) (Map h y) = g (go (f . h) x y)
go f (Ap fs xs) (Ap gs ys) =
(go (f . ($ runMag id ys)) fs gs)
(go (f . runMag id gs) xs ys)
go _ _ _ = error "Impossible!"
We actually produce both Mag values (of different types!) using a single call to traverse. These two values will actually be represented by a single structure in memory.
holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes t = smash mag mag
where
mag :: Mag a b (t b)
mag = traverse One t
Now we can play with fun values like
holes (Reverse [1..])
where Reverse is from Data.Functor.Reverse.
Here is an implementation that is short, total (if you ignore the circularity), doesn't use any intermediate data structures, and is lazy (works on any kind of infinite traversable):
import Control.Applicative
import Data.Traversable
holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runKA id $ for t $ \a ->
KA $ \k ->
let f a' = fst <$> k (a', f)
in (a, f)
newtype KA r a = KA { runKA :: (a -> r) -> a }
instance Functor (KA r) where fmap f a = pure f <*> a
instance Applicative (KA r) where
pure a = KA (\_ -> a)
liftA2 f (KA ka) (KA kb) = KA $ \cr ->
let
a = ka ar
b = kb br
ar a' = cr $ f a' b
br b' = cr $ f a b'
in f a b
KA is a "lazy continuation applicative functor". If we replace it with the standard Cont monad, we also get a working solution, which is not lazy, however:
import Control.Monad.Cont
import Data.Traversable
holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runCont id $ for t $ \a ->
cont $ \k ->
let f a' = fst <$> k (a', f)
in k (a, f)
This doesn't really answer the original question, but it shows another angle. It looks like this question is actually tied rather deeply to a previous question I asked. Suppose that Traversable had an additional method:
traverse2 :: Biapplicative f
=> (a -> f b c) -> t a -> f (t b) (t c)
Note: This method can actually be implemented legitimately for any concrete Traversable datatype. For oddities like
newtype T a = T (forall f b. Applicative f => (a -> f b) -> f (T b))
see the illegitimate ways in the answers to the linked question.
With that in place, we can design a type very similar to Roman's, but with a twist from rampion's:
newtype Holes t m x = Holes { runHoles :: (x -> t) -> (m, x) }
instance Bifunctor (Holes t) where
bimap f g xs = Holes $ \xt ->
let
(qf, qv) = runHoles xs (xt . g)
in (f qf, g qv)
instance Biapplicative (Holes t) where
bipure x y = Holes $ \_ -> (x, y)
fs <<*>> xs = Holes $ \xt ->
let
(pf, pv) = runHoles fs (\cd -> xt (cd qv))
(qf, qv) = runHoles xs (\c -> xt (pv c))
in (pf qf, pv qv)
Now everything is dead simple:
holedOne :: a -> Holes (t a) (a, a -> t a) a
holedOne x = Holes $ \xt -> ((x, xt), x)
holed :: Traversable t => t a -> t (a, a -> t a)
holed xs = fst (runHoles (traverse2 holedOne xs) id)
I have a these three functions
a :: Int -> Maybe Int
a i = if i < 100 then Just i else Nothing
b :: Int -> Maybe Int
b i = if i < 50 then Just i else Nothing
c :: Int -> Maybe Int
c i = if i > 0 then Just i else Nothing
And I want to chain them together so that when the result of one function results in a Nothing the input of that function is returned instead.
I can achieve this with this function:
import Data.Maybe (fromMaybe)
e :: Int -> [Int -> Maybe Int] -> Int
e i [] = i
e i (f:fs) = e (fromMaybe i $ f i) fs
-
*Main> e 75 [a,b,c]
75
Is there an existing function, Monad instance, or other way in the base libraries that exhibits this behavior?
Expanding my comment above -- this approach is not too different from the code the OP posted.
We first define how to turn a function a -> Maybe a into a -> a, substituting the input for Nothing.
totalize :: (a -> Maybe a) -> (a -> a)
totalize f x = fromMaybe x (f x)
Then, we exploit the above: we make every function "total" (meaning no-Nothings), wrap it as an Endo, then we compose the list of endomorphisms (mconcat is composition in the Endo monoid).
e :: [a -> Maybe a] -> a -> a
e = appEndo . mconcat . map (Endo . totalize)
or even (as suggested below)
e :: Foldable t => t (a -> Maybe a) -> a -> a
e = appEndo . foldMap (Endo . totalize)
Well, you can create a a -> a from a a -> Maybe a:
repair :: (a -> Maybe a) -> a -> a
repair f x = fromMaybe x (f x)
Afterwards, you can just combine (.) and repair:
andThen :: (a -> Maybe a) -> (a -> Maybe a) -> a -> a
andThen f g = repair g . repair f
But there's no library function for that, since there is no general way to get a value out of a Monad.
Are you looking for the maybe monad?
*Main> let f x = a x >>= b >>= c >> return x
*Main> f 1
Just 1
*Main> f 100
Nothing
*Main>
Then if the result is Nothing we can get to your desired end state with fromMaybe (or just maybe and id, same thing):
*Main> let g x = maybe x id (f x)
*Main> g 100
100
I would like to union two Map instances with a monadic function. This becomes a problem because of the unionWith type signature:
unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
I'm looking for a smart way to do this. Here is my naive implementation:
monadicUnionWith :: (Monad m, Ord k) => (a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
monadicUnionWith f mapA mapB = do
let overlapping = toList $ intersectionWith (\a b -> (a,b)) mapA mapB
mergedOverlapping <- liftM fromList $ mapM helper overlapping
return $ union (union mergedOverlapping mapA) mapB
where
helper (k, (a,b)) = do
c <- f a b
return (k, c)
Note that union is left biased
Not sure if it is more efficient, but it is somewhat cooler (as it involves storing monadic values in the map):
monadicUnionWith :: (Monad m, Ord k) => (a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
monadicUnionWith f mapA mapB =
Data.Traversable.sequence $ unionWith (\a b -> do {x <- a; y <- b; f x y}) (map return mapA) (map return mapB)
And if you want you can use
(\a b -> join (liftM2 f a b))
as the parameter to unionWith, or even
((join.).(liftM2 f))