Observations

// T будет траверсабельным, если определены:
trait Traversable[T[_]] {
  // для аппликативного функтора app и функции f обход структуры as
  def traverse[A, B, F[_]](app: Applicative[F])(f: A => F[B])(as: T[A]): F[T[B]]
  // и для, скажем, дерева аппликативов можно построить один аппликатив с деревом внутри
  def dist[B, F[_]](app: Applicative[F]) = traverse[F[B], B, F](app)(identity[F[B]]) _
}

implicit object TraversableList extends Traversable[List] {
  def cons[A](a: A)(as: List[A]): List[A] = a :: as

  def traverse[A, B, F[_]](app: Applicative[F])(f: A => F[B])(al: List[A]): F[List[B]] = {
    al match {
      case Nil => app.pure(List[B]())
      case head :: tail => app.applicable(app.lift(cons[B] _) <@> f(head)) <*> traverse[A, B, F](app)(f)(tail)
    }
  }
}

trait Tree[T]
case class Leaf[T](t: T) extends Tree[T]
def leaf[T](t: T): Tree[T] = Leaf(t)
case class Node[T](left: Tree[T], right: Tree[T]) extends Tree[T]
def node[T](left: Tree[T])(right: Tree[T]): Tree[T] = Node(left, right)

implicit object TraversableTree extends Traversable[Tree] {

  def traverse[A, B, F[_]](app: Applicative[F])(f: A => F[B])(at: Tree[A]): F[Tree[B]] = at match {

    case Leaf(a) => app.lift(leaf[B]) <@> f(a)
    case Node(left, right) => {
      implicit def applicable[A, B](tf: F[A => B]) = app.applicable(tf)

      val traverse1: (Tree[A]) => F[Tree[B]] = traverse(app)(f)

      app.pure(node[B] _) <*> traverse1(left) <*> traverse1(right)
    }
  }
}

import TraversableList._

val distributor = dist[String, Set](AppSet)
val setOfLists = distributor(List(Set("a", "b"), Set("x", "y")))
setOfLists must_== Set(List("a", "x"), List("a", "y"), List("b", "x"), List("b", "y"))

import TraversableTree._

val distributor = dist[String, List](AppList)
val treeOfLists:Tree[List[String]] = Node(Leaf(List("a", "b")), Node(Leaf(List("x", "y", "z")), Leaf(List("1"))))
val listOfTrees = distributor(treeOfLists)
def tree(s: String) = Node(Leaf("" + s(0)), Node(Leaf("" + s(1)), Leaf("" + s(2))))
listOfTrees must_== List(tree("ax1"), tree("ay1"), tree("az1"), tree("bx1"), tree("by1"), tree("bz1"))

trait Functor[T[_]] { self =>
  // mapping on objects of a category
  type f0[_] = T[_]

  // mapping on arrows of a category
  def f1[A, B](f: A => B): T[A] => T[B]

  // builds a composition of two functors
  def andThen[U[_]](u: Functor[U]) = new Functor[({type UT[X] = U[T[X]]})#UT] {
    def f1[A, B](f: A => B): (U[T[A]]) => U[T[B]] = u.f1(self.f1(f))
  }
}

  /**
   * Functorial features of List type
   */
  trait ListFunctor extends Functor[List] {
    override def f1[A, B](f: A => B) = (aa: List[A]) =>  aa map f
  }

  /**
   * Functorial features of Seq type
   */
  trait SeqFunctor extends Functor[Seq] {
    override def f1[A, B](f: A => B) = (aa: Seq[A]) => aa map f
  }

  /**
   * Functorial features of Set type (covariant version)
   */
  trait SetFunctor extends Functor[Set] {
    override def f1[A, B](f: A => B) = (sa: Set[A]) => sa map f
  }

  /**
   * Functorial features of Either[X,Y], for the second parameter
   */
  trait RightEitherFunctor[L] extends Functor[({type Maybe[A] = Either[L, A]})#Maybe] {
    def f1[A, B](f: A => B): Either[L, A] => Either[L, B] = _.right.map(f)
  }

  type E = Any => Int

  type Env[X] = E => X

  trait EnvFunctor extends Functor[Env] {
    override def f1[A, B](f: A => B) = (aa: Env[A]) => aa andThen f
  }

trait Applicative[T[_]] extends Functor[T] { self =>
  def pure[A](a: A): T[A]

// below are additional enrichments, not exactly pertaining to Applicative
  def ap[A, B](fs: T[A => B]): (T[A] => T[B]) = (ta: T[A]) => fs <*> ta

  implicit def applicable[A, B](tf: T[A => B]): Applicable[A, B, T]

  trait Lifted[A, B, T[_]] { def <@>(ta: T[A]): T[B] }

  implicit def lift[A, B](fun: A => B) = new Lifted[A, B, T] {
    def <@>(ta: T[A]) = pure(fun) <*> ta
  }

  def andThen[U[_]](u: Applicative[U]) = new Applicative[({type UT[X] = U[T[X]]})#UT] {
    type UT[X] = U[T[X]]
    def f1[A, B](f: A => B): (U[T[A]]) => U[T[B]] = u.f1(self.f1(f))

    def pure[A](a: A) : U[T[A]] = u.pure(self.pure(a))

    implicit def applicable[A, B](utf: U[T[A => B]]) = {
      val uta2tb: U[(T[A]) => T[B]] = u.f1(self.ap[A, B])(utf)
      new Applicable[A, B, UT] {
        def <*>(uta: UT[A]) = u.applicable(uta2tb) <*> uta
      }
    }
  }
}

trait Applicable[A, B, T[_]] { def <*>(ta: T[A]): T[B] }

object AppList extends ListFunctor with Applicative[List] {
  override def pure[A](a: A) = List(a)

  override implicit def applicable[A, B](lf: List[A => B]): Applicable[A, B, List] = {
    new Applicable[A, B, List] {
      def <*>(as: List[A]) = (for (f <- lf; a <- as) yield f(a)).toList
    }
  }
}

    "ApplicativeList" should {
      "combine two lists" in {
        import applicative.All.AppList._
        def pp(i: Int) = (j: Int) => i + j * j

        val combinations:List[Int] = ap(List(pp(1), pp(2)))(List(10, 20, 30))
        combinations must_== List(101, 401, 901, 102, 402, 902)
      }
    }

object AppSet extends SetFunctor with Applicative[Set] {
  override def pure[A](a: A) = Set(a)

  override implicit def applicable[A, B](ff: Set[A => B]) = {
    val sf: Set[A => B] = ff
    new Applicable[A, B, Set] {
      def <*>(fa: Set[A]) = (for (f <- sf; a <- fa) yield f(a)).toSet
    }
  }
}

object AppZip extends SeqFunctor with Applicative[Seq] {

  override def pure[A](a: A): Seq[A] = Stream.continually(a) // повторяем пока кому-нибудь не надоест

  implicit def applicable[A, B](ff: Seq[A => B]) = {
    new Applicable[A, B, Seq] {
      def <*>(az: Seq[A]) = ff zip az map ({ case (f: (A => B), a: A) => f(a) }) // в Скале уже есть зип; применим его
    }
  }
}

"ZipList" should {
  import All.AppZip._

  "be able to zip functions with values" in {

    def prepend(prefix: String) = (s: String) => prefix + " " + s
    val result = (List(prepend("a"), prepend("the")) <*> List("quick brown fox jumps over ", "lazy dog "))
    result must_== List("a quick brown fox jumps over ", "the lazy dog ")
  }
}

"be able to transpose a matrix" in {

  trait matrices[A] { // матрицы с абстрактными элементами
    type matrix = Seq[Seq[A]]

    val glue: Seq[A => List[A] => List[A]] = pure(cons _) // функция, конкатенирующая элемент и список, применяется к последовательности

    def transpose(m: matrix): matrix = if (m.isEmpty) Nil else transposeNonempty(m) // приходится различать пустую и непустую, потому что размерность не указывать

    def transposeNonempty(m: matrix): matrix = { // нетривиальная часть
      m match {
        case Nil => pure(Nil) // это на случай, когда непустой вектор склеиваем с пустой матрицей
        case row :: rows => { // типичный случай - применим клей к row и остатку
          glue <*> row <*> transposeNonempty(rows)
        }
      }
    }
  }

  object m extends matrices[Int]
  import m._

  val m0x0: m.matrix = transpose(List[List[Int]]()).toList
  m0x0 must_== List() // мы не можем даже выразить m0x1

  val m0x1: m.matrix = transpose(List(List[Int]()))
  m0x1 must_== List()

  val m2x1: m.matrix = transpose(List(List(1, 2)))
  m2x1 must_== List(List(1), List(2))

  val m1x2: m.matrix = transpose(List(List(1), List(2))).toList
  m1x2 must_== List(List(1,2))

  val m2x2 = transpose(List(List(11, 12), List(21, 22))).take(12).toList
  m2x2 must_== List(List(11, 21), List(12, 22))
}