ݍͷఆٛ -- ߃ࣹ id :: a -> a id a = a -- ࣹͷ߹ (.) :: (b -> c) -> (a -> b) -> (a -> c) f . g = \x -> f (g x) ୯Ґ๏ଇ id ∘ f ≅ f ∘ id ≅ f (f ∘ g) ∘ h ≅ f ∘ (g ∘ h) ݁߹๏ଇ
ܕΫϥεΛͬͨݍͷఆٛ class Category cat where id :: cat a a (.) :: cat b c -> cat a b -> cat a c -- ʮܕʯͱʮؔ (->)ʯͷݍ (Hask) instance Category (->) where id :: (->) a a -- a -> a ͱಉ͡ id a = a (.) :: (->) b c -> (->) a b -> (->) a c f . g = \x -> f (g x)
ݍͷྫɿΫϥΠεϦݍ -- ΫϥΠεϦࣹ newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b } -- ΫϥΠεϦݍ instance Monad m => Category (Kleisli m) where id :: (Kleisli m) a a id = Kleisli pure -- Note: (<=<) ͱಉ͡ (.) :: (Kleisli m) b c -> (Kleisli m) a b -> (Kleisli m) a c f . g = Kleisli (\x -> runKleisli g x >>= runKleisli f)
ݍͷྫɿϨϯζݍ -- Ϩϯζɿੵσʔλߏͷ getter & setter data Lens a b = Lens (a -> b) (a -> b -> a) -- Ϩϯζݍ instance Category Lens where id :: Lens a a id = Lens Prelude.id (const Prelude.id) (.) :: Lens b c -> Lens a b -> Lens a c Lens g1 s1 . Lens g2 s2 = Lens (g1 Prelude.. g2) s3 where s3 a c = s2 a (s1 (g2 a) c)
ؔख class (Category c, Category d) => Functor' c d f where fmap' :: c a b -> d (f a) (f b) -- Functorଇ -- fmap' id = id -- fmap' (g . h) = fmap' g . fmap' h -- Πϯελϯεྫ instance Functor' (->) (->) Maybe where fmap' _ Nothing = Nothing fmap' f (Just a) = Just (f a)
-- (Endo)Functor == Functor' (->) (->) class Functor f where fmap :: (a -> b) -> f a -> f b instance Functor Maybe where fmap _ Nothing = Nothing fmap f (Just a) = Just (f a) )BTLFMMʹ͓͚Δ'VODUPSɺ )BTLݍ ࣹ͕ʮʯ ʹ͓͚Δࣗݾؔख &OEPGVODUPS
ؔखݍͱࣗવม newtype f :~> g = NT { unNT :: forall x. f x -> g x } -- ର͕ؔखɺࣹ͕ࣗવมͷؔखݍ instance Category (:~>) where id :: a :~> a id = NT Prelude.id (.) :: (b :~> c) -> (a :~> b) -> (a :~> c) -- ਨ߹ NT f . NT g = NT (f Prelude.. g)
ࣗવมͷྫɿଟ૬ؔ head' :: List :~> Maybe -- List a -> Maybe a head' = NT $ \case Nil' -> Nothing Cons' a _ -> Just a length' :: List :~> Const Int -- List a -> Int length' = NT $ \case Nil' -> Const 0 Cons' _ as -> Const $ 1 + getConst (unNT length' as)
ถాͷิ newtype Yoneda f a = Yoneda { runYoneda :: forall b. (a -> b) -> f b } instance Functor (Yoneda f) where fmap f m = Yoneda (\k -> runYoneda m (k . f)) -- Yoneda f a ≅ f a liftYoneda :: Functor f => f a -> Yoneda f a lowerYoneda :: Yoneda f a -> f a Nat(Hom(A, − ), F) ≅ F(A) ' " "ͷͱ͖ɺ$14 ܧଓ
ถాͷݪཧͷྫɿܕܭࢉ ≅ Hom(X × C, AB) (AB)C ≅ A(B×C) Hom(X, (AB)C) ≅ Hom((X × C) × B, A) ≅ Hom(X × (B × C), A) ≅ Hom(X, A(B×C)) A × (B + C) ≅ (A × B) + (A × C) (A × B)C ≅ AC × BC A(B+C) ≅ AB × AC ͦͷଞɺ ͳͲ
data Coyoneda f a where Coyoneda :: (z -> a) -> f z -> Coyoneda f a instance Functor (Coyoneda f) where fmap f (Coyoneda g v) = Coyoneda (f . g) v -- Coyoneda f a ≅ f a liftCoyoneda :: f a -> Coyoneda f a lowerCoyoneda :: Functor f => Coyoneda f a -> f a ∫ Z F(Z) × Hom(Z, A) ≅ F(A) MJGU࣌ʹ'VODUPS͕ඞཁͳ͍ͷͰ ҙͷGΛ$PZPOFEBؔखͱͯ͠ѻ͑Δ ͋Δ;͕ଘࡏ $PFOE
ଘࡏྔԽ
class (Functor f, Functor u) => Adjunction f u where unit :: a -> u (f a) counit :: f (u a) -> a leftAdjunct :: (f a -> b) -> a -> u b rightAdjunct :: (a -> u b) -> f a -> b unit = leftAdjunct id counit = rightAdjunct id leftAdjunct f = fmap f . unit rightAdjunct f = counit . fmap f -- unit ͱ counit ·ͨ leftAdjunct ͱ rightAdjunct ͷ࣮͕ඞཁ
-- B × ? ⊣ (?)^B instance Adjunction ((,) b) ((->) b) where -- curry leftAdjunct :: ((b, a) -> c) -> a -> b -> c leftAdjunct f a b = f (b, a) -- uncurry rightAdjunct :: (a -> b -> c) -> (b, a) -> c rightAdjunct f (b, a) = f a b Hom(A × B, C) ≅ Hom(A, CB)
ਵͷྫɿΫϥΠεϦݍͷຒΊࠐΈؔख⊣֦ுؔख class (Functor' c d f, Functor' d c u) => Adjunction' c d f u where leftAdjunct' :: d (f a) b -> c a (u b) rightAdjunct' :: c a (u b) -> d (f a) b instance Monad m => Functor' (->) (Kleisli m) Identity where fmap' :: (a -> b) -> Kleisli m (Identity a) (Identity b) fmap' f = Kleisli $ fmap Identity . (pure . f . runIdentity) instance Monad m => Functor' (Kleisli m) (->) m where fmap' :: Kleisli m a b -> m a -> m b fmap' k = (Prelude.=<<) (runKleisli k) instance Monad m => Adjunction' (->) (Kleisli m) Identity m where leftAdjunct' :: Kleisli m (Identity a) b -> a -> m b leftAdjunct' k a = runKleisli k (Identity a) rightAdjunct' :: (a -> m b) -> Kleisli m (Identity a) b rightAdjunct' f = Kleisli $ f . runIdentity HomCT (A, B) ≅ HomC (A, M(B))
Cat H G RanG H σ A B F ∘ G ε (RanG H) ∘ G σG (ε ∘ σG )B σA F F(G(B)) H(B) F(A) (RanG H)(A) B A C fromRan toRan toRan :: Functor f => (forall b . f (g b) -> h b) -> f a -> Ran g h a fromRan :: (forall a . f a -> Ran g h a) -> f (g b) -> h b
-- ӈKan֦ுʢۃݶɺӈਵɺYonedaʣɺF = Hom(a,-) ͱ͓͘ newtype Ran g h a = Ran { runRan :: forall b. (a -> g b) -> h b } yonedaToRan :: Yoneda f a -> Ran Identity f a ranToYoneda :: Ran Identity f a -> Yoneda f a adjunctionToCodensity :: Adjunction f g => g (f a) -> Codensity g a codensityToRan :: Codensity g a -> Ran g g a ranToCodensity :: Ran g g a -> Codensity g a codensityToAdjunction :: Adjunction f g => Codensity g a -> g (f a) -- ࠨKan֦ுʢ༨ۃݶɺࠨਵɺCoyonedaʣ data Lan g h a where Lan ::(g b -> a) -> h b -> Lan g h a
Ϟφυ class Applicative m => Monad m where join :: m (m a) -> m a -- μ: M^2 -> M join x = x >>= id (>>=) :: m a -> (a -> m b) -> m b m >>= f = join (fmap f m) return :: a -> m aɹ-- η: 1 -> M return = pure ࢀߟɿϓϩάϥϚͷͨΊͷϞφυ ݍ
class Adjunction f u => Monad' f u where return' :: a -> u (f a) -- η: 1 -> M join' :: u (f (u (f a))) -> u (f a) -- μ: M^2 -> M -- ྫɿf = (s, ?), u = s -> ?, uf = s -> (s, ?) = StateϞφυ instance Monad' ((,) s) ((->) s) where return' :: a -> (s -> (s, a)) return’ a s = (s, a) -- == unit join' :: (s -> (s, (s -> (s, a)))) -> (s -> (s, a)) join' f s = f' s' where (s', f') = f s
ίϞφυ -- ແݶͷू߹͔ΒͳΔঢ়ଶۭؒͱɺݱࡏҐஔΛ࣋ͭΠϝʔδ class Functor w => Comonad w where extract :: w a -> a -- ݱࡏҐஔͷঢ়ଶΛऔಘ -- ݱࡏҐஔΛશύλʔϯͣΒͭͭ͠ɺঢ়ଶۭؒΛͯ͢ෳ duplicate :: w a -> w (w a) duplicate = extend id extend :: (w a -> b) -> w a -> w b extend f = fmap f . duplicate w ΠϯελϯεྫɿNonEmptyList, Stream, RoseTree, Zipper, Moore w ར༻ྫɿը૾ϑΟϧλɺϥΠϑήʔϜͳͲͷΈࠐΈԋࢉɺ3FBDU$PNQPOFOU
class Adjunction f u => Comonad' f u where extract' :: f (u a) -> a — ε: W -> 1 duplicate' :: f (u a) -> f (u (f (u a))) -- δ: W -> W^2 -- ྫɿf = (s, ?), u = s -> ?, fu = (s, s -> ?) = StoreίϞφυ instance Comonad' ((,) s) ((->) s) where extract' :: (s, s -> a) -> a extract' (s, f) = f s -- == counit duplicate' :: (s, s -> a) -> (s, s -> (s, s -> a)) duplicate' (s, f) = (s, \s -> (s, f))
ΞϓϦΧςΟϒ-BY.POPJEBM'VODUPSXJUITUSFOHUI class Functor f => Applicative f where unit :: f () -- ≅ () -> f () zip :: f a -> f b -> f (a, b) F : C → D η : 1D → F(1C ) μA,B : F(A) ⊗D F(B) → F(A ⊗C B) stx,y : A ⊗ F(B) → F(A ⊗ B)
ΞϓϦΧςΟϒؔख class Functor f => Applicative f where unit :: f () unit = pure () zip :: f a -> f b -> f (a, b) zip = liftA2 (,) -- f () ≅ forall a. (() -> a) -> f a (by Yoneda) pure :: a -> f a pure a = fmap (const a) unit liftA2 :: (a -> b -> c) -> f a -> f b -> f c liftA2 f fa fb = fmap (uncurry f) (zip fa fb)
%BZ$POWPMVUJPO data Day f g a = forall b c. Day (f b) (g c) (b -> c -> a) -- f == g ͷͱ͖ɺDay liftA2 (≒ Applicative) ͱ΄΅ಉ͡ dap :: Applicative f => Day f f a -> f a dap (Day fb fc abc) = liftA2 abc fb fc day :: f (a -> b) -> g a -> Day f g b day fa gb = Day fa gb id -- f == g ͷͱ͖ɺ (<*>) :: f (a -> b) -> f a -> f b (F ⊗Day G)(A) = ∫ B ∫ C F(B) × G(C) × Hom(B × C, A)
1SPGVODUPS -- C = D = Hask class Profunctor p where dimap :: (c' -> c) -> (d -> d') -> p c d -> p c' d' -- unzip :: p c (d, d') -> (p c d, p c d') -- unzip p = ((dimap id fst) p, (dimap id snd) p) -- unzipEither :: p (Either c c') d -> (p c d, p c' d) -- unzipEither p = ((dimap Left id) p, (dimap Right id) p) P : Cop × D → Set C ↛ D or
4USPOH$IPJDF1SPGVODUPS class Profunctor p => StrongProfunctor p where -- (×) strength first' :: p a b -> p (a, z) (b, z) class Profunctor p => ChoiceProfunctor p where -- (+) strength left' :: p a b -> p (Either a z) (Either b z) stA,B,Z = P(A, B) → P(A ⊗ Z, B ⊗ Z)
"SSPX w Πϯελϯεྫɿ , Kleisli m, Cokleisli w, Mealy w ར༻ྫɿฒྻॲཧɺ"SSPXCBTFEGVODUJPOBMSFBDUJWFQSPHSBNNJOH -- Note: Arrow StrongProfunctor ʹϞϊΠυରΛՃ͑ͨͷͱΈͳͤΔ class Category a => Arrow a where arr :: (b -> c) -> a b c -- η: Hom :-> a -- (.) :: a z c -> a b z -> a b c -- μ: a^2 :-> a first :: a b c -> a (b, z) (c, z) -- strength -- (&&&) :: a z b -> a z b' -> a z (b, b') -- Arrow + ChoiceProfunctor class Arrow a => ArrowChoice a where left :: a b c -> a (Either b z) (Either c z) -- (|||) :: a b z -> a b’ z -> a (Either b b’) z
1SPGVODUPS"SSPXͷྫɿੵɾͷීวੑ Hom( − , A) × Hom( − , B) ≅ Hom( − , A × B) Hom(A, − ) × Hom(B, − ) ≅ Hom(A + B, − ) "SSPX ͱ1SPGVODUPS VO[JQ ͔Β (x -> a, x -> b) ≅ x -> (a, b) "SSPX$IPJDF ccc ͱ1SPGVODUPS VO[JQ&JUIFS ͔Β (a -> x, b -> x) ≅ Either a b -> x
1SPGVODUPS0QUJDT ProfOptic((A, B), (S, T)) = [Prof, Set]( − (A, B), − (S, T)) type Optic p s t a b = p a b -> p s t type Iso s t a b = forall p . Profunctor p => Optic p s t a b type Lens s t a b = forall p . Strong p => Optic p s t a b type Prism s t a b = forall p . Choice p => Optic p s t a b type AffineTraversal s t a b = forall p . (Strong p, Choice p) => Optic p s t a b
F(Fix(F)) Fix(F) F(A) A F(Fix(F)) Fix(F) F(A + Fix(F)) A F(Fix(F)) Fix(F) F(Fix(F) × A) A F(Fix(F)) Fix(F) F(A) A $BUBNPSQIJTN "OBNPSQIJTN 1BSBNPSQIJTN "QPNPSQIJTN In out In out out In out In g g cata(g) para(g) g F(cata(g)) F(id × para(g)) F(id + apo(g)) apo(g) ana(g) g F(ana(g)) cata ana para apo
data Fix f = In { out :: f (Fix f) } cata :: Functor f => (f a -> a) -> Fix f -> a cata g = g . fmap (cata g) . out para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a para g = g . fmap (id &&& para g) . out ana :: Functor f => (a -> f a) -> a -> Fix f ana g = In . fmap (ana g) . g apo :: Functor f => (a -> f (Either (Fix f) a)) -> a -> Fix f apo g = In . fmap (id ||| apo g) . g
ࢀߟจݙ w $BUFHPSZ5IFPSZGPS1SPHSBNNFST w ݍcұେҬ w .POBET.BEF%JGpDVMU w )BTLFMMͱਵ2JJUB w LBOFYUFOTJPOT w $ISJT1FOOFSDPOXBZ w (FOFSBMJTJOH.POBETUP"SSPXT w "SSPXT"(FOFSBM*OUFSGBDFUP$PNQVUBUJPO w %POU'FBSUIF1SPGVODUPS0QUJDT w 8IBU:PV/FFEB,OPXBCPVU:POFEB 1SPGVODUPS0QUJDTBOEUIF:POFEB-FNNB w 1SPGVODUPS0QUJDT.PEVMBS%BUB"DDFTTPST w $BUFHPSJFTPG0QUJDT w 'VODUJPOBM1SPHSBNNJOHXJUI#BOBOBT
-FOTFT
&OWFMPQFTBOE#BSCFE8JSF w $VSTFFYQMJDJUSFDVSTJPO w 3FDVSTJPO4DIFNFTIBTLFMMTIPFO w "%VBMJUZPG4PSUT
inamiy
gishi_yama
ogijun2018
ogiwarat
77web
rubhanazeem
torounit
hagatake
myahagi
hirotokirimaru
syumai
akatsuki174
konokenj
tmm1
destraynor
cherdarchuk
eitanlees
thoeni
ddemaree
skipperchong
malarkey
maltzj
tanoku
jeffersonlam
matthewcrist