9
Help us understand the problem. What are the problem?

More than 1 year has passed since last update.

posted at

updated at

Functor, Applicative, Monad, Comonad, MonadTrans, Profunctor, Strong, Arrow, Choice, ArrowChoice, Costrong, ArrowLoop

Functor, Applicative, Monad, Comonad

monad.jpg

Kleisli 圏の射 >=>

kleisli.jpg

MonadTrans

trans.jpg

Profunctor, Strong, Arrow

arrow.jpg

Arrow, ArrowLoop

arrow2.jpg

Profunctor, Strong, Arrow, Choice, ArrowChoice, Costrong, ArrowLoop

PureScript による Strong, Costrong, Choice のデモコード
PureScript は正格評価のため遅延評価が必要な Costrong (->) の loop == unfirst を実装していない
個々では型だけ合わせて擬似的に再現したが unfirst, unsecond は本来の意図通りのフィードバックループとしては機能しない

-- purescript 0.13.3

import Control.Applicative (pure)
import Control.Bind ((>>=), discard, bind)
import Control.Semigroupoid ((>>>))
import Data.Eq (class Eq, (==))
import Data.Either (Either(Left, Right))
import Data.Function (($), (#))
import Data.Profunctor (class Profunctor dimap, arr)
import Data.Profunctor.Choice ((+++), (|||))
import Data.Profunctor.Costrong (class Costrong, unfirst unsecond)
import Data.Profunctor.Strong ((&&&), (***), first, second)
import Data.Semigroup ((<>))
import Data.Show (class Show, show)
import Data.Tuple (Tuple(Tuple))
import Data.Unit (Unit, unit)
import Effect (Effect)
import Effect.Console (log)

main :: Effect Unit
main = do
  log "Arrow Demo"
  log $ ("arrow: " <> _) $ show $ A # a2bc >>> bc2cc >>> cc2aa >>> (second a2b)
  log $ ("choice: " <> _) $ show $ Left A # (a2b +++ a2c) >>> (b2c +++ c2a) >>> (c2a +++ a2b) >>> (a2c ||| b2c)
  log $ ("loop: " <> _) $ show $ let Function' a2a = unfirst (Function' ooo) in a2a $ a2a A
  log $ ("loop2: " <> _) $ show $ let Function' f = unfirst (Function' iii) in f true
  pure unit
  where
  ooo :: (Tuple A (Maybe Int)) -> (Tuple A (Maybe Int))
  ooo = case _ of
    Tuple a (Just c) ->
      Tuple a $ Just $ spy "ooo" $ c + 1
    Tuple a _ -> Tuple a $ Just $ spy "ooo" 0

  iii :: (Tuple Boolean (Unit -> Int)) -> (Tuple Boolean (Unit -> Int))
  iii (Tuple reset lazy) = case reset of
    true -> Tuple false \_ -> spy "iii" 0
    false -> Tuple false $ \_ -> spy "iii" $ 1 + lazy unit

  a2b :: A -> B
  a2b A = B

  a2c:: A -> C
  a2c A = C

  b2c :: B -> C
  b2c B = C

  c2a :: C -> A
  c2a C = A

  a2bc :: A -> (Tuple B C)
  a2bc = (a2b &&& a2c)

  bc2cc :: (Tuple B C) -> (Tuple C C)
  bc2cc = first b2c

  cc2aa :: (Tuple C A) -> (Tuple A A)
  cc2aa = (c2a *** c2a)

--- Costrong (->) === ArrowLoop のために必要
--- PureScript は正格評価のため遅延評価が必要な Costrong (->) を実装できない!!! 

newtype Function' a b = Function' (a -> b)

instance profunctorFn' :: Profunctor Function' where
  dimap a2b c2d (Function' b2c) = Function' (a2b >>> b2c >>> c2d)

instance costrongFn' :: Costrong Function' where
  unfirst :: forall a b c. (Function' (Tuple a c) (Tuple b c)) -> Function' a b
  unfirst (Function' f) =
    Function' \a ->
      let
        (Tuple b c) = f (Tuple a c)
      in
        b
    where
    c = undefined -- 正格評価の PureScript ではフィードバック値 c の初期値を遅延評価で算出できない!!!
  unsecond :: forall a b c. (Function' (Tuple a b) (Tuple a c)) -> Function' b c
  unsecond (Function' f) =
    Function' \b ->
      let
        (Tuple a c) = f (Tuple a b)
      in
        c
    where
    a = undefined -- 正格評価の PureScript ではフィードバック値 a の初期値を遅延評価で算出できない!!!

data A = A
derive instance eqA :: Eq A
instance showA :: Show A where
  show A = "A"

data B = B
derive instance eqB :: Eq B
instance showB :: Show B where
  show B = "B"

data C = C
derive instance eqC :: Eq C
instance showC :: Show C where
  show C = "C"

data D = D
derive instance eqD :: Eq D
instance showD :: Show D where
  show D = "D"

Kleisli Triple

todo...

referencce

reference2

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
9
Help us understand the problem. What are the problem?