Монада недетерминированных вычислений

gistfile1.fs

(* Nondeterministic *)
type Nondet<'a> = 'a list
let ret x = [x]
let ret' x = x
let fail = []

let (>>=) mA b = List.collect b mA

ret' [1;2;3] >>= fun x -> 
 [x+1;x+2]

ret' [0..9] >>= fun x->
 List.map (fun z -> z*10+x) [0..9]

ret 10 >>= fun x -> ret (x*2)
  
(* Nondet Computation Expressions *)

type NondetBuilder() =
  member b.Return(x) = ret x
  member b.Bind(mA,b) = mA >>= b
  member b.Zero() = fail
  member b.Combine(a,b) = a@b
  member b.Delay(x) = x()

let nondet = new NondetBuilder()

nondet { let x = 10 in return! [x;x+1] }
nondet { let! x = [1;2;3] in return! [x;x+1] }
nondet { let! x = [1;2;3] in if x>2 then return! [x;x+1] else return 0 }

let rec remove x l =
  nondet {
    if l=[] then return []
    else
     if (List.Head l) = x then return (List.Tail l)
     return! List.map (fun x -> (List.Head l)::x) (remove x (List.Tail l))
  }


remove 2 [1;2;3;4;3;2;1];;

let rec premove l =
  nondet {
    if l=[] then return (0,[])
    else
     return (List.Head l,List.Tail l)
     return! map (fun (z,r) -> (z,(List.Head l)::r)) (premove (List.Tail l))
  }


premove [1;2;3]

let rec permute l =
  nondet {
    if l=[] then return []
    else
      let! (z,r) = premove l in
        return! (map (fun t -> z::t) (permute r))
  }

nondet { let! z,r = (premove [1;2;3]) in return r }

// Логическая задачка

let lev = [false;false;false;true;true;true;true]
let edi = [true;true;true;false;false;false;true]
let days = ["mon";"tue";"wed";"thu";"fri";"sat";"sun"]

let data = List.zip3 lev edi days

let rec prev last hit l =
  match l with
    [] -> last
  | h::t -> if hit h then last else prev h hit t

prev (true,true,"sun") (fun (_,_,x) -> x="sun") data

let realday state said = 
  if state then said else not(said)

let res = 
 nondet {
   let! (l,e,d) = data in
    let (l1,e1,d1) = prev (true,true,"sun") (fun (_,_,x) -> x=d) data in
    if (realday l false) = l1 && (realday e false) = e1 then return (l,e,d)
  }