Композиция

cтрелок

и

морфизмов
симметричных моноидальных категорий

в Scala

Моноид

trait Monoid[A] {
  def neutral: A
  def combine(x: A, y: A): A
}

Категория

trait Cat[->[_, _]] {
  def id[A]: A -> A
  def compose[A, B, C](f: B -> C, g: A -> B): A -> C

  implicit def homEq[A, B]: Eq[A -> B] = Eq.fromUniversalEquals

  class CatLaws {
    def left_unit[A, B](f: A -> B) =
      (id[B] o f) === f
    def right_unit[A, B](f: A -> B) =
      (f o id[A]) === f
    def associativity[A, B, C, D](f: A -> B, g: B -> C, h: C -> D) =
      (h o (g o f)) === ((h o g) o f)
  }

  implicit class CatHomOps[A, B](f: A -> B) {
    def o[C](g: C -> A): C -> B = compose(f, g)
    def >>[C](g: B -> C): A -> C = compose(g, f)
  }
}

Изоморфизм

  case class <->[A, B](to: A -> B, from: B -> A) {
    def section    = compose(to, from) === id
    def retraction = compose(from, to) === id
  }

Моноидальная категория

trait MonoidalCat[->[_, _], x[_, _], I] extends Cat[->] {
  def left_unit[A]: (I x A) <-> A
  def right_unit[A]: (A x I) <-> A
  def assoc[A, B, C]: (A x (B x C)) <-> ((A x B) x C)

  def tensor[A, B, C, D](f: A -> B, g: C -> D): (A x C) -> (B x D)

  class MonoidalLaws {
    def pentagon[A, B, C, D] =
      ((ar[A, B, C] x id[D]) >> ar[A, B x C, D] >> (id[A] x ar[B, C, D])) ===
        (ar[A x B, C, D] >> ar[A, B, C x D])

    def triagonal[A, B] =
      ar[A, I, B] === ((right_unit[A].to x id[B]) >> (id[A] x left_unit[B].from))

    def tenson_dist[A, B, C, D, E, F]
    (f: A -> B, g: B -> C, h: D -> E, i: E -> F) =
      ((f x h) >> (g x i)) === ((f >> g) x (h >> i))

    def tensor_id[A, B] = (id[A] x id[B]) === id[A x B]
  }

  def ar[A, B, C] = assoc[A, B, C].from
  implicit class TensorHomOps[A, B](f: A -> B) {
    def x[C, D](g: C -> D): (A x C) -> (B x D) = tensor(f, g)
  }
}

Симметричная моноидальная категория

trait Symon[->[_, _], x[_, _], I] extends MonoidalCat[->, x, I] {
  def swap[A, B]: (A x B) -> (B x A)

  def symmetry[A, B]: (A x B) <-> (B x A) = <->(swap, swap)

  class SymonLaws {
    def unit_coherence[A] =
      swap[A, I] === (left_unit[A].from o right_unit[A].to)

    def assoc_coherence[A, B, C] =
      ((swap[A, B] x id[C]) >> ar[B, A, C] >> (id[B] x swap[A, C])) ===
        (ar[A, B, C] >> swap[A, B x C] >> ar[B, C, A])
  }
}

Декартова категория

trait Cartesian[->[_, _], x[_, _], I] extends Symon[->, x, I] {
  def proj1[A, B]: (A x B) -> A
  def proj2[A, B]: (A x B) -> B

  def product[A, B, C](f: A -> B, g: A -> C): A -> (B x C)

  def term[A]: A -> I

  class CartesianLaws {
    def lcomp[A, B, C](f: A -> B, g: A -> C) =
      (proj1 o product(f, g)) === f

    def rcomp[A, B, C](f: A -> B, g: A -> C) =
      (proj2 o product(f, g)) === g
  }
}

Замкнутая категория

trait Closed[->[_, _], x[_, _], ==>[_, _], I] extends Symon[->, x, I] {
  def lcurry[A, B, C](p: (A x B) -> C): A -> (B ==> C)
  def luncurry[A, B, C](p: A -> (B ==> C)): (A x B) -> C

  class ClosedLaws{
    def curryEq[A, B, C](p: (A x B) -> C) = luncurry(lcurry(p)) === p
    def uncurryEq[A, B, C](p: A -> (B ==> C)) = lcurry(luncurry(p)) === p
  }

  def lapply[A, B]: ((A ==> B) x A) -> B = luncurry(id)
  def rapply[A, B]: (A x (A ==> B)) -> B = runcurry(id)

  def lunapply[A, B]: A -> (B ==> (A x B)) = lcurry(id)
  def runapply[A, B]: B -> (A ==> (A x B)) = rcurry(id)

  def ident[A]: I -> (A ==> A) = lcurry(left_unit[A].to)
  def choose[A]: A -> (I ==> A) = lcurry(right_unit[A].to)
  def unchoose[A]: (I ==> A) -> A = 
    compose(lapply[I, A], right_unit[I ==> A].from)
}

trait CartesianClosed[->[_, _], x[_, _], ==>[_, _], I]
     extends Cartesian[->, x, I] with Closed[->, x, ==>, I]

Лямбда исчисление

\frac{} {\Gamma \vdash x: T} x : T \in \Gamma
\frac {\Gamma \vdash f : A \to B ~~~~ \Gamma \vdash x: A} {\Gamma \vdash f(x) : B}

Variable

Application

\frac {\Gamma, x: A \vdash e: B} {\Gamma \vdash (\lambda x: A. e) : A \to B}

Abstraction

Лямбда исчисление

name: UUID \to String, \\ age: UUID \to Int, \\ user: String \to Int \to User, \\ d: Int\\ \vdash \\ \lambda\, uuid: UUID . \\ user(name\, uuid) (age\, uuid) \\ : UUID \to User

Lambek Horrespondence

\frac{} {A \vdash A} id
\frac{} {A \times B \vdash A} proj_1
\frac{} {A \times B \vdash B} proj_2
\frac{} {A \vdash \top} term
\frac{A \vdash B ~ B \vdash C } {A \vdash C} compose
\frac{\Gamma \vdash A ~ \Gamma \vdash B} {Г \vdash A \times B} product
\frac {A \times B \vdash C} {A \vdash B \to C} curry
\frac {A \vdash B \to C} {A \times B \vdash C} uncurry

Пример:

  def name(id: UUID): String
  def balance(id: UUID): BigDecimal
  def plus(x: BigDecimal, y: BigDecimal): BigDecimal
  def user(name: String, balance: BigDecimal): User

  def total(main: UUID, secondary: UUID): User =
    user(name(main), plus(balance(main), balance(secondary)))
  def name: UUID -> String
  def balance: UUID -> BigDecimal
  def plus: (BigDecimal x BigDecimal) -> BigDecimal
  def user: (String x BigDecimal) -> User

  def total: (UUID x UUID) -> User =
    (product(name, balance) x balance) >> ar >> (id[String] x plus) >> user

Функции

  def getName(id: UUID): String
  def getBalance(id: UUID): BigDecimal
  def makeUser(name: String, balance: BigDecimal): User
  def plus(x: BigDecimal, y: BigDecimal): BigDecimal


  def total(main: UUID, secondary: UUID) = {
    val name = getName(main)
    val mainBalance = getBalance(main)
    val secondaryBalance = getBalance(main)
    val totalBalance = plus(mainBalance, secondaryBalance)
    makeUser(name, totalBalance)
  }

Функции

  def let[A, B](x: A)(cont: A => B): B = cont(x)

  def getName: UUID => String
  def getBalance: UUID => BigDecimal
  def plus: BigDecimal => BigDecimal => BigDecimal
  def makeUser: String => BigDecimal => User


  def total: UUID => UUID => User = main => secondary =>
    let(getName(main))(name =>
      let(getBalance(main))(mainBalance =>
        let(getBalance(secondary))(secondaryBalance =>
          let(plus(mainBalance)(secondaryBalance))(totalBalance =>
            makeUser(name)(totalBalance)
          ))))

Монады

  def getName: UUID => F[String]
  def getBalance: UUID => F[BigDecimal]
  def plus: BigDecimal => BigDecimal => F[BigDecimal]
  def makeUser: String => BigDecimal => F[User]

  def total: UUID => UUID => F[User] = main => secondary =>
    getName(main) flatMap (name =>
      getBalance(main) flatMap (mainBalance =>
        getBalance(secondary) flatMap (secondaryBalance =>
          plus(mainBalance)(secondaryBalance) flatMap (totalBalance =>
            makeUser(name)(totalBalance)
            ))))

For

  def getName(id: UUID): F[String]
  def getBalance(id: UUID): F[BigDecimal]
  def makeUser(name: String, balance: BigDecimal): F[User]
  def plus(x: BigDecimal, y: BigDecimal): F[BigDecimal]

  def total(main: UUID, secondary: UUID): F[User] =
    for {
      name <- getName(main)
      mainBalance <- getBalance(main)
      secondaryBalance <- getBalance(main)
      totalBalance <- plus(mainBalance, secondaryBalance)
    } yield makeUser(name, totalBalance)

Монады

sealed trait ConsoleM[X]

object ConsoleM {
  case class Pure[A](x: A) extends ConsoleM[A]
  case class Bind[A, B](x: ConsoleM[A], fab: A => ConsoleM[B]) extends ConsoleM[B]
  case object GetLine extends ConsoleM[String]
  case class PutLine(s: String) extends ConsoleM[Unit]

  implicit val monad: Monad[ConsoleM] = new StackSafeMonad[ConsoleM] {
    def pure[A](x: A): ConsoleM[A] = Pure(x)
    def flatMap[A, B](fa: ConsoleM[A])(f: A => ConsoleM[B]): ConsoleM[B] = Bind(fa, f)
  }

  val getLine: ConsoleM[String] = GetLine

  def echo2: ConsoleM[Unit] = for (x <- getLine; y <- getLine) yield x + y

  def countGets[A](cm: ConsoleM[A]): Int = cm match {
    case Pure(_) => 0
    case GetLine => 1
    case PutLine(_) => 0
    case Bind(m, f) => countGets(m) + (??? : Int)
  }
}

Аппликативные функторы

sealed trait ConsoleA[X]

object ConsoleA {
  case class Pure[A](x: A) extends ConsoleA[A]
  case class Ap[A, B](f: ConsoleA[A => B], x: ConsoleA[A]) extends ConsoleA[B]
  case object GetLine extends ConsoleA[String]
  case class PutLine(s: String) extends ConsoleA[Unit]

  implicit val applicative: Applicative[ConsoleA] = new Applicative[ConsoleA] {
    def pure[A](x: A): ConsoleA[A] = Pure(x)
    def ap[A, B](ff: ConsoleA[A => B])(fa: ConsoleA[A]): ConsoleA[B] = Ap(ff, fa)
  }

  def countGets[X](ca: ConsoleA[X]): Int = ca match {
    case Pure(_) => 0
    case GetLine => 1
    case PutLine(_) => 0
    case Ap(f, x) => countGets(f) + countGets(x)
  }

  def echo2: ConsoleA[Unit] = ???
}

Стрелки

trait Arr[->[_, _]] extends Cartesian[->, (?, ?), Unit] {
  def lift[A, B](f: A => B): A -> B
  def split[A, B, C, D](f: A -> B, g: C -> D): (A, C) -> (B, D)
  def compose[A, B, C](f: B -> C, g: A -> B): A -> C

  def proj1[A, B]: (A, B) -> A = lift(_._1)
  def proj2[A, B]: (A, B) -> B = lift(_._2)
  def term[A]: A -> Unit = lift(_ => ())
  def id[A]: A -> A = lift(a => a)
  def product[A, B, C](f: A -> B, g: A -> C): A -> (B, C) =
    compose(split(f, g), lift(a => (a, a)))
  override def tensor[A, B, C, D](f: A -> B, g: C -> D): (A, C) -> (B, D) =
    split(f, g)
}
import cats.arrow.Arrow

Стрелки

sealed trait ConsoleArr[X, Y]

object ConsoleArr{
  case class Lift[A, B](f: A => B) extends ConsoleArr[A, B]
  case class AndThen[A, B, C](start: ConsoleArr[A, B], next: ConsoleArr[B, C])
    extends ConsoleArr[A, C]
  case class Split[A, B, C, D](first: ConsoleArr[A, B], second: ConsoleArr[C, D])
    extends ConsoleArr[(A, C), (B, D)]
  case object GetLine extends ConsoleArr[Unit, String]
  case object PutLine extends ConsoleArr[String, Unit]

  implicit val arrow: Arrow[ConsoleArr] = new Arrow[ConsoleArr] {
    def lift[A, B](f: A => B): ConsoleArr[A, B] = Lift(f)
    def first[A, B, C](fa: ConsoleArr[A, B]): ConsoleArr[(A, C), (B, C)] = Split(fa, id)
    def compose[A, B, C](f: ConsoleArr[B, C], g: ConsoleArr[A, B]): ConsoleArr[A, C] = AndThen(g, f)
  }

  val getLine: ConsoleArr[Unit, String] = GetLine
  val putLine: ConsoleArr[String, Unit] = PutLine

  def concat: ConsoleArr[(String, String), String] = Lift(tupled(_ + _))

Стрелки

  def echo2: ConsoleArr[Unit, Unit] =
    (getLine &&& getLine) >>> concat >>> putLine

  def countGets[X, Y](carr: ConsoleArr[X, Y]): Int = carr match {
    case Lift(_) => 0
    case AndThen(start, next) => countGets(start) + countGets(next)
    case Split(first, second) => countGets(first) + countGets(second)
    case GetLine => 1
    case PutLine => 0
  }

Capabilities

Задача Applicative Monad Arrow
последовательная композиция Х Monad Arrow
условное выполнение Selective Monad ArrowChoice
сумма результатов Alternative MonadPlus ArrowPlus
циклы X Monad ArrowLoop
абстракция и применение Х Monad ArrowApply
параллельное выполнение Applicative Parallel Arrow

Применение

  • Явное совмещение последовательной и параллельной семантик
  • Производительность https://github.com/traneio/arrows
  • интроспеция
  • структурная оптимизация
  • строгость

https://www.haskell.org/arrows/

def echo2: ConsoleArr[Unit, Unit] =
    (getLine &&& getLine) >>> concat >>> putLine


def echo2s: ConsoleArr[Unit, Unit] = arr[ConsoleArr] { () =>
  val s1 = getLine()
  val s2 = getLine()
  val s = concat(s1, s2)
  putLine(s)
}

Volga

https://github.com/Odomontois/volga

Arrow and

Symmetric Monoidal Category composition syntax helper

import volga.syntax._
val getLine: ConsoleArr[Unit, String] = GetLine
val putLine: ConsoleArr[String, Unit] = PutLine

val concat: ConsoleArr[(String, String), String] = Lift(tupled(_ + _))
val show: ConsoleArr[Int, String] = Lift(_.toString)
val plus: ConsoleArr[(Int, Int), Int] = Lift(tupled(_ + _))

Volga

  val foo: ConsoleArr[(Int, Int), Unit] = arr[ConsoleArr] {
    (x, y) =>
      val xs = show(x)
      val ys = show(y)
      putLine(xs)
      putLine(ys)
      val z  = plus(x, y)
      val zs = show(z)
      val s = concat(xs, ys)
      val t = concat(zs, s)
      putLine(zs)
      putLine(s)
      putLine(t)
  }

Volga

  val foo: ConsoleArr[(Int, Int), Unit] = arr[ConsoleArr] { (x: V[Int], y: V[Int]) =>
    val xs: V[String] = show(x)
    val ys: V[String] = show(y)
    putLine(xs)
    putLine(ys)
    val z: V[Int] = plus(x, y)
    val zs: V[String] = show(z)
    val s: V[String] = concat(xs, ys)
    val t: V[String] = concat(zs, s)
    putLine(zs)
    putLine(s)
    putLine(t)
  }

Volga

val foo: ConsoleArr[(Int, Int), Unit] = arr[ConsoleArr] { (x: V[Int], y: V[Int]) =>
    val xs: V[String] = ArrSyn(show).apply(x)
    val ys: V[String] = ArrSyn(show).apply(y)
    ArrSyn(putLine).apply(xs)
    ArrSyn(putLine).apply(ys)
    val z: V[Int] = ArrSyn(plus)(x, y)
    val zs: V[String] = ArrSyn(show)(z)
    val s: V[String] = ArrSyn(concat).apply(xs, ys)
    val t: V[String] = ArrSyn(concat).apply(zs, s)
    ArrSyn(putLine).apply(zs)
    ArrSyn(putLine).apply(s)
    ArrSyn(putLine).apply(t)
  }

Volga

 (x, y) =>
    val xs = show(x)
    val ys = show(y)
    putLine(xs)
    putLine(ys)
    val z = plus(x, y)
    val zs = show(z)
    val s = concat(xs, ys)
    val t = concat(zs, s)
    putLine(zs)
    putLine(s)
    putLine(t)

Volga

(x,y) <- <<REUSE>> -< (x,y)
(xs) <- show -< (x)
(ys) <- show -< (y)
<<BREAK>>
(xs,ys) <- <<REUSE>> -< (xs,ys)
() <- putLine -< (xs)
() <- putLine -< (ys)
(z) <- plus -< (x,y)
<<BREAK>>
(zs) <- show -< (z)
(s) <- concat -< (xs,ys)
<<BREAK>>
(t) <- concat -< (zs,s)
() <- putLine -< (zs)
() <- putLine -< (s)
<<BREAK>>
(last$macro$1) <- putLine -< (t)
(x, y) =>
    val xs = show(x)
    val ys = show(y)
    putLine(xs)
    ----
    putLine(ys)
    val z = plus(x, y)
    val zs = show(z)
    ----
    val s = concat(xs, ys)
    val t = concat(zs, s)
    putLine(zs)
    putLine(s)
    ----
    putLine(t)

Volga

(x,y) <- <<REUSE>> -< (x,y)
(xs) <- show -< (x)
(ys) <- show -< (y)
<<BREAK>>
(ys,x,y,xs) <- <<REUSE>> -< (ys,x,y,xs)
() <- putLine -< (xs)
<<BREAK>>
(xs,ys) <- <<REUSE>> -< (xs,ys)
() <- putLine -< (ys)
(z) <- plus -< (x,y)
<<BREAK>>
(xs,ys) <- <<REUSE>> -< (xs,ys)
(zs) <- show -< (z)
<<BREAK>>
(zs) <- <<REUSE>> -< (zs)
(s) <- concat -< (xs,ys)
<<BREAK>>
(t) <- concat -< (zs,s)
() <- putLine -< (zs)
() <- putLine -< (s)
<<BREAK>>
(last$macro$1) <- putLine -< (t)
  liftf[volga.pres.ConsoleArr,
        (Int, Int),
        (((Int, Int), Int), Int)] {
    case (x, y) => (((x, y), x), y)
  }.andThen(ident[volga.pres.ConsoleArr, (Int, Int)]
      .split(show)
      .split(show))
    .andThen(
      syntax.liftf[volga.pres.ConsoleArr,
                   (((Int, Int), String), String),
                   ((String, Int, Int, String), String)] {
        case (((x, y), xs), ys) => ((ys, x, y, xs), xs)
      })
    .andThen(ident[volga.pres.ConsoleArr,
                   (String, Int, Int, String)].split(putLine))
    .andThen(
      syntax.liftf[volga.pres.ConsoleArr,
                   ((String, Int, Int, String), Unit),
                   (((String, String), String), (Int, Int))] {
        case ((ys, x, y, xs), ()) => (((xs, ys), ys), (x, y))
      })
    .andThen(ident[volga.pres.ConsoleArr, (String, String)]
      .split(putLine)
      .split(plus))
    .andThen(syntax.liftf[volga.pres.ConsoleArr,
                          (((String, String), Unit), Int),
                          ((String, String), Int)] {
      case (((xs, ys), ()), z) => ((xs, ys), z)
    })
    .andThen(ident[volga.pres.ConsoleArr, (String, String)]
      .split(show))
    .andThen(syntax.liftf[volga.pres.ConsoleArr,
                          ((String, String), String),
                          (String, (String, String))] {
      case ((xs, ys), zs) => (zs, (xs, ys))
    })
    .andThen(ident[volga.pres.ConsoleArr, String].split(concat))
    .andThen(
      syntax.liftf[volga.pres.ConsoleArr,
                   (String, String),
                   (((String, String), String), String)] {
        case (zs, s) => (((zs, s), zs), s)
      })
    .andThen(concat.split(putLine).split(putLine))
    .andThen(syntax.liftf[volga.pres.ConsoleArr,
                          ((String, Unit), Unit),
                          String] {
      case ((t, ()), ()) => t
    })
    .andThen(putLine)

Volga

Haskell ArrowDo

Cons

  • Не добавляет параллельность ни автоматически, ни вручную
  • Ещё более нагруженный синтаксис, чем do

Pros

  • Автоматическая работа с MonadPlus

Симметричные моноидальные категории

  • volga.syntax.arr - Стрелки
  • volga.syntax.symon - СМК

Симметричные моноидальные категории

  1. Не позволяют переносить функции
  2. Не позволяют переиспользовать результат
  3. Не позволяют выбрасывать результат 
  4. Единица может быть получена и выброжена

Симметричные моноидальные категории

Симметричные моноидальные категории

  1. Реактивные потоки
  2. Протоколы распределённых приложений
  3. serverless
  4. Языки запросов СУБД
  5. Бизнес-правила
  6. (ко) Эффекты

Будущее

  • volga.syntax.arr - Стрелки
  • volga.syntax.symon - СМК
  • volga.syntax.cc - Декартовы категории
  • volga.syntax.smcc - Замкнутые категории
  • volga.syntax.сcc - Декартово-замкнутые категории

Будущее - условные конструкции

  • if (v) arr1(a ,b, c) else arr2(d, e)
    (ArrowChoice)
  • pattern matching?
  • *-autonomous category ?

Будущее - типы данных ?

  • Алгебраические типы данных?
  • Алгебраические функторы ?
  • (ко) индуктивные типы ?

Будущее - (ко) моноиды

trait MonoidSMC[A, ->[_, _], x[_, _], I]{
  def zero: I -> A
  def combine: (A x A) -> A
}

trait ComonoidSMC[A, ->[_, _], x[_, _],  I]{
  def drop: A -> I
  def duplicate: A -> (A x A)
}
var logging: Logging = _

logging = action1(a, b)

logging = action2(c, d, e)

Спасибо за внимание!

 

email: odomontois@gmail.com, o.nizhnikov@tinkoff.ru

telegram: @odomontois

 

asymmon

By Oleg Nizhnik

asymmon

  • 1,028

More from Oleg Nizhnik