圏論とプログラミング / Category Theory and Programming

Slide 1

Slide 1 text

ݍ࿦ͱ ϓϩάϥϛϯά 2020/01/25 γϯϙδ΢Ϝ ʮݍ࿦తੈք૾͔Β͸͡·Δෳ߹஌ͷల๬ʯ Yasuhiro Inami / @inamiy

Slide 2

Slide 2 text

Ҵݟହ޺ J04ΞϓϦ։ൃऀɾϑϦʔϥϯε w 1)1 +BWB4DSJQU 8FC੍࡞ w 0CKFDUJWF$ +BWB J04ΞϓϦɺαʔόʔαΠυ։ൃ w 4XJGU )BTLFMM J04ɺझຯ w ݍ࿦

Slide 3

Slide 3 text

J04%$ ݍ࿦ͱ4XJGU΁ͷԠ༻ IUUQTTQFBLFSEFDLDPNJOBNJZJPTEDKBQBO ϓϩάϥϚͷͨΊͷݍ࿦ษڧձ ϓϩάϥϚͷͨΊͷϞφυ ݍ࿦ IUUQTTQFBLFSEFDLDPNJOBNJZOVNCFSDBUQH J04%$ 4XJGUͱ࿦ཧʙͦͯ͠ؼ͖ͬͯͨݍ࿦ʙ IUUQTTQFBLFSEFDLDPNJOBNJZTXJGUBOEMPHJD BOEDBUFHPSZUIFPSZ

Slide 4

Slide 4 text

2ϓϩάϥϚʔ͸ ʮݍ࿦ʯΛֶΜͩํ͕ྑ͍ʁ

Slide 5

Slide 5 text

ϓϩάϥϛϯάݴޠͷมભ ೥୅ͷݴޠ ΠϯλʔωοτීٴظɺαʔόʔαΠυ։ൃ w 1ZUIPO w 3VCZ w +BWB w +BWB4DSJQU w 1)1 ೥୅ͷݴޠ εϚʔτϑΥϯීٴظɺϑϩϯτΤϯυେن໛։ൃ w 3VTU w ,PUMJO w 5ZQF4DSJQU w 4XJGU

Slide 6

Slide 6 text

ۙ೥ͷϓϩάϥϛϯάݴޠʹڞ௨͍ͯ͠Δ͜ͱ w ੩తܕ෇͚ݴޠʴܕਪ࿦ w δΣωϦΫεʢଟ૬ੑʣ w ୅਺తσʔλܕʢ௚ੵɺ௚࿨ɺύλʔϯϚονϯάʣ w Ϟφυʢ0QUJPOBM 3FTVMU 'VUVSF 0CTFSWBCMF FUDʣ ؔ਺ܕϓϩάϥϛϯάͷ୆಄ʂ

Slide 7

Slide 7 text

)BTLFMM ۙ೥ͷϞμϯͳݴޠ͸ɺ)BTLFMMͷӨڹΛڧ͘ड͚͍ͯΔ

Slide 8

Slide 8 text

ݍ࿦ ਺ֶɺ࿦ཧֶɺ෺ཧֶɺܭࢉػՊֶͳͲɺ ͋Γͱ͋ΒΏΔֶ໰෼໺Ͱ༻͍ΒΕΔʮ໼ҹʯͷཧ࿦

Slide 9

Slide 9 text

ϓϩάϥϚʔ͕ݍ࿦ΛֶͿͱخ͍͜͠ͱ w ϓϩάϥϛϯάͷجૅཧ࿦ֶ͕΂Δ w ܕ෇͖Еܭࢉ˱࿦ཧֶ˱ݍ࿦ w ਺ֶͷجૅʢ୅਺ֶʣɺϞφυͳͲ w ࣮຿Ͱͷܕܭࢉɺઃܭɺந৅ԽͷεΩϧ্͕͕Δ w ࿦จ͕ಡΊΔΑ͏ʹͳΔ w কདྷͷྲྀߦΛҰ଍ઌʹΩϟονΞοϓͰ͖Δ &GGFDU4ZTUFN౳

Slide 10

Slide 10 text

ΞδΣϯμ wݍͷఆٛ wؔख wࣗવม׵ wถాͷิ୊ wਵ൐ w,BO֦ு wϞφυ ίϞφυ wΞϓϦΧςΟϒؔख w1SPGVODUPS "SSPX w0QUJDT -FOT w3FDVSTJPO4DIFNF

Slide 11

Slide 11 text

ݍͷఆٛ Deﬁnition of Category

Slide 12

Slide 12 text

ݍͷఆٛ -- ߃౳ࣹ 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) ݁߹๏ଇ

Slide 13

Slide 13 text

ܕΫϥεΛ࢖ͬͨݍͷఆٛ 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)

Slide 14

Slide 14 text

ݍͷྫɿΫϥΠεϦݍ -- ΫϥΠεϦࣹ 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)

Slide 15

Slide 15 text

ݍͷྫɿϨϯζݍ -- Ϩϯζɿ௚ੵσʔλߏ଄ͷ 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)

Slide 16

Slide 16 text

ؔख Functor

Slide 17

Slide 17 text

A f F(f) F(A) F(B) B C F(C) F C D g F(g) g ∘ f F(g ∘ f ) = F(g) ∘ F(f )

Slide 18

Slide 18 text

ؔख 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)

Slide 19

Slide 19 text

ࣗݾؔख &OEPGVODUPS -- (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

Slide 20

Slide 20 text

ؔखݍɾࣗવม׵ Functor Category, Natural Transformation

Slide 21

Slide 21 text

A B F f G F(A) F(B) G(A) G(B) F(f) G(f) α αA αB C D ؔखݍ DC

Slide 22

Slide 22 text

ؔखݍͱࣗવม׵ 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)

Slide 23

Slide 23 text

ࣗવม׵ͷྫɿଟ૬ؔ਺ 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)

Slide 24

Slide 24 text

ࣗવಉܕͷྫɿMaybe a ≅ 1 + a -- MaybeΛߏ੒͢Δ֤ίϯετϥΫλ nothing :: Const () :~> Maybe -- (() -> Maybe a) ≅ Maybe a just :: Identity :~> Maybe -- a -> Maybe a -- ؔखͷ௚࿨ data (f :+: g) e = InL (f e) | InR (g e) -- ࣗવಉܕɿ1 + a ≅ Maybe a toMaybe :: (Const () :+: Identity) :~> Maybe -- nothing + just fromMaybe :: Maybe :~> (Const () :+: Identity)

Slide 25

Slide 25 text

ถాͷิ୊ Yoneda Lemma

Slide 26

Slide 26 text

A B Hom(A, − ) f F Hom(A, A) … Hom(A, B) F(A) f … F(B) Hom(A, f ) = f ∘ − F(f ) α αA αB αA ★ idA … … ؔखݍ SetC C Set

Slide 27

Slide 27 text

ถాͷิ୊ 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 ܧଓ ' " 9ˠ"ͷͱ͖ɺ$14ม׵

Slide 28

Slide 28 text

ถాຒΊࠐΈ ถాͷݪཧ Hom( − , A) ≅ Hom( − , B) ⟺ A ≅ B Nat(Hom( − , A), Hom( − , B)) ≅ Hom(A, B) )PN͸ॆຬ஧࣮͔ͭର৅্୯ࣹ

Slide 29

Slide 29 text

ถాͷݪཧͷྫɿܕܭࢉ ≅ 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 ͦͷଞɺ ͳͲ

Slide 30

Slide 30 text

༨ถాͷิ୊ $PZPOFEB 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 ଘࡏྔԽ

Slide 31

Slide 31 text

ڞม:POFEB$PZPOFEB ൓ม:POFEB$PZPOFEB f' a ≅ ∀b. (b -> a) -> f' b f' a ≅ ∃b. (a -> b, f' b) f a ≅ ∀b. (a -> b) -> f b f a ≅ ∃b. (b -> a, f b)

Slide 32

Slide 32 text

ਵ൐ Adjunction

Slide 33

Slide 33 text

F U F(A) B A U(B) ≅ rightAdjunct leftAdjunct D C

Slide 34

Slide 34 text

F(A) B F U A U(B) F(U(B)) U(F(A)) f f F(f) U(f) ηA = unitA εB = counitB D C

Slide 35

Slide 35 text

ਵ൐ Gࠨਵ൐ Vӈਵ൐ 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 ͷ࣮૷͕ඞཁ

Slide 36

Slide 36 text

ਵ൐ͷྫɿ௚ੵ⊣ႈ DVSSZVODVSSZ -- 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)

Slide 37

Slide 37 text

ਵ൐ͷྫɿΫϥΠεϦݍ΁ͷຒΊࠐΈؔख⊣֦ுؔख 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))

Slide 38

Slide 38 text

,BO֦ு Kan Extension

Slide 39

Slide 39 text

Cat H A G RanG H F B C σ

Slide 40

Slide 40 text

Cat B C H ε ε ∘ σG F ∘ G (RanG H) ∘ G σG ≅ Мͱ(ͷਫฏ߹੒

Slide 41

Slide 41 text

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

Slide 42

Slide 42 text

− ∘ G RanG − F ∘ G H F RanG H ≅ fromRan toRan CB CA

Slide 43

Slide 43 text

,BO֦ு ۃݶɺਵ൐ɺถాΛؚΉɺશͯͷ֓೦ -- ӈ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

Slide 44

Slide 44 text

Ԡ༻ฤ

Slide 45

Slide 45 text

ϞφυɾίϞφυ Monad, Comonad

Slide 46

Slide 46 text

Ϟφυ 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 ࢀߟɿϓϩάϥϚͷͨΊͷϞφυ ݍ࿦ https://speakerdeck.com/inamiy/number-cat4pg

Slide 47

Slide 47 text

ਵ൐͔Β࡞ΔϞφυ .6' 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

Slide 48

Slide 48 text

F(C) F U C U(F(C)) ηC U(F(U(F(C)))) F(U(F(C))) ϵF(C) UϵF(C) D C Ϟφυ (return) (join)

Slide 49

Slide 49 text

ίϞφυ -- ແݶͷ఺ू߹͔ΒͳΔঢ়ଶۭؒͱɺݱࡏҐஔΛ࣋ͭΠϝʔδ 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

Slide 50

Slide 50 text

ਵ൐͔Β࡞ΔίϞφυ 8'6 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))

Slide 51

Slide 51 text

F U U(F(U(D))) U(D) F(U(D)) FηU(D) ηU(D) D C ίϞφυ D F(U(F(U(D)))) ϵD (extract) (duplicate)

Slide 52

Slide 52 text

-- ྫɿStoreίϞφυ ͱ ϥΠϑήʔϜ (ηϧΦʔτϚτϯ) data Store s a = Store (s -> a) s -- instance of Functor, Comonad, ComonadStore type Pos = (Int, Int) type Grid = Store Pos Bool neighbors :: Pos -> [Pos] neighbors (x, y) = [ (x + dx, y + dy) | dx <- [-1, 0, 1], dy <- [-1, 0, 1], (dx, dy) /= (0, 0) ] rule :: Grid -> Bool rule grid = neighborAlives == 3 || (neighborAlives == 2 && alive) where neighbors' = experiment neighbors grid neighborAlives = length $ filter id neighbors alive = extract grid

Slide 53

Slide 53 text

makeGrid :: [Pos] -> Grid makeGrid xs = Store (`elem` xs) (0, 0) showCells :: Grid -> IO () showCells grid = sequence_ [ write pos “#" | pos <- [ (i, j) | i <- [1 .. width], j <- [1 .. height] ] , peek pos grid ] playGameOfLife :: Grid -> IO () playGameOfLife grid = do clearScreen showCells grid playGameOfLife (extend rule grid) -- rule Λద༻ͯ͠࠶ؼ gliderDemo = [(0, 2), (1, 0), (1, 2), (2, 1), (2, 2)] main = playGameOfLife (makeGrid gliderDemo)

Slide 54

Slide 54 text

No content

Slide 55

Slide 55 text

ΞϓϦΧςΟϒؔख Applicative Functor

Slide 56

Slide 56 text

F (C, ⊗C ,1C ) (D, ⊗D ,1D ) 1C -BY .POPJEBM 'VODUPS F(1C ) 1D η A ⊗C B F(A ⊗C B) F(A) ⊗D F(B) μA,B

Slide 57

Slide 57 text

ΞϓϦΧςΟϒ-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)

Slide 58

Slide 58 text

ΞϓϦΧςΟϒؔख 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)

Slide 59

Slide 59 text

%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)

Slide 60

Slide 60 text

Profunctor / Arrow

Slide 61

Slide 61 text

P Cop × D Set ⟨C, D⟩ 1SPGVODUPS ⟨C′ , D′ ⟩ P⟨C, D⟩ P⟨C′ , D′ ⟩ P⟨f, g⟩ = f g dimap f g

Slide 62

Slide 62 text

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

Slide 63

Slide 63 text

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)

Slide 64

Slide 64 text

"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

Slide 65

Slide 65 text

https://en.wikibooks.org/wiki/Haskell/Understanding_arrows

Slide 66

Slide 66 text

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

Slide 67

Slide 67 text

A B C A × B HomC (C, A) × HomC (C, B) ≅ HomC (C, A × B) A B C A + B HomC (A, C) × HomC (B, C) ≅ HomC (A + B, C)

Slide 68

Slide 68 text

Optics (Lens)

Slide 69

Slide 69 text

init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Let’s focus on this node… … and edit this node!

Slide 70

Slide 70 text

init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Update! getter getter

Slide 71

Slide 71 text

init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Update! Update! getter getter setter setter

Slide 72

Slide 72 text

init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Lens.parameter getter getter setter setter Lens.rightParen

Slide 73

Slide 73 text

init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Lens.parameter >>> Lens.rightParen deep getter deep setter

Slide 74

Slide 74 text

http://oleg.ﬁ/gists/posts/2017-04-18-glassery.html

Slide 75

Slide 75 text

&YJTUFOUJBM0QUJDT Optic((A, B), (S, T)) = ∫ M C(S, M ⊗ A) × C(M ⊗ B, T) Lens((A, B), (S, T)) = ∫ M C(S, M × A) × C(M × B, T) = ∫ M C(S, A) × C(S, M) × C(M × B, T) = C(S, A) × C(S × B, T) Prism((A, B), (S, T)) = ∫ M C(S, M + A) × C(M + B, T) = ∫ M C(S, M + A) × C(M, T) × C(B, T) = C(S, T + A) × C(B, T)

Slide 76

Slide 76 text

P Cop × C Set ⟨A, B⟩ 1SPGVODUPS ⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ dimap f g f g *TPࣹ (Iso)

Slide 77

Slide 77 text

−⟨A, B⟩ (Profunctor) Set P −⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ SetCop×C %PVCMF:POFEB&NCFEEJOH ʹΑΔɺ*TPࣹʹಉܕͳ 1SPGVODUPS*TPࣹ

Slide 78

Slide 78 text

P Lens Set ⟨A, B⟩ ⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ f g -FOTࣹ 4USPOH 1SPGVODUPS

Slide 79

Slide 79 text

−⟨A, B⟩ (StrongProfunctor) Set P −⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ SetLens %PVCMF:POFEB&NCFEEJOH ʹΑΔɺ-FOTࣹʹಉܕͳ 1SPGVODUPS-FOTࣹ

Slide 80

Slide 80 text

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

Slide 81

Slide 81 text

http://oleg.ﬁ/gists/posts/2017-04-18-glassery.html

Slide 82

Slide 82 text

Recursion Scheme

Slide 83

Slide 83 text

࠶ؼͱෆಈ఺ ྫɿϦετ List(A) ≅ 1 + A × List(A) ≅ 1 + A × (1 + A × List(A)) ≅ 1 + A + A2 × List(A) ListFA (X) ≅ 1 + A × X Fix(ListFA ) ≅ List(A) ͱ͓͘ͱɺ ListFA ͷ࠷খෆಈ఺͸ Fix(F) ≅ F(Fix(F)) Λ࢖ͬͯ 'JY$PpYΛԾఆ ≅ ⋯ ࠨลʹԿճ-JTU'Λ͔͚ͯ΋-JTU " Ͱݻఆ F(Fix(F)) Fix(F) In out

Slide 84

Slide 84 text

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

Slide 85

Slide 85 text

3FDVSTJPO4DIFNF ࠶ؼߏ଄ͷந৅Խ 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

Slide 86

Slide 86 text

3FDVSTJPO4DIFNF ࠶ؼߏ଄ͷந৅Խ w $BUBNPSQIJTN'࢝୅਺͔Βͷ།ҰͷࣹɺGPME w "OBNPSQIJTN'ऴ༨୅਺΁ͷ།ҰͷࣹɺVOGPME w 1BSBNPSQIJTN࠶ؼதʹɺݱࡏཁૉҎ֎ʹݩͷσʔλΛಉ࣌ʹड͚ औΔ ݪ࢝࠶ؼɺ$BUBͷ֦ு൛ w "QPNPSQIJTN༨࠶ؼதʹσʔλߏஙͷૣظϦλʔϯΛՄೳʹͨ͠ ΋ͷ "OBͷ֦ு൛ w ͦͷଞɺ༷ʑͳ999NPSQIJTN͕ଘࡏ͢Δ

Slide 87

Slide 87 text

https://github.com/sellout/recursion-scheme-talk/blob/master/cheat%20sheet.pdf

Slide 88

Slide 88 text

3FDVSTJPO4DIFNFͷྫ w ιʔτΞϧΰϦζϜ w όϒϧιʔτ BOBDBUB w ૠೖιʔτ DBUBBQP w બ୒ιʔτ BOBQBSB w Ϛʔδιʔτ IZMP w ΫΠοΫιʔτ IZMP w ώʔϓιʔτ NFUB w ಈతܭը๏ %ZOBNPSQIJTN ࢀߟɿૠೖιʔτͱબ୒ιʔτ͸૒ର2JJUB IUUQTRJJUBDPNMPU[JUFNTBCFFEFF

Slide 89

Slide 89 text

·ͱΊ

Slide 90

Slide 90 text

·ͱΊ ݍ࿦ͷϓϩάϥϛϯά΁ͷԠ༻ྫ w ؔखɿNBQɺؔखͷ߹੒ ܭ ࢉޮՌͷ౔୆ w ࣗવม׵ɿδΣωϦΫε w ถాͷิ୊ɿ$14 ܕܭࢉ w ϞφυɿܭࢉޮՌ w ίϞφυɿۙ๣ͷ৞ΈࠐΈܭࢉ w ΞϓϦΧςΟϒؔखɿฒྻܭࢉ w "SSPXɿೖྗ෇͖ܭࢉޮՌ w 0QUJDTɿσʔλΞΫηα w 3FDVSTJPO4DIFNFɿιʔ τΞϧΰϦζϜɺಈతܭը๏

Slide 91

Slide 91 text

ࢀߟจݙ 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

Slide 92

Slide 92 text

Thanks! Yasuhiro Inami @inamiy