[英]Haskell :How to define an instance of the constructor class Foldable for the constructor
[英]How to define an instance of Data.Foldable.Constrained?
我已經成功定義了類別,函子,半群,Monoid約束。 現在,我陷入了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)
您需要在定義中使用FL.foldMap (FL.foldMap f) r
,以便在Map
和 Set
折疊。
但是,您的Functor
實例中存在嚴重錯誤。 您的fmap
是不完整的。 沒有在IdRMS
定義。
我建議使用-Wall
來讓編譯器警告您此類問題。
問題歸結為您需要能夠表示具有有限域和無限域的關系。 IdRMS :: RelationRMS aa
已經可以用來表示無限域的某些關系,它不足以表示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
值,我們需要所有可能的a
值!
您可以嘗試解決此問題的一種方法是將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]
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.