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

シンポジウム「圏論的世界像からはじまる複合知の展望」＠慶応大学 (Jan 25, 2020)
http://www.inter.ipc.i.u-tokyo.ac.jp/symposium.html

「圏論とプログラミング」発表スライドメモ - Qiita
https://qiita.com/inamiy/items/9af1da1faec22cd968f0

Video: https://www.youtube.com/watch?v=Ua6NE48_-1s

1. ݍ࿦ͱ
   ϓϩάϥϛϯά 2020/01/25 γϯϙδ΢Ϝ ʮݍ࿦తੈք૾͔Β͸͡·Δෳ߹஌ͷల๬ʯ Yasuhiro Inami / @inamiy
2. Ҵݟ
   ହ޺
   J04ΞϓϦ։ൃऀɾϑϦʔϥϯε
   w 
   1)1
   +BWB4DSJQU
   
   8FC੍࡞
   w 
   0CKFDUJWF$
   +BWB
   
   J04ΞϓϦɺαʔόʔαΠυ։ൃ
   w 
   4XJGU
   )BTLFMM
   J04ɺझຯ
   w 
   ݍ࿦
3. 
   J04%$
   
   ݍ࿦ͱ4XJGU΁ͷԠ༻
   IUUQTTQFBLFSEFDLDPNJOBNJZJPTEDKBQBO 
   ϓϩάϥϚͷͨΊͷݍ࿦ษڧձ
   
   ϓϩάϥϚͷͨΊͷϞφυ ݍ࿦
   IUUQTTQFBLFSEFDLDPNJOBNJZOVNCFSDBUQH 
   J04%$
   
   4XJGUͱ࿦ཧ
   ʙͦͯ͠ؼ͖ͬͯͨݍ࿦ʙ
   IUUQTTQFBLFSEFDLDPNJOBNJZTXJGUBOEMPHJD BOEDBUFHPSZUIFPSZ
4. 2
   ϓϩάϥϚʔ͸
   ʮݍ࿦ʯΛֶΜͩํ͕ྑ͍ʁ
5. ϓϩάϥϛϯάݴޠͷมભ ೥୅ͷݴޠ
   ΠϯλʔωοτීٴظɺαʔόʔαΠυ։ൃ
   w 1ZUIPO
   
   w 3VCZ
   
   w +BWB
   
   w +BWB4DSJQU
   
   w 1)1
    ೥୅ͷݴޠ
   εϚʔτϑΥϯීٴظɺϑϩϯτΤϯυେن໛։ൃ
   w 3VTU
   
   w ,PUMJO
   
   w 5ZQF4DSJQU
   
   w 4XJGU
   
6. ۙ೥ͷϓϩάϥϛϯάݴޠʹڞ௨͍ͯ͠Δ͜ͱ w ੩తܕ෇͚ݴޠ
   ʴ
   ܕਪ࿦
   w δΣωϦΫεʢଟ૬ੑʣ
   w ୅਺తσʔλܕʢ௚ੵɺ௚࿨ɺύλʔϯϚονϯάʣ
   w Ϟφυʢ0QUJPOBM
   3FTVMU
   'VUVSF
   0CTFSWBCMF
   FUDʣ ؔ਺ܕϓϩάϥϛϯάͷ୆಄ʂ
7. )BTLFMM
   
   ۙ೥ͷϞμϯͳݴޠ͸ɺ)BTLFMMͷӨڹΛڧ͘ड͚͍ͯΔ
8. ݍ࿦
   
   ਺ֶɺ࿦ཧֶɺ෺ཧֶɺܭࢉػՊֶͳͲɺ
   ͋Γͱ͋ΒΏΔֶ໰෼໺Ͱ༻͍ΒΕΔʮ໼ҹʯͷཧ࿦
9. ϓϩάϥϚʔ͕ݍ࿦ΛֶͿͱخ͍͜͠ͱ w ϓϩάϥϛϯάͷجૅཧ࿦ֶ͕΂Δ
   w ܕ෇͖Еܭࢉ
   ˱
   ࿦ཧֶ
   ˱
   ݍ࿦
   w ਺ֶͷجૅʢ୅਺ֶʣɺϞφυͳͲ
   w ࣮຿Ͱͷܕܭࢉɺઃܭɺந৅ԽͷεΩϧ্͕͕Δ
   w ࿦จ͕ಡΊΔΑ͏ʹͳΔ
   w কདྷͷྲྀߦΛҰ଍ઌʹΩϟονΞοϓͰ͖Δ
   &GGFDU
   4ZTUFN౳
10. ΞδΣϯμ wݍͷఆٛ
    wؔख
    wࣗવม׵
    wถాͷิ୊
    wਵ൐
    w,BO֦ு
    wϞφυ
    ίϞφυ
    wΞϓϦΧςΟϒؔख
    w1SPGVODUPS
    "SSPX
    w0QUJDT
    -FOT
    w3FDVSTJPO
    4DIFNF
11. ݍͷఆٛ
    Definition of Category
12. ݍͷఆٛ -- ߃౳ࣹ 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) ݁߹๏ଇ
13. ܕΫϥεΛ࢖ͬͨݍͷఆٛ 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)
14. ݍͷྫɿΫϥΠεϦݍ -- ΫϥΠεϦࣹ 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)
15. ݍͷྫɿϨϯζݍ -- Ϩϯζɿ௚ੵσʔλߏ଄ͷ 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)
16. ؔख
    Functor
17. 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 )
18. ؔख 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)
19. ࣗݾؔख
    &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
    
20. ؔखݍɾࣗવม׵
    Functor Category, Natural Transformation
21. A B F f G F(A) F(B) G(A) G(B) F(f) G(f) α αA αB C D ؔखݍ DC
22. ؔखݍͱࣗવม׵ 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)
23. ࣗવม׵ͷྫɿଟ૬ؔ਺ 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)
24. ࣗવಉܕͷྫɿ
    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)
25. ถాͷิ୊
    Yoneda Lemma
26. 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
27. ถాͷิ୊ 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ม׵
28. ถాຒΊࠐΈ ถాͷݪཧ Hom( − , A) ≅ Hom( − , B) ⟺ A ≅ B Nat(Hom( − , A), Hom( − , B)) ≅ Hom(A, B) )PN
    ͸ॆຬ஧࣮͔ͭର৅্୯ࣹ
29. ถాͷݪཧͷྫɿܕܭࢉ ≅ 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 ͦͷଞɺ ͳͲ
30. ༨ถాͷิ୊
    $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
    ଘࡏྔԽ
31. ڞม
    :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)
32. ਵ൐
    Adjunction
33. F U F(A) B A U(B) ≅ rightAdjunct leftAdjunct D C
34. 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
35. ਵ൐
    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 ͷ࣮૷͕ඞཁ
36. ਵ൐ͷྫɿ௚ੵ
    ⊣
    ႈ
    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)
37. ਵ൐ͷྫɿΫϥΠεϦݍ΁ͷຒΊࠐΈؔख
    ⊣
    ֦ுؔख 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))
38. ,BO֦ு
    Kan Extension
39. Cat H A G RanG H F B C σ
40. Cat B C H ε ε ∘ σG F ∘ G (RanG H) ∘ G σG ≅ Мͱ(ͷਫฏ߹੒
41. 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
42. − ∘ G RanG − F ∘ G H F RanG H ≅ fromRan toRan CB CA
43. ,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
44. Ԡ༻ฤ
45. ϞφυɾίϞφυ
    Monad, Comonad
46. Ϟφυ 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
47. ਵ൐͔Β࡞ΔϞφυ
    .
    
    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
48. 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)
49. ίϞφυ -- ແݶͷ఺ू߹͔ΒͳΔঢ়ଶۭؒͱɺݱࡏҐஔΛ࣋ͭΠϝʔδ 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
50. ਵ൐͔Β࡞ΔίϞφυ
    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))
51. 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)
52. -- ྫɿ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
53. 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)
55. ΞϓϦΧςΟϒؔख
    Applicative Functor
56. 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
57. ΞϓϦΧςΟϒ
    
    -BY
    .POPJEBM
    'VODUPS
    XJUI
    TUSFOHUI 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)
58. ΞϓϦΧςΟϒؔख 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)
59. %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)
60. Profunctor / Arrow
61. P Cop × D Set ⟨C, D⟩ 1SPGVODUPS ⟨C′ , D′ ⟩ P⟨C, D⟩ P⟨C′ , D′ ⟩ P⟨f, g⟩ = f g dimap f g
62. 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
63. 4USPOH
    
    $IPJDF
    1SPGVODUPS
    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)
64. "SSPX w Πϯελϯεྫɿ
     , Kleisli m, Cokleisli w, Mealy w ར༻ྫɿฒྻॲཧɺ"SSPXCBTFE
    GVODUJPOBM
    SFBDUJWF
    QSPHSBNNJOH -- 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
65. https://en.wikibooks.org/wiki/Haskell/Understanding_arrows
66. 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
67. 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)
68. Optics (Lens)
69. init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Let’s focus on this node… … and edit this node!
70. init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Update! getter getter
71. init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Update! Update! getter getter setter setter
72. init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Lens.parameter getter getter setter setter Lens.rightParen
73. init ( ) value : Int InitializerDecl FunctionParameterList ParameterClause Lens.parameter >>> Lens.rightParen deep getter deep setter
74. http://oleg.fi/gists/posts/2017-04-18-glassery.html
75. &YJTUFOUJBM
    0QUJDT 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)
76. P Cop × C Set ⟨A, B⟩ 1SPGVODUPS ⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ dimap f g f g *TPࣹ (Iso)
77. −⟨A, B⟩ (Profunctor) Set P −⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ SetCop×C %PVCMF
    :POFEB
    &NCFEEJOH
    ʹΑΔɺ*TPࣹʹಉܕͳ
    1SPGVODUPS
    *TPࣹ
78. P Lens Set ⟨A, B⟩ ⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ f g -FOTࣹ 4USPOH
    1SPGVODUPS
79. −⟨A, B⟩ (StrongProfunctor) Set P −⟨S, T⟩ P⟨A, B⟩ P⟨S, T⟩ SetLens %PVCMF
    :POFEB
    &NCFEEJOH
    ʹΑΔɺ-FOTࣹʹಉܕͳ
    1SPGVODUPS
    -FOTࣹ
80. 1SPGVODUPS
    0QUJDT 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
81. http://oleg.fi/gists/posts/2017-04-18-glassery.html
82. Recursion Scheme
83. ࠶ؼͱෆಈ఺
    ྫɿϦετ 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
84. 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
85. 3FDVSTJPO
    4DIFNF
    ࠶ؼߏ଄ͷந৅Խ 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
86. 3FDVSTJPO
    4DIFNF
    ࠶ؼߏ଄ͷந৅Խ w $BUBNPSQIJTN
    '࢝୅਺͔Βͷ།ҰͷࣹɺGPME
    w "OBNPSQIJTN
    'ऴ༨୅਺΁ͷ།ҰͷࣹɺVOGPME
    w 1BSBNPSQIJTN
    ࠶ؼதʹɺݱࡏཁૉҎ֎ʹݩͷσʔλΛಉ࣌ʹड͚ औΔ
    ݪ࢝࠶ؼɺ$BUB
    ͷ֦ு൛
    w "QPNPSQIJTN
    ༨࠶ؼதʹσʔλߏஙͷૣظϦλʔϯΛՄೳʹͨ͠ ΋ͷ
    "OB
    ͷ֦ு൛
    w ͦͷଞɺ༷ʑͳ
    999NPSQIJTN
    ͕ଘࡏ͢Δ
87. https://github.com/sellout/recursion-scheme-talk/blob/master/cheat%20sheet.pdf
88. 3FDVSTJPO
    4DIFNFͷྫ w ιʔτΞϧΰϦζϜ
    w όϒϧιʔτ
    BOB
    
    DBUB
    w ૠೖιʔτ
    DBUB
    
    BQP
    w બ୒ιʔτ
    BOB
    
    QBSB
    w Ϛʔδιʔτ
    IZMP
    w ΫΠοΫιʔτ
    IZMP
    w ώʔϓιʔτ
    NFUB
    w ಈతܭը๏
    %ZOBNPSQIJTN ࢀߟɿ
    ૠೖιʔτͱબ୒ιʔτ͸૒ର
    
    2JJUB
    
    IUUQTRJJUBDPNMPU[JUFNTBCFFEFF
89. ·ͱΊ
90. ·ͱΊ
    ݍ࿦ͷϓϩάϥϛϯά΁ͷԠ༻ྫ w ؔखɿ
    NBQɺؔखͷ߹੒
    ܭ ࢉޮՌͷ౔୆
    w ࣗવม׵ɿδΣωϦΫε
    w ถాͷิ୊ɿ$14
    ܕܭࢉ
    w Ϟφυɿ
    ܭࢉޮՌ
    w ίϞφυɿۙ๣ͷ৞ΈࠐΈܭࢉ
    w ΞϓϦΧςΟϒؔखɿฒྻܭࢉ
    w "SSPXɿ
    ೖྗ෇͖ܭࢉޮՌ
    w 0QUJDTɿ
    σʔλΞΫηα
    w 3FDVSTJPO
    4DIFNFɿ
    ιʔ τΞϧΰϦζϜɺಈతܭը๏
91. ࢀߟจݙ w $BUFHPSZ
    5IFPSZ
    GPS
    1SPHSBNNFST
    w ݍ࿦
    c
    ұେ੔Ҭ
    w .POBET
    .BEF
    %JGpDVMU
    w )BTLFMMͱਵ൐
    
    2JJUB
    w LBOFYUFOTJPOT
    w $ISJT1FOOFSDPOXBZ
    w (FOFSBMJTJOH
    .POBET
    UP
    "SSPXT
    w "SSPXT
    "
    (FOFSBM
    *OUFSGBDF
    UP
    $PNQVUBUJPO
    w %POU
    'FBS
    UIF
    1SPGVODUPS
    0QUJDT
    w 8IBU
    :PV
    /FFEB
    ,OPX
    BCPVU
    :POFEB
    
    1SPGVODUPS
    0QUJDT
    BOE
    UIF
    :POFEB
    -FNNB
    w 1SPGVODUPS
    0QUJDT
    .PEVMBS
    %BUB
    "DDFTTPST
    w $BUFHPSJFT
    PG
    0QUJDT
    w 'VODUJPOBM
    1SPHSBNNJOH
    XJUI
    #BOBOBT
    -FOTFT
    &OWFMPQFT
    BOE
    #BSCFE
    8JSF
    w $VSTF
    FYQMJDJU
    SFDVSTJPO
    w 3FDVSTJPO
    4DIFNFT
    
    IBTLFMMTIPFO
    w "
    %VBMJUZ
    PG
    4PSUT
92. Thanks! Yasuhiro Inami @inamiy