(.) :: 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)
{ 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)
= 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)
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)
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
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)
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)
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 ܧଓ ' " 9ˠ"ͷͱ͖ɺ$14ม
-> 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 ଘࡏྔԽ
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) 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)
=> 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))
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
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
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 ࢀߟɿϓϩάϥϚͷͨΊͷϞφυ ݍ https://speakerdeck.com/inamiy/number-cat4pg
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
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
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))
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)
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)
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
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)
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
≅ 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
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(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
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
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
clonn
rainerhahnekamp
syumai
chiroruxx
chrisbanes
m_seki
kutakutat
blueswen
oekazuma
chobishiba
yoshifumi_ishikura
kazatohiei
danielanewman
cassininazir
lynnandtonic
aleyda
maggiecrowley
bcantrill
irinanazarova
lauravandoore
soudai
jnunemaker
tammyeverts
erikaheidi
![makeGrid :: [Pos] -> Grid makeGrid xs = Store (`elem`](https://files.speakerdeck.com/presentations/4494137eae6342bf9b0d841bafca3f7c/slide_52.jpg){kind=link}
