如何定义Data.Foldable.Constrained的实例？

Question

我已经成功定义了 Category、Functor、Semigroup、Monoid constrained。现在我坚持 Data.Foldable.Constrained。更准确地说，我似乎已经正确定义了不受约束的函数 fldl 和 fldMp，但我无法让它们被接受为 Foldable.Constrained 个实例。我的定义尝试作为评论插入。

{-# LANGUAGE OverloadedLists, GADTs, TypeFamilies, ConstraintKinds, 
FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, TypeApplications #-}

import Prelude ()

import Control.Category.Constrained.Prelude
import qualified Control.Category.Hask as Hask
-- import Data.Constraint.Trivial
import Data.Foldable.Constrained
import Data.Map as M
import Data.Set as S
import qualified Data.Foldable as FL

main :: IO ()
main = print $ fmap (constrained @Ord (+1))
             $ RMS ([(1,[11,21]),(2,[31,41])])

data RelationMS a b where
  IdRMS :: RelationMS a a
  RMS :: Map a (Set b) -> RelationMS a b 
deriving instance (Show a, Show b) => Show (RelationMS a b)

instance Category RelationMS where
    type Object RelationMS o = Ord o
    id = IdRMS
    RMS mp2 . RMS mp1
      | M.null mp2 || M.null mp1 = RMS M.empty
      | otherwise = RMS $ M.foldrWithKey 
            (\k s acc -> M.insert k (S.foldr (\x acc2 -> case M.lookup x mp2 of
                                                        Nothing -> acc2
                                                        Just s2 -> S.union s2 acc2
                                             ) S.empty s
                                    ) acc
            ) M.empty mp1

(°) :: (Object k a, Object k b, Object k c, Category k) => k a b -> k b c -> k a c
r1 ° r2 = r2 . r1

instance (Ord a, Ord b) => Semigroup (RelationMS a b) where
    RMS r1 <> RMS r2 = RMS $ M.foldrWithKey (\k s acc -> M.insertWith S.union k s acc) r1  r2 

instance (Ord a, Ord b) => Monoid (RelationMS a b) where
    mempty = RMS M.empty
    mappend = (<>)

instance Functor (RelationMS a) (ConstrainedCategory (->) Ord) Hask where
    fmap (ConstrainedMorphism f) = ConstrainedMorphism $
            \(RMS r) -> RMS $ M.map (S.map f) r


fldl :: (a -> Set b -> a) -> a -> RelationMS k b -> a
fldl f acc (RMS r) = M.foldl f acc r

fldMp :: Monoid b1 => (Set b2 -> b1) -> RelationMS k b2 -> b1
fldMp m (RMS r) = M.foldr (mappend . m) mempty r


-- instance Foldable (RelationMS a) (ConstrainedCategory (->) Ord) Hask where
    -- foldMap f (RMS r)
        -- | M.null r = mempty
        -- | otherwise = FL.foldMap f r
    -- ffoldl f = uncurry $ M.foldl (curry f)

Answer 1

您的定义中需要 FL.foldMap (FL.foldMap f) r，以便将 Map 和折叠到 Set。

但是，您的 Functor 实例中存在严重错误；你的 fmap 是部分的。它没有在 IdRMS.

上定义

我建议使用 -Wall 让编译器警告您此类问题。

问题归结为您需要能够表示有限域和无限域之间的关系。 IdRMS :: RelationRMS a a 已经可以用来表示一些无限域的关系，它还不够强大，无法表示像 fmap (\x -> [x]) IdRMS.

这样的关系

一种方法是对有限关系使用 Map a (Set b)，对无限关系使用 a -> Set b。

data Relation a b where
   Fin :: Map a (Set b) -> Relation a b
   Inf :: (a -> Set b) -> Relation a b

image :: Relation a b -> a -> Set b
image (Fin f) a = M.findWithDefault (S.empty) a f
image (Inf f) a = f a

这会相应地更改类别实例：

instance Category Relation where
  type Object Relation a = Ord a

  id = Inf S.singleton

  f . Fin g = Fin $ M.mapMaybe (nonEmptySet . concatMapSet (image f)) g
  f . Inf g = Inf $ concatMapSet (image f) . g

nonEmptySet :: Set a -> Maybe (Set a)
nonEmptySet | S.null s = Nothing
            | otherwise = Just s

concatMapSet :: Ord b => (a -> Set b) -> Set a -> Set b
concatMapSet f = S.unions . fmap f . S.toList

现在您可以定义总共 Functor 个实例：

instance Functor (Relation a) (Ord ⊢ (->)) Hask where
  fmap (ConstrainedMorphism f) = ConstrainedMorphism $ \case -- using {-# LANGUAGE LambdaCase #-}
    Fin g -> Fin $ fmap (S.map f) g
    Inf g -> Inf $ fmap (S.map f) g

但是在定义 Foldable 实例时出现了一个新问题：

instance Foldable (Relation a) (Ord ⊢ (->)) Hask where
  foldMap (ConstrainedMorphism f) = ConstrainedMorphism $ \case
    Fin g -> Prelude.foldMap (Prelude.foldMap f) g
    Inf g -> -- uh oh...problem!

我们有 f :: b -> m 和 g :: a -> Set b。 Monoid m 给我们 append :: m -> m -> m，我们知道 Ord a，但是为了生成关系图像中的所有 b 值，我们需要所有可能的 [=34] =]值！

您可以尝试挽救它的一种方法是使用 Bounded 和 Enum 作为关系域的附加约束。然后你可以尝试用 [minBound..maxBound] 枚举所有可能的 a 值（这可能不会列出所有类型的每个值；我不确定这是否是 Bounded 和 Enum).

instance (Enum a, Bounded a) => Foldable (Relation a) (Ord ⊢ (->)) Hask where
  foldMap (ConstrainedMorphism f) = ConstrainedMorphism $ \case
    Fin g -> Prelude.foldMap (Prelude.foldMap f) g
    Inf g -> Prelude.foldMap (Prelude.foldMap f . g) [minBound .. maxBound]

如何定义Data.Foldable.Constrained的实例？

How to define an instance of Data.Foldable.Constrained?

haskell

category-abstractions