Стрелочная и моноидальная композиция

в 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
}

Изоморфизм

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

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

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

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)
}
trait Symon[->[_, _], x[_, _], I] extends MonoidalCat[->, x, I]
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
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
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 e: A} {\Gamma \vdash f(e) : B}

Variable

Application

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

Abstraction

\Gamma = \{ a : A, b : B, c : C \}

Lambek Сorrespondence

\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

Монады

trait Monad[F[_]] {
  def pure[A](a: A): F[A]
  def flatMap[A, B](a: A)(f: A => F[B]): F[B]
}

Используют функции - продолжения  для композиции

  • Используют все возможности языка
  • Непрозрачны

Задача

  1. Выразить процесс, который может читать и писать строки в консоли
  2. Процесс должен уметь выполнять произвольные чистые преобразование над обрабатываемыми данными
  3. Реализовать процесс echo2 : прочитать две строки из консоли и вывести в консоль сконкатенированный результат
  4. Реализовать функцию countGets, которая определит для любого процесса, сколько раз он прочитает строку из консоли

Попытка 1: Монады

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

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

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
}
import cats.arrow.Arrow

Попытка 3: Стрелки

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
  }

Попытка 3: Стрелки

Возможности

Задача 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

Volga

arrow(a, b, c)

(x, y, z)
arrow(a, b, c)

val x = arrow(a, b, c)

val (x, y, z) = arrow(a, b, c)

arr( (x, y, z) =>

Передача параметров

Промежуточные вычисления

Результат

Haskell ArrowDo

Cons

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

Pros

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

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

https://arxiv.org/pdf/1007.2885.pdf

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

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

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

  • Чистота
  • Тотальность
  • Линейная семантика
  • Tagless Final Friendly
  trait Symon[->[_, _], x[_, _], I]{
    def id[A]: A -> A
    def compose[A, B, C](f: B -> C, g: A -> B): A -> C
    def tensor[A, B, C, D](f: A -> C, g: B -> D): (A x B) -> (C x D)
    def assocl[A, B, C]: (A x (B x C)) -> ((A x B) x C)
    def swap[A, B]: (A x B) -> (B x A)
    def lunit[A]: (I x A) -> A
    def unitl[A]: A -> (I x A)
  }

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

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

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

Будущее

  • 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