Как определить экземпляр Control.Functor.Constrained? - PullRequest
Новая
       35

Как определить экземпляр Control.Functor.Constrained?

2 голосов
/ 01 июня 2019

Я пытаюсь определить экземпляр Functor.Constrained после успешного определения экземпляра Category.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])]

Ответы [ 2 ]

2 голосов
/ 02 июня 2019 
{-# 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])])

Кстати, вы можете сделать определения этих карт и наборов проще для ввода / чтения с помощью синтаксического расширения: 

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

или даже полностью ее опустить и вместо этого указать ограничение с помощью приложения type on constrained: 

{-# LANGUAGE TypeApplications, OverloadedLists #-}
main :: IO ()
main = print $ FC.fmap (constrained @Ord (+1))
              $ RMS ([(1,[11,21]),(2,[31,41])])

Кроме того, теперь есть синоним Hask для оксюморонного вида ConstrainedCategory (->) Unconstrained, так что вы можете упростить заголовок экземпляра до 

instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) Hask
2 голосов
/ 01 июня 2019

Вы, вероятно, не хотите сделать RelationMS a Functor (это можно сделать один, но не с constrained-categories). Вы хотите сделать RelationMS a a Functor для всех a; Вы хотите Functor (RelationMS a). Кроме того, Functor s существует между двумя Category s, поэтому вы должны определить Category s, между которыми RelationMS a является Functor. Категория источника - <a href="https://hackage.haskell.org/package/constrained-categories-0.3.1.1/docs/Control-Category-Constrained.html" rel="nofollow noreferrer">ConstrainedCategory</a> (->) Ord, а категория вывода - (->). Однако существует экземпляр по умолчанию 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
...