Upgrade to Pro — share decks privately, control downloads, hide ads and more …

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

Yasuhiro Inami

January 25, 2020
Tweet

More Decks by Yasuhiro Inami

Other Decks in Programming

Transcript

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

    View Slide

  2. Ҵݟହ޺
    J04ΞϓϦ։ൃऀɾϑϦʔϥϯε

    w 1)1 +BWB4DSJQU
    8FC੍࡞

    w 0CKFDUJWF$ +BWB
    J04ΞϓϦɺαʔόʔαΠυ։ൃ

    w 4XJGU )BTLFMM J04ɺझຯ

    w ݍ࿦

    View Slide

  3. J04%$
    ݍ࿦ͱ4XJGU΁ͷԠ༻
    IUUQTTQFBLFSEFDLDPNJOBNJZJPTEDKBQBO
    ϓϩάϥϚͷͨΊͷݍ࿦ษڧձ
    ϓϩάϥϚͷͨΊͷϞφυ ݍ࿦

    IUUQTTQFBLFSEFDLDPNJOBNJZOVNCFSDBUQH
    J04%$
    4XJGUͱ࿦ཧʙͦͯ͠ؼ͖ͬͯͨݍ࿦ʙ
    IUUQTTQFBLFSEFDLDPNJOBNJZTXJGUBOEMPHJD
    BOEDBUFHPSZUIFPSZ

    View Slide

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

    View Slide

  5. ϓϩάϥϛϯάݴޠͷมભ
    ೥୅ͷݴޠ
    ΠϯλʔωοτීٴظɺαʔόʔαΠυ։ൃ

    w 1ZUIPO

    w 3VCZ

    w +BWB

    w +BWB4DSJQU

    w 1)1

    ೥୅ͷݴޠ
    εϚʔτϑΥϯීٴظɺϑϩϯτΤϯυେن໛։ൃ

    w 3VTU

    w ,PUMJO

    w 5ZQF4DSJQU

    w 4XJGU

    View Slide

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

    View Slide

  7. )BTLFMM

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

    View Slide

  8. ݍ࿦

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

    View Slide

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

    View Slide

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

    w3FDVSTJPO4DIFNF

    View Slide

  11. ݍͷఆٛ
    Definition of Category

    View Slide

  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)
    ݁߹๏ଇ

    View Slide

  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)

    View Slide

  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)

    View Slide

  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)

    View Slide

  16. ؔख
    Functor

    View Slide

  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 )

    View Slide

  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)

    View Slide

  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

    View Slide

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

    View Slide

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

    View Slide

  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)

    View Slide

  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)

    View Slide

  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)

    View Slide

  25. ถాͷิ୊
    Yoneda Lemma

    View Slide

  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

    View Slide

  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ม׵

    View Slide

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

    View Slide

  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
    ͦͷଞɺ
    ͳͲ

    View Slide

  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 ଘࡏྔԽ

    View Slide

  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)

    View Slide

  32. ਵ൐
    Adjunction

    View Slide

  33. F
    U
    F(A)
    B
    A
    U(B)

    rightAdjunct
    leftAdjunct
    D C

    View Slide

  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

    View Slide

  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 ͷ࣮૷͕ඞཁ

    View Slide

  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)

    View Slide

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

    View Slide

  38. ,BO֦ு
    Kan Extension

    View Slide

  39. Cat
    H
    A
    G
    RanG
    H
    F
    B C
    σ

    View Slide

  40. Cat
    B C
    H
    ε ε ∘ σG
    F ∘ G
    (RanG
    H) ∘ G
    σG

    Мͱ(ͷਫฏ߹੒

    View Slide

  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

    View Slide

  42. − ∘ G
    RanG

    F ∘ G
    H
    F
    RanG
    H

    fromRan
    toRan
    CB CA

    View Slide

  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

    View Slide

  44. Ԡ༻ฤ

    View Slide

  45. ϞφυɾίϞφυ
    Monad, Comonad

    View Slide

  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

    View Slide

  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

    View Slide

  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)

    View Slide

  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

    View Slide

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

    View Slide

  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)

    View Slide

  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

    View Slide

  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)

    View Slide

  54. View Slide

  55. ΞϓϦΧςΟϒؔख
    Applicative Functor

    View Slide

  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

    View Slide

  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)

    View Slide

  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)

    View Slide

  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)

    View Slide

  60. Profunctor / Arrow

    View Slide

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

    View Slide

  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

    View Slide

  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)

    View Slide

  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

    View Slide

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

    View Slide

  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

    View Slide

  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)

    View Slide

  68. Optics (Lens)

    View Slide

  69. init
    ( )
    value : Int
    InitializerDecl
    FunctionParameterList
    ParameterClause
    Let’s focus on

    this node…
    … and edit

    this node!

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

  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)

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

  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

    View Slide

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

    View Slide

  82. Recursion Scheme

    View Slide

  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

    View Slide

  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

    View Slide

  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

    View Slide

  86. 3FDVSTJPO4DIFNF ࠶ؼߏ଄ͷந৅Խ

    w $BUBNPSQIJTN'࢝୅਺͔Βͷ།ҰͷࣹɺGPME
    w "OBNPSQIJTN'ऴ༨୅਺΁ͷ།ҰͷࣹɺVOGPME
    w 1BSBNPSQIJTN࠶ؼதʹɺݱࡏཁૉҎ֎ʹݩͷσʔλΛಉ࣌ʹड͚
    औΔ ݪ࢝࠶ؼɺ$BUBͷ֦ு൛

    w "QPNPSQIJTN༨࠶ؼதʹσʔλߏஙͷૣظϦλʔϯΛՄೳʹͨ͠
    ΋ͷ "OBͷ֦ு൛

    w ͦͷଞɺ༷ʑͳ999NPSQIJTN͕ଘࡏ͢Δ

    View Slide

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

    View Slide

  88. 3FDVSTJPO4DIFNFͷྫ
    w ιʔτΞϧΰϦζϜ
    w όϒϧιʔτ BOBDBUB

    w ૠೖιʔτ DBUBBQP

    w બ୒ιʔτ BOBQBSB

    w Ϛʔδιʔτ IZMP

    w ΫΠοΫιʔτ IZMP

    w ώʔϓιʔτ NFUB

    w ಈతܭը๏ %ZOBNPSQIJTN
    ࢀߟɿૠೖιʔτͱબ୒ιʔτ͸૒ର2JJUB
    IUUQTRJJUBDPNMPU[JUFNTBCFFEFF

    View Slide

  89. ·ͱΊ

    View Slide

  90. ·ͱΊ ݍ࿦ͷϓϩάϥϛϯά΁ͷԠ༻ྫ

    w ؔखɿNBQɺؔखͷ߹੒ ܭ
    ࢉޮՌͷ౔୆

    w ࣗવม׵ɿδΣωϦΫε
    w ถాͷิ୊ɿ$14 ܕܭࢉ
    w ϞφυɿܭࢉޮՌ
    w ίϞφυɿۙ๣ͷ৞ΈࠐΈܭࢉ
    w ΞϓϦΧςΟϒؔखɿฒྻܭࢉ
    w "SSPXɿೖྗ෇͖ܭࢉޮՌ
    w 0QUJDTɿσʔλΞΫηα
    w 3FDVSTJPO4DIFNFɿιʔ
    τΞϧΰϦζϜɺಈతܭը๏

    View Slide

  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

    View Slide

  92. Thanks!
    Yasuhiro Inami
    @inamiy

    View Slide