泛函编程(31)-泛函IO:Free Monad-Running free

  在上节我们介绍了Free Monad的基本情况。可以说Free Monad又是一个以数据结构替换程序堆栈的实例。实际上Free Monad的功能绝对不止如此,以heap换stack必须成为Free Monad的运算模式,这样我们才可以放心的使用Free Monad所产生的Monadic编程语言了。前面我们介绍了Trampoline的运算模式可以有效解决堆栈溢出问题,而上节的Free Monad介绍里还没有把Free Monad与Trampoline运算模式挂上钩。我们先考虑一下如何在Free Monad数据类型里引入Trampoline运算模式。

我们先对比一下Tranpoline和Free这两个数据类型的基本结构:

 1 trait Free[F[_],A] {
 2  private case class FlatMap[B](a: Free[F,A], f:A => Free[F,B]) extends Free[F,B]
 3  def unit(a: A) = Return(a)
 4  def flatMap[B](f: A => Free[F,B])(implicit F: Functor[F]): Free[F,B] = this match {
 5      case Return(a) => f(a)
 6      case Suspend(k) => Suspend(F.map(k)( _ flatMap f))
 7      case FlatMap(b,g) => FlatMap(b, x => g(x) flatMap f) //FlatMap(b, g andThen (_ flatMap f))
 8  }
 9  def map[B](f: A => B)(implicit F: Functor[F]): Free[F,B] = flatMap(a => Return(f(a)))
10 }
11 case class Return[F[_],A](a: A) extends Free[F,A]
12 case class Suspend[F[_],A](ffa: F[Free[F,A]]) extends Free[F,A]
13 trait Trampoline[A] {
14   private case class FlatMap[B](a: Trampoline[A], f: A => Trampoline[B]) extends Trampoline[B]
15     final def runT: A = resume match {
16         case Right(a) => a
17         case Left(k) => k().runT
18     }
19     def unit[A](a: A) = Done(a)
20     def flatMap[B](f: A => Trampoline[B]): Trampoline[B] = this match {
21 //        case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)
22 //        case FlatMap(b,g) => FlatMap(b, x => FlatMap(g(x),f))
23     case FlatMap(b,g) => FlatMap(b, x => g(x) flatMap f)
24         case x => FlatMap(x,f)
25     }
26     def map[B](f: A => B): Trampoline[B] = flatMap(a => More(() => Done(f(a))))
27     final def resume: Either[() => Trampoline[A],A] = this match {
28         case Done(a) => Right(a)
29         case More(k) => Left(k)
30         case FlatMap(a,f) => a match {
31             case Done(v) => f(v).resume
32             case More(k) => Left(() => FlatMap(k(),f))
33             case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume
34         }
35     }
36 }
37 case class Done[A](a: A) extends Trampoline[A]
38 case class More[A](k: () => Trampoline[A]) extends Trampoline[A]

这两个数据类型的设计目的都是为了能逐步运行算法:按照算法运算的状态确定下一步该如何运行。这个F[Free[F,A]]就是一个循环递归结构,里面保存了运算当前状态和下一步运算。

我们曾说如果一个数据类型能有个Functor实例,那么我们就可以用它来产生一个Free Monad。这个要求从上面Free[F,A]类型里的map,flatMap可以了解:我们用了implicit F: Functor[F]参数,因为必须有个Functor实例F才能实现map和flatMap。

为了实现Free Monad在运行中采用Trampoline运行机制,我们可以像Trampoline数据类型一样来实现resume,这个确定每一步运算方式的函数:

 1 trait Free[F[_],A] {
 2  private case class FlatMap[B](a: Free[F,A], f:A => Free[F,B]) extends Free[F,B]
 3  def unit(a: A) = Return(a)
 4  def flatMap[B](f: A => Free[F,B])(implicit F: Functor[F]): Free[F,B] = this match {
 5      case Return(a) => f(a)
 6      case Suspend(k) => Suspend(F.map(k)( _ flatMap f))
 7      case FlatMap(b,g) => FlatMap(b, x => g(x) flatMap f) //FlatMap(b, g andThen (_ flatMap f))
 8  }
 9  def map[B](f: A => B)(implicit F: Functor[F]): Free[F,B] = flatMap(a => Return(f(a)))
10  final def resume(implicit F: Functor[F]): Either[F[Free[F,A]],A] = this match {
11        case Return(a) => Right(a)
12        case Suspend(k) => Left(k)
13        case FlatMap(a,f) => a match {
14            case Return(v) => f(v).resume
15            case Suspend(k) => Left(F.map(k)(_ flatMap f))
16            case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume
17        }
18  }
19 }
20 case class Return[F[_],A](a: A) extends Free[F,A]
21 case class Suspend[F[_],A](ffa: F[Free[F,A]]) extends Free[F,A]

Free类型的resume函数与Trampoline的基本一致,只有返回类型和增加了参数implicit F: Functor[F],因为Free[F,A]的F必须是个Functor:用Functor F可以产生Free[F,A]。

我们用个实际例子来体验一下用Functor产生Free:

我们可以用上一节的Interact类型:

1 trait Interact[A]
2 case class Ask(prompt: String) extends Interact[String]
3 case class Tell(msg: String) extends Interact[Unit]

这个类型太简单了,太单纯了。我还没想到如何得出它的Functor实例。好像没办法实现那个map函数。那么如果修改一下这个Interact类型:

1 trait Interact[A]
2 case class Ask[A](prompt: String, next: A) extends Interact[A]
3 case class Tell[A](msg: String, next: A) extends Interact[A]

这个新类型的两个状态Ask,Tell都增加了个参数next,代表下一步操作。实际上我们是用map来运行next的。这样我们就可以得出Interact的Functor实例。

1 trait Interact[A]
2 case class Ask[A](prompt: String, next: A) extends Interact[A]
3 case class Tell[A](msg: String, next: A) extends Interact[A]
4 implicit val interactFunctor = new Functor[Interact] {
5     def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
6             case Ask(x,n) => Ask(x,f(n))
7             case Tell(x,n) => Tell(x,f(n))
8     }
9 }                                                 //> interactFunctor  : ch13.ex1.Functor[ch13.ex1.Interact] = ch13.ex1$$anonfun$

从上面的Functor实例中我们可以看到如何通过map的f(n)来运行下一步骤next。

接下来我们要把Interact类型升格到Free类型:

 1 def liftF[F[_],A](fa: F[A])(implicit F: Functor[F]): Free[F,A] = {
 2     Suspend(F.map(fa)(a => Return(a)))
 3 }                                                 //> liftF: [F[_], A](fa: F[A])(implicit F: ch13.ex1.Functor[F])ch13.ex1.Free[F,
 4                                                   //| A]
 5 implicit def LiftInteract[A](ia: Interact[A]): Free[Interact,A] = liftF(ia)
 6                                                   //> LiftInteract: [A](ia: ch13.ex1.Interact[A])ch13.ex1.Free[ch13.ex1.Interact,
 7                                                   //| A]
 8 val prg = for {
 9     first <- Ask("What's your first name?",())
10     last <- Ask("What's your last name?",())
11     _ <- Tell(s"Hello $first $last",())
12 } yield ()                                        //> prg  : ch13.ex1.Free[ch13.ex1.Interact,Unit] = Suspend(Ask(What's your firs
13                                                   //| t name?,Suspend(Ask(What's your last name?,Suspend(Tell(Hello () (),Return(
14                                                   //| ())))))))

看,把Interact升格后就可以使用for-comprehension了。

还是那句话:用一个有Functor实例的类型就可以产生一个Free Monad。然后我们可以用这个产生的Monad来在for-comprehension里面编写一个算法。

解译运算(Interpret)是Free Monad的Interpreter功能。我们说过要把Trampoline运行机制引入Free Monad运算:

1  def foldMap[G[_]](f: F ~> G)(implicit F: Functor[F], G: Monad[G]): G[A] = resume match {
2        case Right(a) => G.unit(a)
3        case Left(k) => G.flatMap(f(k))(_ foldMap f)
4  }

foldMap通过调用resume引入了Trampoline运行机制。

前面介绍的Free Monad相对都比较简单。实际上Free Monad的Suspend处理可以是很复杂的,包括返回结果及接受输入等任何组合。下面我们再看一个较复杂的例子:我们可以把State视为一种简单的状态转变编程语言,包括读取及设定状态两种操作指令:

1 trait StateF[S,A]
2 case class Get[S,A](f: S => A) extends StateF[S,A]
3 case class Put[S,A](s: S, a: A) extends StateF[S,A]

我们先看看嫩不能获取StateF的Functor实例:

1 mplicit def stateFFunctor[S] = new Functor[({type l[x] = StateF[S,x]})#l] {
2     def map[A,B](sa: StateF[S,A])(f: A => B): StateF[S,B] = sa match {
3          case Get(g) => Get( s => f(g(s)) )
4          case Put(s,a) => Put(s, f(a))
5     }
6 }                                                 //> stateFFunctor: [S]=> ch13.ex1.Functor[[x]ch13.ex1.StateF[S,x]]

既然有了Functor实例,那么我们可以用来产生Free Monad:

1 type FreeState[S,A] = Free[({type l[x] = StateF[S,x]})#l, A]

Free[F,A]里的Functor F只接受一个类型参数。StateF[S,A]有两个类型参数,我们必须用type lambda来解决类型参数匹配问题。

现在我们已经得到了一个FreeState Monad。下面接着实现FreeState的基础组件函数:

1 def unit[S,A](a: A): FreeState[S,A] = Return[({type l[x] = StateF[S,x]})#l, A](a)
2                                                   //> unit: [S, A](a: A)ch13.ex1.FreeState[S,A]
3 def getState[S]: FreeState[S,S] = Suspend[({type l[x] = StateF[S,x]})#l, S](
4     Get(s => Return[({type l[x] = StateF[S,x]})#l, S](s)))
5                                                   //> getState: [S]=> ch13.ex1.FreeState[S,S]
6 def setState[S](s: S): FreeState[S,Unit]  = Suspend[({type l[x] = StateF[S,x]})#l, Unit](
7     Put(s, Return[({type l[x] = StateF[S,x]})#l, Unit](())))
8                                                   //> setState: [S](s: S)ch13.ex1.FreeState[S,Unit]

注意类型匹配。我们可以写个函数来运算这个FreeState:

1 def evalS[S,A](s: S, t: FreeState[S,A]): A = t.resume match {
2     case Right(a) => a
3     case Left(Get(f)) => evalS(s, f(s))
4     case Left(Put(n,a)) => evalS(n,a)
5 }                                                 //> evalS: [S, A](s: S, t: ch13.ex1.FreeState[S,A])A

这个运算方式还是调用了resume函数。注意:Get(f) 返回 StateF[S,A],StateF是个Functor, F[Free[F,A]]那么A就是Free[F,A]

还是试试运算那个zipIndex函数:

 1 def zipIndex[A](as: List[A]): List[(Int, A)] = {
 2     evalS(1, as.foldLeft(unit[Int,List[(Int,A)]](List()))(
 3       (acc,a) => for {
 4           xs <- acc
 5           n <- getState
 6           _ <- setState(n+1)
 7       } yield (n, a) :: xs)).reverse
 8 }                                                 //> zipIndex: [A](as: List[A])List[(Int, A)]
 9 
10 zipIndex((0 to 10000).toList)                     //> res0: List[(Int, Int)] = List((1,0), (2,1), (3,2), (4,3), (5,4), (6,5), (7,
11                                                   //| 6), (8,7), (9,8), (10,9), (11,10), (12,11), (13,12), (14,13), (15,14), (16,
12                                                   //| 15), (17,16), (18,17), (19,18), (20,19), (21,20), (22,21), (23,22), (24,23)

没错,这段程序不但维护了一个状态而且使用了Trampoline运算模式,可以避免StackOverflow问题。

下面我们再用一个例子来示范Free Monad的Monadic Program和Interpreter各自的用途:

我们用一个Stack操作的例子。对Stack中元素的操作包括:Push,Add,Sub,Mul,End。这几项操作也可被视作一种Stack编程语言中的各项操作指令:

1 trait StackOps[A]
2 case class Push[A](value: Int, ops:A) extends StackOps[A]
3 case class Add[A](ops: A) extends StackOps[A]
4 case class Mul[A](ops: A) extends StackOps[A]
5 case class Dup[A](ops: A) extends StackOps[A]
6 case class End[A](ops: A) extends StackOps[A]

我们先推导它的Functor实例:

1 implicit val stackOpsFunctor: Functor[StackOps] = new Functor[StackOps] {
2     def map[A,B](oa: StackOps[A])(f: A => B): StackOps[B] = oa match {
3         case Push(v,a) => Push(v,f(a))
4         case Add(a) => Add(f(a))
5         case Mul(a) => Mul(f(a))
6         case Dup(a) => Dup(f(a))
7         case End(a) => End(f(a))
8     }
9 }

 这里的next看起来是多余的,但它代表的是下一步运算。有了它才可能得到Functor实例,即使目前每一个操作都是完整独立步骤。

有了Functor实例我们就可以实现StackOps的Monadic programming:

 1 def liftF[F[_],A](fa: F[A])(implicit F: Functor[F]): Free[F,A] = {
 2     Suspend(F.map(fa)(a => Return(a)))
 3 }                                                 //> liftF: [F[_], A](fa: F[A])(implicit F: ch13.ex1.Functor[F])ch13.ex1.Free[F,
 4                                                   //| A]
 5 implicit def liftStackOps[A](sa: StackOps[A]): Free[StackOps,A] = liftF(sa)
 6                                                   //> liftStackOps: [A](sa: ch13.ex1.StackOps[A])ch13.ex1.Free[ch13.ex1.StackOps,
 7                                                   //| A]
 8 val stkprg = for {
 9     _ <- Push(1,())
10     _ <- Push(2,())
11     _ <- Add(())    
12 } yield x                                         //> stkprg  : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu
13                                                   //| sh(2,Suspend(Add(Suspend(Pop(Return(())))))))))

我们用lisftStackOps函数把StackOps升格到Free[StackOps,A]后就可以用for-comprehension进行Monadic programming了。如果不习惯Add(())这样的表达式可以这样:

 1 def push(value: Int) = Push(value,())             //> push: (value: Int)ch13.ex1.Push[Unit]
 2 def add = Add(())                                 //> add: => ch13.ex1.Add[Unit]
 3 def sub = Sub(())                                 //> sub: => ch13.ex1.Sub[Unit]
 4 def mul = Mul(())                                 //> mul: => ch13.ex1.Mul[Unit]
 5 def end = End(())                                 //> end: => ch13.ex1.End[Unit]
 6 val stkprg = for {
 7     _ <- push(1)
 8     _ <- push(2)
 9     _ <- add
10     _ <- push(4)
11     _ <- mul
12 } yield ()                                        //> stkprg  : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu
13                                                   //| sh(2,Suspend(Add(Suspend(Push(4,Suspend(Mul(Return(())))))))))))

这样从文字意思上描述就清楚多了。但是,这个stkprg到底是干什么的?如果不从文字意义上解释我们根本不知道这段程序干了些什么,怎么干的。换句直白的话就是:没有意义。这正是Free Monad功能精妙之处:我们用Monad for-comprehension来编写一段Monadic program,然后在Interpreter中赋予它具体意义:用Interpreter来确定程序具体的意义。

那我们就进入Interpreter来运算这段程序吧。

先申明Stack类型: type Stack = List[Int]

在上面我们有个Interpreter, foldMap:

1  def foldMap[G[_]](f: F ~> G)(implicit F: Functor[F], G: Monad[G]): G[A] = resume match {
2        case Right(a) => G.unit(a)
3        case Left(k) => G.flatMap(f(k))(_ foldMap f)
4  }

但是运行stkprg必须传入Stack起始值,foldMap无法满足。那么我们再写另一个runner吧:

 1  final def foldRun[B](b: B)(f: (B, F[Free[F,A]]) => (B, Free[F,A]))(implicit F: Functor[F]): (B, A) = {
 2       @annotation.tailrec
 3       def run(t: Free[F,A], z: B): (B, A) = t.resume match {
 4               case Right(a) => (z, a)
 5               case Left(k) => {
 6                   val (b1, f1) = f(z, k)
 7                   run(f1,b1)
 8               }
 9       }
10       run(this,b)
11  }

foldRun也是个折叠算法:给予一个起始值及一个对数据结构内部元素的处理函数然后可以开始运行。这个函数刚好符合我们的需要。下一步就是给予stkprg意义:确定Push,Add...这些指令具体到底干什么:

 1 type Stack = List[Int]
 2 def stackFn(stack: Stack, prg: StackOps[Free[StackOps,Unit]]): (Stack, Free[StackOps,Unit]) = prg match {
 3     case Push(v, n) => {
 4         (v :: stack, n)
 5     }
 6     case Add(n) => {
 7         val hf :: hs :: t = stack
 8         ((hf + hs) :: stack, n)
 9     }
10     case Sub(n) => {
11         val hf :: hs :: t = stack
12         ((hs - hf) :: stack, n)
13     }
14     case Mul(n) => {
15         val hf :: hs :: t = stack
16         ((hf * hs) :: stack, n)
17     }
18 }                                                 //> stackFn: (stack: ch13.ex1.Stack, prg: ch13.ex1.StackOps[ch13.ex1.Free[ch13.
19                                                   //| ex1.StackOps,Unit]])(ch13.ex1.Stack, ch13.ex1.Free[ch13.ex1.StackOps,Unit])

啊。。。在这里我们才能具体了解每一句StackOps指令的意义。这就是Free Monad Interpreter的作用了。我们试着运算这个stkprg:

1 val stkprg = for {
2     _ <- push(1)
3     _ <- push(2)
4     _ <- add
5     _ <- push(4)
6     _ <- mul
7 } yield ()                                        //> stkprg  : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu
8                                                   //| sh(2,Suspend(Add(Suspend(Push(4,Suspend(Mul(Return(())))))))))))
9 stkprg.foldRun(List[Int]())(stackFn)              //> res0: (List[Int], Unit) = (List(12, 4, 3, 2, 1),())

跟踪一下操作步骤,最终结果是正确的。 我们再试一下用Natural Transformation原理的foldMap函数。我们可以用State的runS来传入Stack初始值:

1 type StackState[A] = State[Stack,A]
2 implicit val stackStateMonad = new Monad[StackState] {
3     def unit[A](a: A) = State(s => (a,s))
4     def flatMap[A,B](sa: StackState[A])(f: A => StackState[B]): StackState[B] = sa flatMap f
5 }                                                 //> stackStateMonad  : ch13.ex1.Monad[ch13.ex1.StackState] = ch13.ex1$$anonfun$
6                                                   //| main$1$$anon$5@26f67b76

这个StackState类型就是一个State类型。我们能够推导它的Monad实例,那我们就可以调用foldMap了。我们先编写Interpreter功能:

 1 object StackOperator extends (StackOps ~> StackState) {
 2   def apply[A](sa: StackOps[A]): StackState[A] = sa match {
 3       case Push(v,n) => State((s: Stack) => (n, v :: s))
 4       case Add(n) => State((s: Stack) => {
 5           val hf :: hs :: t = s
 6           (n, (hf + hs) :: s)
 7       })
 8       case Sub(n) => State((s: Stack) => {
 9           val hf :: hs :: t = s
10           (n, (hs - hf) :: s)
11       })
12       case Mul(n) => State((s: Stack) => {
13           val hf :: hs :: t = s
14           (n, (hf * hs) :: s)
15       })
16   }
17 }

通过Natural Transformation把StackOps转成StackState状态维护。StackOps具体意义也在这里才能得到体验。我们用foldMap运算stkprg:

1 stkprg.foldMap(StackOperator).runS(List[Int]())   //> res1: (Unit, ch13.ex1.Stack) = ((),List(12, 4, 3, 2, 1))

我们得到了同样的运算结果。

希望通过这些例子能把Free Monad的用途、用法、原理解释清楚了。

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

发表于

我来说两句

0 条评论
登录 后参与评论

相关文章

来自专栏函数式编程语言及工具

Scalaz(49)- scalaz-stream: 深入了解-Sink/Channel

   一个完整的scalaz-stream有以下几个部分组成:Source -> Transducer -> Sink,用直白文字来描述就是:“输入 -> 传换...

1798
来自专栏技术之路

WPF之TreeList的实现方法(一)

做项目的时候根据需求,WPF现有的控件不能完全满足我们的需求, 很多时候我们需要对现有的控件做一下加工。 最简单的我们可能会把Tree转换成List形式有的叫G...

1965
来自专栏xingoo, 一个梦想做发明家的程序员

AngularJS 使用ngOption实现下拉列表

最近使用到了ngOption实现下拉选择列表,由于需要实现分组等功能,百度了下没有太好的文章,就百度到一篇英文的帖子,按照其中的代码很顺利的搞定了。 本篇根...

18310
来自专栏跟着阿笨一起玩NET

C# EPL USB 指令打印

331
来自专栏前端杂货铺

Blob初探

简介   Blob在js中意味着二进制大数据。实现该接口的对象有3个属性,分别是type(MIME),size(byte)和 一个切割方法:slice(在大文件...

2293
来自专栏用户2442861的专栏

HttpEntity的类型及其使用

  代表底层流的基本实体。通常是在http报文中获取的实体。他只有一个空参的构造方法。刚创建时没有内容,长度为负值。需要通过两个方法,把值赋进去。

341
来自专栏函数式编程语言及工具

SDP(6):分布式数据库运算环境- Cassandra-Engine

    现代信息系统应该是避不开大数据处理的。作为一个通用的系统集成工具也必须具备大数据存储和读取能力。cassandra是一种分布式的数据库,具备了分布式数据...

2904
来自专栏快乐八哥

Angular企业级开发(8)-控制器的作用域

scope概念 scope(作用域)是视图和控制器之间的桥梁,scope本身是一个对象,有方法和属性。scope可以应用在视图和控制器上。 scope简单示例 ...

1765
来自专栏大内老A

Enterprise Library Policy Injection Application Block 之三:PIAB的扩展—创建自定义CallHandler(提供Source Code下载)

本系列的第一部分对PIAB使用场景进行了简单的介绍,作中阐述了通过PI(Policy Injection)的方式实现了Business Logic和Non-Bu...

25710
来自专栏软件开发

MyBatis学习总结(二)——MyBatis核心配置文件与输入输出映射

在上一章中我们学习了《MyBatis学习总结(一)——ORM概要与MyBatis快速起步》,这一章主要是介绍MyBatis核心配置文件、使用接口+XML实现完整...

553

扫码关注云+社区