如何定义Control.Functor.Constrained的实例?
How to define an instance of Control.Functor.Constrained?
在成功定义 Category.Constrained 的实例后,我正在尝试定义 Functor.Constrained 的实例。但是 Functor.Constrained fmap 的类型很复杂,我所做的尝试导致了一个我无法解释的错误。 fmap类型需要的所有对象怎么定义?
Control.Functor.Constrained
fmap :: (Object r a, Object t (f a), Object r b, Object t (f b)) => r a b -> t (f a) (f b)
http://hackage.haskell.org/package/constrained-categories-0.3.1.1
{-# LANGUAGE GADTs, TypeFamilies, ConstraintKinds #-}
module Question1 where
import Control.Category.Constrained
import Control.Functor.Constrained as FC
import Data.Map as M
import Data.Set as S
data RelationMS a b where
IdRMS :: RelationMS a a
RMS :: Map a (Set b) -> RelationMS a b
instance Category RelationMS where
type Object RelationMS o = Ord o
id = IdRMS
(.) = compRMS
compRMS :: (Ord a, Ord k, Ord b) => RelationMS k b -> RelationMS a k -> RelationMS a b
RMS mp2 `compRMS` 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
pseudoFmap :: Ord c => (b -> c) -> RelationMS a b -> RelationMS a c
pseudoFmap f (RMS r) = RMS $ M.map (S.map f) r
instance FC.Functor RelationMS where
-- error: ‘Object’ is not a (visible) associated type of class ‘Functor’
type Object RelationMS o = Ord o
fmap f (RMS r) = pseudoFmap f (RMS r)
------------检查建议的解决方案--------
instance (Show a, Show b) => Show (RelationMS a b) where
show (IdRMS) = "IdRMS"
show (RMS r) = show r
> FC.fmap (+1) (RMS $ M.fromList [(1,S.fromList [10,20]), (2,S.fromList [30,40])])
> fromList [(1,fromList [11,21]),(2,fromList [31,41])]
你可能不是想把 RelationMS
变成 Functor
(它可以变成一个,但不能和 constrained-categories
一起)。你的意思是让 RelationMS a
成为所有 a
的 Functor
;你想要Functor (RelationMS a)
。此外,Functor
存在于两个 Category
之间,因此您必须定义 RelationMS a
是 Functor
之间的 Category
。源类别为<a href="https://hackage.haskell.org/package/constrained-categories-0.3.1.1/docs/Control-Category-Constrained.html" rel="nofollow noreferrer">ConstrainedCategory</a>(->)Ord
,输出类别为(->)
。然而,有一个 "default" instance Prelude.Functor f => FC.Functor f (->) (->)
实例停止 instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) (->)
工作,因为 fundep 冲突。定义这个 newtype
newtype Fun a b = Fun { runFun :: a -> b }
instance Category Fun where
id = Fun Prelude.id
Fun f . Fun g = Fun (f Prelude.. g)
满足 Functor
的两个超类,第三个满足 Object Fun o = ()
。所以,你得到
instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) Fun where
fmap = Fun Prelude.. pseudoFmap Prelude.. unconstrained
{-# LANGUAGE GADTs, TypeFamilies, ConstraintKinds, FlexibleInstances
, MultiParamTypeClasses, StandaloneDeriving #-}
module Question1 where
import Prelude hiding (($))
import Control.Category.Constrained
import Control.Functor.Constrained as FC
import Control.Arrow.Constrained (($))
import Data.Map as M
import Data.Set as S
import Data.Constraint.Trivial
main :: IO ()
main = print $ FC.fmap f
$ RMS (M.fromList [(1,S.fromList [11,21]),(2,S.fromList [31,41])])
where f :: ConstrainedCategory (->) Ord Int Int
f = constrained (+1)
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
(.) = compRMS
compRMS :: (Ord a, Ord k, Ord b) => RelationMS k b -> RelationMS a k -> RelationMS a b
RMS mp2 `compRMS` 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
pseudoFmap :: Ord c => (b -> c) -> RelationMS a b -> RelationMS a c
pseudoFmap f (RMS r) = RMS $ M.map (S.map f) r
instance FC.Functor (RelationMS a)
(ConstrainedCategory (->) Ord)
(ConstrainedCategory (->) Unconstrained) where
fmap (ConstrainedMorphism f) = ConstrainedMorphism $
\(RMS r) -> pseudoFmap f (RMS r)
RMS (fromList [(1,fromList [12,22]),(2,fromList [32,42])])
顺便说一句,您可以使用句法扩展使这些映射和集合的定义更容易 type/read:
{-# LANGUAGE OverloadedLists #-}
main :: IO ()
main = print $ FC.fmap f $ RMS [(1, [11,21]),(2, [31,41])]
where f :: ConstrainedCategory (->) Ord Int Int
f = constrained (+1)
谈论语法糖:使用constrained-categories>=0.4
,您还可以缩短类型签名
{-# LANGUAGE TypeOperators #-}
main = print $ FC.fmap f
$ RMS (M.fromList [(1,S.fromList [11,21]),(2,S.fromList [31,41])])
where f :: (Ord⊢(->)) Int Int
f = constrained (+1)
甚至完全省略它,而是在 constrained
:
上使用 type application 指定约束
{-# LANGUAGE TypeApplications, OverloadedLists #-}
main :: IO ()
main = print $ FC.fmap (constrained @Ord (+1))
$ RMS ([(1,[11,21]),(2,[31,41])])
此外,oxymoronic-looking ConstrainedCategory (->) Unconstrained
现在有了同义词 Hask
,因此您可以将实例头简化为
instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) Hask
在成功定义 Category.Constrained 的实例后,我正在尝试定义 Functor.Constrained 的实例。但是 Functor.Constrained fmap 的类型很复杂,我所做的尝试导致了一个我无法解释的错误。 fmap类型需要的所有对象怎么定义?
Control.Functor.Constrained
fmap :: (Object r a, Object t (f a), Object r b, Object t (f b)) => r a b -> t (f a) (f b)
http://hackage.haskell.org/package/constrained-categories-0.3.1.1
{-# LANGUAGE GADTs, TypeFamilies, ConstraintKinds #-}
module Question1 where
import Control.Category.Constrained
import Control.Functor.Constrained as FC
import Data.Map as M
import Data.Set as S
data RelationMS a b where
IdRMS :: RelationMS a a
RMS :: Map a (Set b) -> RelationMS a b
instance Category RelationMS where
type Object RelationMS o = Ord o
id = IdRMS
(.) = compRMS
compRMS :: (Ord a, Ord k, Ord b) => RelationMS k b -> RelationMS a k -> RelationMS a b
RMS mp2 `compRMS` 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
pseudoFmap :: Ord c => (b -> c) -> RelationMS a b -> RelationMS a c
pseudoFmap f (RMS r) = RMS $ M.map (S.map f) r
instance FC.Functor RelationMS where
-- error: ‘Object’ is not a (visible) associated type of class ‘Functor’
type Object RelationMS o = Ord o
fmap f (RMS r) = pseudoFmap f (RMS r)
------------检查建议的解决方案--------
instance (Show a, Show b) => Show (RelationMS a b) where
show (IdRMS) = "IdRMS"
show (RMS r) = show r
> FC.fmap (+1) (RMS $ M.fromList [(1,S.fromList [10,20]), (2,S.fromList [30,40])])
> fromList [(1,fromList [11,21]),(2,fromList [31,41])]
你可能不是想把 RelationMS
变成 Functor
(它可以变成一个,但不能和 constrained-categories
一起)。你的意思是让 RelationMS a
成为所有 a
的 Functor
;你想要Functor (RelationMS a)
。此外,Functor
存在于两个 Category
之间,因此您必须定义 RelationMS a
是 Functor
之间的 Category
。源类别为<a href="https://hackage.haskell.org/package/constrained-categories-0.3.1.1/docs/Control-Category-Constrained.html" rel="nofollow noreferrer">ConstrainedCategory</a>(->)Ord
,输出类别为(->)
。然而,有一个 "default" instance Prelude.Functor f => FC.Functor f (->) (->)
实例停止 instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) (->)
工作,因为 fundep 冲突。定义这个 newtype
newtype Fun a b = Fun { runFun :: a -> b }
instance Category Fun where
id = Fun Prelude.id
Fun f . Fun g = Fun (f Prelude.. g)
满足 Functor
的两个超类,第三个满足 Object Fun o = ()
。所以,你得到
instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) Fun where
fmap = Fun Prelude.. pseudoFmap Prelude.. unconstrained
{-# LANGUAGE GADTs, TypeFamilies, ConstraintKinds, FlexibleInstances
, MultiParamTypeClasses, StandaloneDeriving #-}
module Question1 where
import Prelude hiding (($))
import Control.Category.Constrained
import Control.Functor.Constrained as FC
import Control.Arrow.Constrained (($))
import Data.Map as M
import Data.Set as S
import Data.Constraint.Trivial
main :: IO ()
main = print $ FC.fmap f
$ RMS (M.fromList [(1,S.fromList [11,21]),(2,S.fromList [31,41])])
where f :: ConstrainedCategory (->) Ord Int Int
f = constrained (+1)
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
(.) = compRMS
compRMS :: (Ord a, Ord k, Ord b) => RelationMS k b -> RelationMS a k -> RelationMS a b
RMS mp2 `compRMS` 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
pseudoFmap :: Ord c => (b -> c) -> RelationMS a b -> RelationMS a c
pseudoFmap f (RMS r) = RMS $ M.map (S.map f) r
instance FC.Functor (RelationMS a)
(ConstrainedCategory (->) Ord)
(ConstrainedCategory (->) Unconstrained) where
fmap (ConstrainedMorphism f) = ConstrainedMorphism $
\(RMS r) -> pseudoFmap f (RMS r)
RMS (fromList [(1,fromList [12,22]),(2,fromList [32,42])])
顺便说一句,您可以使用句法扩展使这些映射和集合的定义更容易 type/read:
{-# LANGUAGE OverloadedLists #-}
main :: IO ()
main = print $ FC.fmap f $ RMS [(1, [11,21]),(2, [31,41])]
where f :: ConstrainedCategory (->) Ord Int Int
f = constrained (+1)
谈论语法糖:使用constrained-categories>=0.4
,您还可以缩短类型签名
{-# LANGUAGE TypeOperators #-}
main = print $ FC.fmap f
$ RMS (M.fromList [(1,S.fromList [11,21]),(2,S.fromList [31,41])])
where f :: (Ord⊢(->)) Int Int
f = constrained (+1)
甚至完全省略它,而是在 constrained
:
{-# LANGUAGE TypeApplications, OverloadedLists #-}
main :: IO ()
main = print $ FC.fmap (constrained @Ord (+1))
$ RMS ([(1,[11,21]),(2,[31,41])])
此外,oxymoronic-looking ConstrainedCategory (->) Unconstrained
现在有了同义词 Hask
,因此您可以将实例头简化为
instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) Hask