Using effect of Traversable [] and Applicative Maybe in lens library - haskell

I have the following structure:
y = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20)])
]
I can use this to update every "c":
y & mapped . at "c" . mapped %~ (+ 1)
-- [fromList [("c",2)], fromList [("c",6)], fromList [("d",20)]]
So the third entry is basically just ignored. But I want is for the operation to fail.
Only update, iff all the maps contain the key "c".
So I want:
y & mysteryOp
-- [fromList [("c",1)], fromList [("c",5)], fromList [("d",20)]]
-- fail because third entry does not contain "c" as key
I think I know which functions to use here:
over
-- I want to map the content of the list
mapped
-- map over the structure and transform to [(Maybe Int)]
traverse
-- I need to apply the operation, which will avoid
at "c"
-- I need to index into the key "c"
I just don't know how to combine them

Here's a couple of alternative approaches seeing as you like lenses;
Using laziness to delay deciding whether or not to make the changes,
f y = res
where (All c, res) = y
& each %%~ (at "c" %%~ (Wrapped . is _Just &&& fmap (applyWhen c succ)))
Or deciding upfront whether to make the changes,
f' y = under (anon y $ anyOf each (nullOf $ ix "c")) (mapped . mapped . ix "c" +~ 1) y

I don't see a way to write it as a simple composition of lens combinators, but this is a traversal that you can write from scratch. It should either traverse all values of "c" keys if every map contains such a key or else traverse no values.
We can start with a helper function to "maybe" update a map with a new key value, failing in the Maybe monad if the key doesn't exist. For reasons that will become apparent, we want to allow the update to occur in an arbitrary functor. That is, we want a function:
maybeUpdate :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
Is that signature clear? We check for the key k. If the key is found, we'll return Just an updated map with the key's corresponding value v updated in the f functor. Otherwise, if the key is not found, we return Nothing. We can write this pretty clearly in monad notation, though we need the ApplicativeDo extension if we only want to use Functor f constraint:
maybeUpdate :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
maybeUpdate k f m = do -- in Maybe monad
v <- m ^. at k
return $ do -- in "f" functor
a <- f v
return $ m & at k .~ Just a
Alternatively, these "monadic actions" are really just functor actions, so this definition can be used:
maybeUpdate' k f m =
m ^. at k <&> \v -> f v <&> \a -> m & at k .~ Just a
That's the hard part. Now, the traversal is pretty straightforward. We start with the signature:
traverseAll :: (Ord k) => k -> Traversal' [Map k v] v
traverseAll k f maps =
The idea is that this traversal starts by traversing the list of maps over the Maybe applicative using the maybeUpdate helper:
traverse (maybeUpdate k f) maps :: Maybe [f (Map k v)]
If this traversal succeeds (returns Just a list), then all keys were found, and we can sequence the f applicative actions:
sequenceA <$> traverse (maybeUpdate k f) maps :: Maybe (f [Map k v])
Now, we just use maybe to return the original list if the traversal fails:
traverseAll k f maps = maybe (pure maps) id (sequenceA <$> traverse (maybeUpdate k f) maps)
Now, with:
y :: [Map String Int]
y = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20)])
]
y2 :: [Map String Int]
y2 = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20),("c",6)])
]
we have:
> y & traverseAll "c" %~ (1000*)
[fromList [("c",1)],fromList [("c",5)],fromList [("d",20)]]
> y2 & traverseAll "c" %~ (1000*)
[fromList [("c",1000)],fromList [("c",5000)],fromList [("c",6000),("d",20)]]
Full disclosure: I was not able to construct traverseAll like that from scratch. I started with the much stupider "traversal" in the implicit identity applicative:
traverseAllC' :: (Int -> Int) -> [Map String Int] -> [Map String Int]
traverseAllC' f xall = maybe xall id (go xall)
where go :: [Map String Int] -> Maybe [Map String Int]
go (x:xs) = case x !? "c" of
Just a -> (Map.insert "c" (f a) x:) <$> go xs
Nothing -> Nothing
go [] = Just []
and once I got that up and running, I simplified it, made the Identity explicit:
traverseAllC_ :: (Int -> Identity Int) -> [Map String Int] -> Identity [Map String Int]
and converted it to a general applicative.
Anyway, here's the code:
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RankNTypes #-}
import Data.Map (Map, fromList)
import Control.Lens
y :: [Map [Char] Int]
y = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20)])
]
y2 :: [Map [Char] Int]
y2 = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20),("c",6)])
]
traverseAll :: (Ord k) => k -> Traversal' [Map k v] v
traverseAll k f maps = maybe (pure maps) id (sequenceA <$> traverse (maybeUpdate k f) maps)
maybeUpdate :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
maybeUpdate k f m = do
v <- m ^. at k
return $ do
a <- f v
return $ m & at k .~ Just a
maybeUpdate' :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
maybeUpdate' k f m =
m ^. at k <&> \v -> f v <&> \a -> m & at k .~ Just a
main = do
print $ y & traverseAll "c" %~ (1000*)
print $ y2 & traverseAll "c" %~ (1000*)

Related

mapEither inserting both Left and Right

Using the function mapEither for multiset's I can turn a MultiSet into a pair of two multisets. When f is returning Left the element is inserted into the first Multiset of the pair, and if f is returning Right the element is inserted into the second MultiSet of the pair.
How can I insert the same element into both MultiSets at the same time, as if f were returning Right and Left at the same time?
f:: LocalType -> Either LocalType LocalType
f (Sometype lt) = Left lt -- And Right lt
f lt = Left lt
parRule :: (MultiSet LocalType) -> (MultiSet LocalType)
parRule sequent = do
let list = MultiSet.mapEither f sequent
For reference, I use Data.Multiset package, https://hackage.haskell.org/package/multiset-0.3.4.3/docs/Data-MultiSet.html.
You can use a type like These to capture the ability to return both. You can then use toAscOccurList and fromOccurList (or fromAscOccurList if your function is monotonic) to compute the new MultiSet.
You could use These as Daniel Wagner suggests, but I would use a slightly different function to start with, which seems like a slightly better match to the library API. Furthermore, I would recommend a different implementation strategy for performance.
data SP a b = SP !a !b
toPair :: SP a b -> (a, b)
toPair (SP a b) = (a, b)
mapPairOcc :: (Ord b, Ord c) => (a -> Occur -> ((b, Occur), (c, Occur))) -> MultiSet a -> (MultiSet b, MultiSet c)
mapPairOcc f = toPair . mapPairOcc' f
mapPairOcc' :: (Ord b, Ord c) => (a -> Occur -> ((b, Occur), (c, Occur))) -> MultiSet a -> SP (MultiSet b) (MultiSet c)
mapPairOcc' f = foldl' go (SP empty empty) . toAscOccurList
where
go (SP bs cs) a
| ((b, bn), (c, cn)) <- f a
= SP (insertMany b bn bs) (insertMany c cn cs)
When you know that f is strictly monotone in the sense that
a < a' ==> fst (f a) < fst (f a') /\ snd (f a) < snd (f a')
it's possible to do better, building the results in O(n) time. The best way to do this seems to be to use Data.Map internals. I'll reuse the SP type from above.
import Data.Map.Lazy (Map)
import Data.MultiSet (MultiSet, Occur)
import qualified Data.MultiSet as MS
import qualified Data.Map.Internal as M
import Control.Monad (guard)
-- | Map over the keys and values in a map, producing
-- two maps with new keys and values. The passed function
-- must be strictly monotone in the keys in the sense
-- described above.
mapMaybeWithKey2Mono :: (k -> a -> (Maybe (l,b), Maybe (m,c))) -> Map k a -> (Map l b, Map m c)
mapMaybeWithKey2Mono f = toPair . mapMaybeWithKey2Mono' f
mapMaybeWithKey2Mono' :: (k -> a -> (Maybe (l,b), Maybe (m,c))) -> Map k a -> SP (Map l b) (Map m c)
mapMaybeWithKey2Mono' _ M.Tip = SP M.Tip M.Tip
mapMaybeWithKey2Mono' f (M.Bin _ kx x l r)
| (fl, fr) <- f kx x
= SP (groink fl mfl1 mfr1) (groink fr mfl2 mfr2)
where
groink :: Maybe (q, x) -> Map q x -> Map q x -> Map q x
groink m n o = case m of
Just (k', y) -> M.link k' y n o
Nothing -> M.link2 n o
SP mfl1 mfl2 = mapMaybeWithKey2Mono' f l
SP mfr1 mfr2 = mapMaybeWithKey2Mono' f r
Using this new general Map function, we can define the function we want on multisets:
mapPairAscOcc :: (a -> Occur -> ((b, Occur), (c, Occur))) -> MultiSet a -> (MultiSet b, MultiSet c)
mapPairAscOcc f m
| (p, q) <- mapMaybeWithKey2Mono go . MS.toMap $ m
= (MS.fromOccurMap p, MS.fromOccurMap q)
where
-- a -> Occur -> (Maybe (b, Occur), Maybe (c, Occur))
go a aocc
| ((b, bocc), (c, cocc)) <- f a aocc
= ( (b, bocc) <$ guard (bocc > 0)
, (c, cocc) <$ guard (cocc > 0) )
I took the function mapEither from the Data.MultiSet and modified it such that it supports These type.
-- | /O(n)/. Map and separate the 'This' and 'That' or 'These' results
-- modified function of mapEither to map both cases in case f return These
-- code of mapEither found in source code,
mapThese :: (Ord b, Ord c) => (a -> These b c) -> MultiSet a -> (MultiSet b, MultiSet c)
mapThese f = (\(ls,rs) -> (MultiSet.fromOccurList ls, MultiSet.fromOccurList rs)) . mapThese' . MultiSet.toOccurList
where mapThese' [] = ([],[])
mapThese' ((x,n):xs) = case f x of
This l -> let (ls,rs) = mapThese' xs in ((l,n):ls, rs)
That r -> let (ls,rs) = mapThese' xs in (ls, (r,n):rs)
These u i -> let (ls,rs) = mapThese' xs in ((u,n):ls, (i,n):rs)
In the case f returns These, both MultiSet's have an added element.

How can I union maps of different types in Haskell?

I'm looking for a Haskell function that combines two Maps of different types. I.e. something like
mergeWith :: (a -> b -> c) -> Map k a -> Map k b -> Map k c
I want it to behave like an inner join in SQL.
unionWith doesn't cut it since it requires both Maps to have values of the same type.
Is there such a function? If not, what's the most efficient way to implement it?
Does intersectionWith not fit the bill?
This was the best that I could do myself
import qualified Data.Map.Strict as M
mergeWith :: (Ord k) => (a -> b -> c) -> M.Map k a -> M.Map k b -> M.Map k c
mergeWith f m1 m2 = M.fromList $ g (M.toList m1) (M.toList m2)
where
g [] _ = []
g _ [] = []
g m1'#((k1, v1):_) m2'#((k2, v2):_)
| k1 < k2 = g (tail m1') m2'
| k1 > k2 = g m1' (tail m2')
| otherwise = (k1, f v1 v2) : g (tail m1') (tail m2')
It sholud have O(n) complexity where n is the size of the bigger Map

How to take an 2D slice with Lens

import qualified Data.Vector as V
import Control.Lens
import Data.Vector.Lens
v = V.fromList [V.fromList [1..3], V.fromList [4..6], V.fromList [7..9]]
1D slice (for example) :
*Main> v ^. sliced 1 2
fromList [fromList [4,5,6],fromList [7,8,9]]
2D sclice: What should I write to get this result?
*Main> v ^. sliced 1 2 {- ??????? -} sliced 0 2 -- Or not so?
V.fromList [V.fromList [4,5], V.fromList [7,8]]
This should do it
insliced :: Int -> Int -> Lens' (V.Vector (V.Vector a)) (V.Vector (V.Vector a))
insliced i n f m = f (V.map (V.slice i n) m)
<&> V.zipWith (\a b -> a V.// zip [i..i+n-1] (V.toList b)) m
then
λ v ^. sliced 1 2 . insliced 0 2
fromList [fromList [4,5],fromList [7,8]]
This has similar requirements to sliced to be valid.
It's worth mentioning there's a general version of this called column from linear. It can't be used with Vector because Vectors aren't Representable (because because it's size isn't statically known). But with something like V3:
λ V3 (V3 1 2 3) (V3 4 5 6) (V3 7 8 9) ^. _yz . column _xy
V2 (V2 4 5) (V2 7 8)
You could write your own (less safe) version for vectors:
vcolumn :: ALens' a b -> Lens' (V.Vector a) (V.Vector b)
vcolumn l f m = f (V.map (^# l) m) <&> V.zipWith (\a b -> a & l #~ b) m

How to define lens into sum-type inside Map-like container?

I can define the needed Lens' manually:
type Key = String
type Val = Int
type Foo = Map Key (Either Val Bool)
ll :: String -> Lens' Foo (Maybe Int)
ll k f m = f mv <&> \r -> case r of
Nothing -> maybe m (const (Map.delete k m)) mv
Just v' -> Map.insert k (Left v') m
where mv = Map.lookup k m >>= maybeLeft
maybeLeft (Left v') = Just v'
maybeLeft (Right _) = Nothing
And it works like:
x, y :: Foo
x = Map.empty
y = Map.fromList [("foo", Right True)]
>>> x ^. ll "foo"
Nothing
>>> x & ll "foo" ?~ 1
fromList [("foo",Left 1)]
>>> (x & ll "foo" ?~ 1) ^. ll "foo"
Just 1
>>> (x & ll "foo" ?~ 1) ^. ll "bar"
Nothing
>>> x & ll "foo" ?~ 1 & ll "foo" .~ Nothing
fromList []
>>> y ^. ll "foo"
Nothing
>>> y & ll "foo" ?~ 1
fromList [("foo",Left 1)]
>>> y & ll "foo" .~ Nothing
fromList [("foo",Right True)]
I verified that definition is lawful:
-- Orphan instance is ok-ish in this case :)
instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
arbitrary = Map.fromList <$> arbitrary
-- 1) You get back what you put in:
lensLaw1 :: Foo -> Key -> Maybe Val -> Property
lensLaw1 s k v = view (ll k) (set (ll k) v s) === v
-- 2) Putting back what you got doesn't change anything:
lensLaw2 :: Foo -> Key -> Property
lensLaw2 s k = set (ll k) (view (ll k) s) s === s
-- 3) Setting twice is the same as setting once:
lensLaw3 :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3 s k v v' = set (ll k) v' (set (ll k) v s) === set (ll k) v' s
So the question: can the ll be defined using at and _Left?
Maybe with some kind of prismToLens :: Prism' a b -> Lens' (Maybe a) (Maybe b), you can do at k . prismToLens _Left. Yet I'm not sure if prismToLens makes sense? Hoogle isn't that helpful with lens :(
EDIT seems that third law doesn't hold always. Easy to find counter-example if you change Key to be Bool. Yet in my application the Map is actually dependent, i.e. the sum branch depends on the key, so the Lens law should hold (if I access foo, I know it should be Left or not exist at all).
For now I go with:
prismToLens :: Prism' a b -> Lens' (Maybe a) (Maybe b)
prismToLens p = lens getter setter
where getter s = s >>= (^? p)
setter _ b = (p#) <$> b
so I can define ll like:
ll' :: Key -> Lens' Foo (Maybe Val)
ll' k = at k . prismToLens _Left
Controrary to the "lens" defined in the question, for this one 2nd law doesn't hold:
-- 2) Putting back what you got doesn't change anything:
-- Doesn't hold
-- >>> quickCheck $ lensLaw2' (Map.fromList [(True,Right False)]) True
-- fromList [] /= fromList [(True,Right False)]
lensLaw2' :: Foo -> Key -> Property
lensLaw2' s k = set (ll' k) (view (ll' k) s) s === s
But with original the third law didn't hold:
-- 3) Setting twice is the same as setting once:
-- Doesn't hold
-- >>> quickCheck $ lensLaw3 (Map.fromList [(False, Right False)]) False (Just 0) Nothing
-- fromList [] /= fromList [(True,Right False)]
lensLaw3 :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3 s k v v' = set (ll k) v' (set (ll k) v s) === set (ll k) v' s
As said in the question as I have dependend map, this is ok. When accessing some key k, there shouldn't ever be Right value, if I expect there to be Left. Taking this into the account, using prismToLens is actually better. Still searching for a better name though.
After remembering non, I altered the answer to use:
prismToIso :: Prism' a b -> Iso' (Maybe a) (Maybe b)
prismToIso p = iso t f
where t a = a >>= (^? p)
f b = (p#) <$> b -- no unused param as in `prismToLens`!
Which resembles mapping. The law properties behaved the same as with prismToLens. This gives rise to the new questio: which one is better or worse, prismToIso or prismToLens. And why?
The full runnable example:
{-# LANGUAGE RankNTypes #-}
module Lens where
import Control.Applicative
import Control.Lens
import Data.Map as Map
import Test.QuickCheck
type Key = Bool
type Val = Int
type Foo = Map Key (Either Val Bool)
ll :: Key -> Lens' Foo (Maybe Val)
ll k f m = f mv <&> \r -> case r of
Nothing -> maybe m (const (Map.delete k m)) mv
Just v' -> Map.insert k (Left v') m
where mv = Map.lookup k m >>= maybeLeft
maybeLeft (Left v') = Just v'
maybeLeft (Right _) = Nothing
prismToLens :: Prism' a b -> Lens' (Maybe a) (Maybe b)
prismToLens p = lens getter setter
where getter s = s >>= (^? p)
setter _ b = (p#) <$> b
ll' :: Key -> Lens' Foo (Maybe Val)
ll' k = at k . prismToLens _Left
x, y :: Foo
x = Map.empty
y = Map.fromList [(True, Right True)]
{-
>>> x ^. ll "foo"
Nothing
>>> x & ll "foo" ?~ 1
fromList [("foo",Left 1)]
>>> (x & ll "foo" ?~ 1) ^. ll "foo"
Just 1
>>> (x & ll "foo" ?~ 1) ^. ll "bar"
Nothing
>>> x & ll "foo" ?~ 1 & ll "foo" .~ Nothing
fromList []
>>> y ^. ll "foo"
Nothing
>>> y & ll "foo" ?~ 1
fromList [("foo",Left 1)]
>>> y & ll "foo" .~ Nothing
fromList [("foo",Right True)]
-}
-- Orphan instance is ok-ish in this case :)
instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
arbitrary = Map.fromList <$> arbitrary
shrink = Prelude.map Map.fromList . shrink . Map.toList
-- 1) You get back what you put in:
lensLaw1 :: Foo -> Key -> Maybe Val -> Property
lensLaw1 s k v = view (ll k) (set (ll k) v s) === v
-- 2) Putting back what you got doesn't change anything:
lensLaw2 :: Foo -> Key -> Property
lensLaw2 s k = set (ll k) (view (ll k) s) s === s
-- 3) Setting twice is the same as setting once:
-- Doesn't hold
-- >>> quickCheck $ lensLaw3 (Map.fromList [(False, Right False)]) False (Just 0) Nothing
-- fromList [] /= fromList [(True,Right False)]
lensLaw3 :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3 s k v v' = set (ll k) v' (set (ll k) v s) === set (ll k) v' s
-- Using prismToLens defined "lens"
-- 1) You get back what you put in:
lensLaw1' :: Foo -> Key -> Maybe Val -> Property
lensLaw1' s k v = view (ll' k) (set (ll' k) v s) === v
-- 2) Putting back what you got doesn't change anything:
-- Doesn't hold
-- >>> quickCheck $ lensLaw2' (Map.fromList [(True,Right False)]) True
-- fromList [] /= fromList [(True,Right False)]
lensLaw2' :: Foo -> Key -> Property
lensLaw2' s k = set (ll' k) (view (ll' k) s) s === s
-- 3) Setting twice is the same as setting once:
lensLaw3' :: Foo -> Key -> Maybe Val -> Maybe Val -> Property
lensLaw3' s k v v' = set (ll' k) v' (set (ll' k) v s) === set (ll' k) v' s

"No instance for (Ord k)" when implementing Functor over Data.Map.Map

I am attempting to implement the Functor fmap over a Data.Map.Map, but I am getting an error. I'm sure I don't need to convert the Map to and from a List in order to get this working, but this is the best I've come up with so far.
class Functor' f where
fmap' :: (a -> b) -> f a -> f b
instance Functor' (Map.Map k) where
fmap' f m
| Map.null m = Map.empty
| otherwise = let x:xs = Map.toList m
mtail = Map.fromList xs
a = fst x
b = snd x
in Map.insert a (f b) (fmap f mtail)
The error:
No instance for (Ord k)
arising from a use of `Map.fromList'
In the expression: Map.fromList xs
In an equation for `mtail': mtail = Map.fromList xs
In the expression:
let
x : xs = Map.toList m
mtail = Map.fromList xs
a = fst x
....
in Map.insert a (f b) (fmap f mtail)
Any ideas?
The error is due to not assigning the Ord predicate to the type-variable k. Just do this:
instance Ord k => Functor' (Map.Map k) where

Resources