用F# workflow实现amb

Workflow是F#的一个强大功能，既便不深入编译器，也不用stack hack，我们也可以用F#模拟出amb，从而更优雅得写出解决如回溯查找一类问题的程序。先从最简单的例子开始：

let nc0 =
    nondeter { let! x = Amb.choose [1;2;3]
               return x}

这段程序的含义为，x取1，2，3中任意一个值，然后返回x的值。得到nc0的类型为seq<int>，代表所有可能的计算结果的集合，在这段简单的程序里就是1、2和3。

如果有多个不确定变量呢： 

 

let nc1 =

    nondeter { let! x = Amb.choose [1;2]
               let! y = Amb.choose [3;4]
               return (x,y)

             }

< p>那么当x取值为1的时候，y第一次取值为3，结果成为nc1的第一值。然后x保持不变，y取另一个值4。此时y可能的值已经用完，又回到对x值 的选择，x取下一个值2，y重新开始取值3。最后y取4，x,y所有可能的取值用光。nc1的结果为(1, 3)、 (1, 4)、 (2, 3)、 (2, 4)。

 

可以用Amb.require限制不确定变量的取值满足一定条件：

 

let nc2 =
    nondeter{ let! y = Amb.choose [10;20;30]
              let! x = Amb.choose [1;2;3]
              let! z = Amb.choose [3;4;5]
              do Amb.require(x+y/10>z)

              return x+y+z}

这段程序的含义是：对所有的y∈{10, 20, 30} x∈{1,2,3} z∈{3,4,5}，只要有满足x+y/10>z的x、y、z取值，就返回x+y+z。

< p>以上三个例子好像跟用for循环没有什么区别，的确，amb的真正威力在于每次进行不确定取值时，程序（确切的说是程序执行过程的堆栈）自动回 到上次取值时的状态，因此程序执行到不确定取值处时好像是分叉了一般，每个分支取一个值接着执行。为了在F#中模拟出这种“保持堆栈状态”的语言，我们要 求所有的变量用let <id> = Amb.preserve <value>的形式初始化，得到<id>的类型为ref<type of "value">。需要引用变量<id>的地方写成!<id>，需要改变 <id>的值时写do <id>:= <new value>。看下面的程序：

 

let nc7 =
    nondeter {let c = Amb.preserve 0
              while !c < 2 do
                  let! x = Amb.choose [0; 1]
                  do printfn "c=%d x=%d" !c x  
                  do c:= !c+1
             }

得到nc7的类型为seq<unit>，原因是nodeter内没有return，所以不返回任何东西，只利用其运行过程中的副效应（do printfn ...），遍历nc7，控制台上打印出：

c=0 x=0
c=1 x=0
c=1 x=1
c=0 x=1
c=1 x=0

c=1 x=1

< p>说明一下原理：Amb.choose在选择一个不确定值之前，会把所有用Amb.preserve初始化的变量存一个快照；每选择一个值的时 候，Amb.choose会把所有用Amb.preserve初始化的变量恢复到之前快照的值，以此模拟出保存堆栈的效果。

 

< p>这里是一个稍稍有些真实感的例子，我们用F#的模拟amb解决 这个问题：

 

#light

type Answer =
 | A = 0
 | B = 1
 | C = 2
 | D = 3
 | E = 4

(*
Each of the function represents a question.
The function is given the "answers" array of answers, in which 
the questions before index "endassign" are assigned answers.
Each function checks whether "this" answer is the only correct answer of 
the question it presents.
*)
let checkers = [|
    (fun answers endassign this ->
         let firstB = [|1;2;3;4;5|].[Enum.to_int this] 
         firstB >= endassign || 
             (answers |> Array.tryfind_index (fun x->x=Answer.B))
              =Some(firstB)
    );

    (fun answers endassign this ->
         let idx=[|1;2;3;4;5|].[Enum.to_int this]
         answers |> Seq.take endassign //ignore unchoiced ones
                 |> Seq.pairwise  
                 |> Seq.mapi (fun i x->(i, x)) 
                 |> Seq.for_all (fun (i,(pred,suc))->
                                     if i=idx then pred=suc
                                     else pred<>suc)
    )

    (fun answers endassign this ->
         let same=[|0;1;3;6;5|].[Enum.to_int this]
         same>=endassign || answers.[same]=this
    )

    //4
    (fun answers endassign this ->
         let numA = [|0;1;2;4;5|].[Enum.to_int this]
         endassign < (Array.length answers) or
         answers |> Seq.filter (fun x->x=Answer.A)
                 |> Seq.length = numA
    )

    //5
    (fun answers endassign this ->
         let same=[|9;8;7;6;5|].[Enum.to_int this]
         same>=endassign || answers.[same]=this
    )

    //6
    (fun answers endassign this ->
         endassign < (Array.length answers) or
         let counts = Array.create 5 0
         for a in answers do
             counts.[Enum.to_int a] <- counts.[Enum.to_int a]+1
         match counts |> Seq.filter (fun c->c=counts.[0]) |> Seq.length with
          |1 -> this=Answer.E 
          |2 -> this<>Answer.E && 
                 counts.[[|1;2;3;4|].[Enum.to_int this]]=counts.[0]
          |_ -> false // multiple correct answers is not allowed
    )
    
    //7
    (fun answers endassign this ->
         endassign <= 7 or
         let next = answers.[7]
         [|4;3;2;1;0|].[Enum.to_int this] = 
          abs (Enum.to_int this)-(Enum.to_int next)
    )

    //8
    (fun answers endassign this ->
         endassign < (Array.length answers) or
         (answers |> Seq.filter (fun a->a=Answer.A || a=Answer.E)
                  |> Seq.length) = [|2;3;4;5;6|].[Enum.to_int this]
    )

    //9
    (fun answers endassign this ->
         endassign < (Array.length answers) or
         let numCon =answers |> Seq.filter (fun a->a<>Answer.A && a<>Answer.E)
                             |> Seq.length
         ([(Answer.A,[2;3;5;7]); 
           (Answer.B,[1;2;6]);
           (Answer.C,[1;4;9]);
           (Answer.D,[1;8]);
           (Answer.E,[0;5;10])
          ] |> Seq.filter (fun (a,c)-> this=a && (c |> Seq.exists (fun x->x=numCon) ))
            |> Seq.length
         )=1
    )
    
    //10
    (fun answers endassign this->true)
|]  

(*
Build a nondeterministic "routine" to find the answers
*)
let solution = 
    nondeter{let answers=Array.create (Array.length checkers) Answer.A //arbitrary 
             let c=Amb.preserve 0
             while !c<(Array.length checkers) do
                 let! a=Amb.choose [Answer.A;Answer.B;Answer.C;Answer.D;Answer.E] 
                 do answers.[!c]<- a
                 do c:= !c+1
                 if not (checkers |> Seq.take !c 
                                  |> Seq.mapi (fun i chk->chk answers !c answers.[i]) 
                                  |> Seq.for_all (fun b->b)) 
                 then
                     // the answers so far don't satisfy the problem
                     // so backtrack
                     do Amb.fail()
                 else if !c=(Array.length checkers) then
                     // all requirements are satisfied
                     do printfn "find an answer %A" answers
    }

Amb.run solution

最后是实现amb模拟的代码，即nondeter的定义：

#light
exception ChooseFailException of unit

type NondeterBuilder() =
    let mutable reverterBuilders:list<unit->(unit->unit)> = []
    
    member b.Bind(amb, f) = // call f with each choice in amb and collect the results
        let reverters = reverterBuilders |> List.map (fun b->b())
        let trychoice c= reverters |> Seq.iter (fun r->r()) //todo: don't revert at the first time
                         try Some(f c) 
                         with  ChooseFailException() -> None 
        let picksome s = seq{for x in s when x<>None -> Option.get x}
        {for x in (amb |> Seq.map trychoice |> picksome) ->> x }


    member b.Return(x) = Seq.singleton x
    member b.Let(v,f) = f v //???: {yield! f v}
    //member b.For(range, body) = 
    member b.Delay(f:unit->seq<'a>) = { yield! f()}
    member b.Combine((e1:seq<unit>), (e2:seq<'a>)) = //fixme: clear revert list
        {for _ in e1 ->> e2}
    member b.Zero() = Seq.singleton ()
    member b.While(cond, (body: seq<unit>)) =
        let rec (evalwhile cond body):seq<unit> = 
            {if cond() then for _ in body ->>(evalwhile cond body)
             else yield ()}
        evalwhile cond body
 
    member b.AddRevertible (r:'a ref) = 
        let rb () =
            let old = !r
            fun () -> r:=old
        reverterBuilders <- rb::reverterBuilders

let nondeter = new NondeterBuilder()



module Amb =
    let choose (c:#seq<'a>) = c
    let fail () = raise (ChooseFailException())
    let require cond = if not cond then fail()
    let preserve v = 
        let r = ref v
        nondeter.AddRevertible r
        r
    let run nc = nc |> Seq.iter (fun _->())