Integrate.hs

import Prelude hiding (foldr, filter)
import Data.Maybe (fromJust, isJust)
import Data.Foldable (Foldable(foldr))
import Data.HashMap.Lazy (HashMap, singleton, unionWith, foldrWithKey)
import Data.Hashable (Hashable(..))
import Data.Monoid (Monoid(mappend, mempty))
import Data.Vector (Vector, find, cons, filter)

-- sniEquivalence describes a surjective but non-injective relation between
-- {b, a}.

integrate' :: Eq a => Hashable a => (a -> b -> Bool) -> Vector a -> Vector b -> HashMap a (Vector b)
integrate' sniEquivalance as = foldr (unionWith mappend) mempty . catMaybes . fmap (flip associate as)
  where associate term = flip singleton (return term) <$$> find (`sniEquivalance` term)

integrate :: Eq a => Hashable a => (a -> Vector b -> c) -> (a -> b -> Bool) -> Vector a -> Vector b -> Vector c
integrate constructor = (uncurry constructor <$$> toVector) <$$$> integrate'

toVector :: HashMap k v -> Vector (k, v)
toVector = cons <$$> (,) `foldrWithKey` mempty

catMaybes :: Vector (Maybe a) -> Vector a
catMaybes = fmap fromJust . filter isJust
  
(<$$>) :: Functor f => Functor g => (a -> b) -> g (f a) -> g (f b)
(<$$>) = fmap fmap fmap 

(<$$$>) :: Functor f => Functor g => Functor h => (a -> b) -> h (g (f a)) -> h (g (f b))
(<$$$>) = fmap `fmap` fmap fmap fmap