mapEither inserting both Left and Right-CodePudding

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.

CodePudding user response：

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.

CodePudding user response：

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) )