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

圏論とプログラミング / 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

Eac0bf787b5279aca5e699ece096956e?s=128

Yasuhiro Inami

January 25, 2020
Tweet

Transcript

  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 কདྷͷྲྀߦΛҰ଍ઌʹΩϟονΞοϓͰ͖Δ &GGFDU4ZTUFN౳
  10. ΞδΣϯμ wݍͷఆٛ wؔख wࣗવม׵ wถాͷิ୊ wਵ൐ w,BO֦ு wϞφυ ίϞφυ wΞϓϦΧςΟϒؔख

    w1SPGVODUPS "SSPX w0QUJDT -FOT  w3FDVSTJPO4DIFNF
  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)
  54. None
  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'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)
  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$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)
  64. "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
  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. &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)
  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. 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
  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. 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
  86. 3FDVSTJPO4DIFNF ࠶ؼߏ଄ͷந৅Խ 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. 3FDVSTJPO4DIFNFͷྫ 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 3FDVSTJPO4DIFNFɿιʔ τΞϧΰϦζϜɺಈతܭը๏
  91. ࢀߟจݙ 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
  92. Thanks! Yasuhiro Inami @inamiy