From ebe6f63a2cc7526b418448752f6d468df2dc5dbb Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 31 May 2013 11:41:19 +0200 Subject: [PATCH] Reactive Behavior tree implementation (for React) --- behavior.ml | 303 +++++++++++++++++++++++++++++++++++++++++++++++++++ behavior.mli | 179 ++++++++++++++++++++++++++++++ 2 files changed, 482 insertions(+) create mode 100644 behavior.ml create mode 100644 behavior.mli diff --git a/behavior.ml b/behavior.ml new file mode 100644 index 00000000..142f3d4c --- /dev/null +++ b/behavior.ml @@ -0,0 +1,303 @@ +(* +Copyright (c) 2013, Simon Cruanes +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. Redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {1 Behavior Trees for React} *) + +(** {2 Behavior tree} *) + +type tree = + | Test of bool React.event (* test the next occurrence *) + | TestS of bool React.signal (* test the current value *) + | Wait of unit React.event (* wait for the event to trigger *) + | Timeout of float (* fails after the given timeout *) + | Do of (unit -> bool) (* perform an action *) + | If of bool React.signal * tree * tree (* switch *) + | Sequence of bool * tree list (* yield to subtrees sequentially. bool: loop? *) + | Select of select_strategy * tree list (* select one subtree *) + | Parallel of parallel_strategy * tree list (* run all subtrees in parallel *) + | Closure of (unit -> tree) (* build a tree dynamically *) + | Succeed + | Fail + (** A behavior tree *) +and select_strategy = tree list -> (unit -> tree option) + (** How to select a subtree to run. It yields a subtree until it + decides to fail *) +and parallel_strategy = + | PSForall (** succeeds when all subtrees succeed *) + | PSExists (** succeeds when some subtree succeeds *) + +let strategy_inorder l = + let cur = ref l in + fun () -> match !cur with + | [] -> None + | t::l' -> + cur := l'; + Some t + +let strategy_random ?(proba_fail=0.05) l = + let a = Array.of_list l in + fun () -> + if Random.float 1. < proba_fail + then None + else (* choose in array *) + let t = a.(Random.int (Array.length a)) in + Some t + +let mk_succeed = Succeed + +let mk_fail = Fail + +let mk_test e = Test e + +let mk_test_s s = TestS s + +let mk_wait e = Wait e + +let mk_timeout f = Timeout f + +let mk_do act = Do act + +let mk_do_ok act = Do (fun () -> act (); true) + +let mk_if s then_ else_ = If (s, then_, else_) + +let mk_sequence ?(loop=false) l = + assert (l <> []); + Sequence (loop, l) + +let mk_select ?(strat=strategy_inorder) l = + assert (l <> []); + Select (strat, l) + +let mk_or_else t1 t2 = + mk_select ~strat:strategy_inorder [t1; t2] + +let mk_parallel ?(strat=PSForall) l = + assert (l <> []); + Parallel (strat, l) + +let mk_closure f = + Closure f + +(** {2 Lightweight futures} *) + +module Fut = struct + type 'a t = { + mutable value : 'a option; + mutable handlers : ('a -> unit) list; + } + + let create () = + let fut = { + value = None; + handlers = []; + } in + let send x = match fut.value with + | Some _ -> raise (Invalid_argument "Behavior.Fut.create: future already set") + | None -> + fut.value <- Some x; + List.iter (fun f -> f x) fut.handlers + in + fut, send + + (* add [h] as a handler that waits for [fut] to complete. May call [h] + immediately *) + let subscribe fut h = + match fut.value with + | None -> fut.handlers <- h :: fut.handlers + | Some x -> h x + + let is_set fut = match fut.value with + | None -> false + | Some _ -> true + + let return x = { + value = Some x; + handlers = []; + } + + let bind fut f = + (* result *) + let result, send = create () in + subscribe fut (fun x -> + (* [fut_f] is what [f] returns. When this completes, [result] will + be updated *) + let fut_f = f x in + subscribe fut_f (fun y -> send y)); + result + + let next e = + let res, send = create () in + let ev = React.E.map send (React.E.once e) in + res.handlers <- [fun _ -> ignore ev]; (* keep reference *) + res + + let wait fut = + let res, set = React.S.create None in + subscribe fut (fun x -> set (Some x)); + ignore (React.S.retain res (fun _ -> ignore fut)); (* keep ref *) + res + + let map f fut = + let res, send = create () in + subscribe fut (fun x -> send (f x)); + res + + let first l = + let res, send = create () in + (* is any of the values set? *) + let any_set = ref false in + (try + List.iter + (fun fut -> match fut.value with + | None -> () + | Some x -> any_set := true; send x; raise Exit) + l + with Exit -> ()); + (* if no element of [l] is already set, add handlers *) + (if not !any_set then + List.iter + (fun fut -> subscribe fut + (fun x -> if not !any_set then (any_set := true; send x))) + l); + res + + let last l = + let res, send = create () in + let count = ref (List.length l) in + List.iter + (fun fut -> subscribe fut + (fun x -> + decr count; + if !count = 0 then send x)) + l; + res + + let filter p l = + let res, send = create () in + let any_ok = ref false in (* any future succeeded? *) + let count = ref (List.length l) in + List.iter + (fun fut -> subscribe fut + (fun x -> + if !any_ok + then () + else if p x + then (any_ok := true; send (Some x)) + else + (decr count; if !count = 0 then send None))) + l; + res + + (** Get value, which must be present *) + let unsafe_get fut = match fut.value with + | None -> assert false + | Some x -> x + + let l2 f a b = + let res, send = create () in + let count = ref 2 in + let compute () = + let y = f (unsafe_get a) (unsafe_get b) in + send y + in + subscribe a (fun _ -> decr count; if !count = 0 then compute ()); + subscribe b (fun _ -> decr count; if !count = 0 then compute ()); + res +end + +(** {2 Run a tree} *) + +type result = bool Fut.t + +let run ?delay tree = + let open React in + (* run given tree *) + let rec run tree = + match tree with + | Test e -> Fut.next e + | TestS s -> Fut.return (S.value s) + | Wait e -> Fut.next (E.stamp e true) + | Timeout howlong -> + begin match delay with + | None -> failwith "Behavior.run: not delay function provided" + | Some delay -> + let timeout = delay howlong in + Fut.next (E.stamp timeout false) + end + | Do act -> + let b = act () in + Fut.return b + | If (s, then_, else_) -> (* depends on value of signal *) + if S.value s then run then_ else run else_ + | Sequence (loop, l) -> run_sequence ~loop l + | Select (strat, l) -> run_select ~strat l + | Parallel (strat, l) -> run_parallel ~strat l + | Closure f -> let tree' = f () in run tree' + | Succeed -> Fut.return true + | Fail -> Fut.return false + and run_sequence ~loop start = + let rec process l = match l with + | [] when loop -> run_sequence ~loop start + | [] -> Fut.return true (* success *) + | t::l' -> + let res_t = run t in + Fut.bind res_t + (fun t_succeeded -> + if t_succeeded + then process l' + else Fut.return false) + in + process start + and run_select ~strat l = + (* choice function *) + let choose = strat l in + (* try a subtree *) + let rec try_one () = + match choose () with + | None -> Fut.return false (* failure *) + | Some t -> + let res_t = run t in + Fut.bind res_t + (fun t_succeeded -> if t_succeeded + then Fut.return true + else try_one ()) + in + try_one () + and run_parallel ~strat l = + let results = List.map run l in + match strat with + | PSExists -> + let ok = Fut.filter (fun x -> x) results in + Fut.map + (function | None -> false | Some _ -> true) + ok + | PSForall -> + let failed = Fut.filter (fun x -> not x) results in + Fut.map + (function | None -> true | Some _ -> false) + failed + in + run tree diff --git a/behavior.mli b/behavior.mli new file mode 100644 index 00000000..db119e7f --- /dev/null +++ b/behavior.mli @@ -0,0 +1,179 @@ +(* +Copyright (c) 2013, Simon Cruanes +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. Redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {1 Behavior Trees for React} *) + +(** Behavior trees are a modular alternative to state machines for controlling + dynamic behavior in time. They are primarily used in video games to + implement non-player AI. + + A tree is composed of basic actions, basic tests, and combinators. During + execution, some subset of the nodes of a tree may be {b running}; at some + point the execution of a given node will terminate with either + {b success} or {b failure}. Depending on the kind of node, this result + may propagate to parent nodes, or set other nodes running. + + For instance, a {i sequence} node runs its subtrees one by one. If a + subtree succeeds, the next one is activated; if it fails, the whole + sequence will fail. + + Here, we build them on top of + {{: http://erratique.ch/software/react/doc/React.html} React}. + + Documentation source: + {{: http://aigamedev.com/open/article/bt-overview/} aigamedev (and links)} +*) + +(** {2 Behavior tree} *) + +type tree = private + | Test of bool React.event (* test the next occurrence *) + | TestS of bool React.signal (* test the current value *) + | Wait of unit React.event (* wait for the event to trigger *) + | Timeout of float (* fails after the given timeout *) + | Do of (unit -> bool) (* perform an action *) + | If of bool React.signal * tree * tree (* switch *) + | Sequence of bool * tree list (* yield to subtrees sequentially. bool: loop? *) + | Select of select_strategy * tree list (* select one subtree *) + | Parallel of parallel_strategy * tree list (* run all subtrees in parallel *) + | Closure of (unit -> tree) (* build a tree dynamically *) + | Succeed + | Fail + (** A behavior tree *) +and select_strategy = tree list -> (unit -> tree option) + (** How to select a subtree to run. It may yield a different result each + time it is called. *) +and parallel_strategy = + | PSForall (** succeeds when all subtrees succeed *) + | PSExists (** succeeds when some subtree succeeds (kill the others) *) + +val strategy_inorder : select_strategy + (** Select subnodes one after the other, then fails *) + +val strategy_random : ?proba_fail:float -> select_strategy + (** Randomly chooses a subtree. May fail at each point with + a probability of [proba_fail]. *) + +val mk_succeed : tree + (** Behavior that always succeeds *) + +val mk_fail : tree + (** Behavior that always fails *) + +val mk_test : bool React.event -> tree + (** Fails or succeeds based on the next occurrence of the event *) + +val mk_test_s : bool React.signal -> tree + (** Fails or succeeds based on the current signal value *) + +val mk_wait : unit React.event -> tree + (** Wait for the event to trigger, then succeed *) + +val mk_timeout : float -> tree + (** Fails after the given amount of seconds *) + +val mk_do : (unit -> bool) -> tree + (** Perform an action, then succeed iff it returned true *) + +val mk_do_ok : (unit -> unit) -> tree + (** Perform an action and succeed (unless it raises an exception) *) + +val mk_if : bool React.signal -> tree -> tree -> tree + (** Conditional choice, based on the current value of the signal *) + +val mk_sequence : ?loop:bool -> tree list -> tree + (** Sequence of sub-trees to run *) + +val mk_select : ?strat:select_strategy -> tree list -> tree + (** Choice among the subtrees. The strategy defines in which order subtrees + are tried. *) + +val mk_or_else : tree -> tree -> tree + (** Binary choice, favoring the left one *) + +val mk_parallel : ?strat:parallel_strategy -> tree list -> tree + (** Run subtrees in parallel *) + +val mk_closure : (unit -> tree) -> tree + (** Produce a tree dynamically, at each call. *) + +(** {2 Lightweight futures} *) + +module Fut : sig + type 'a t + (** Future value of type 'a *) + + val create : unit -> 'a t * ('a -> unit) + (** Create a future, and a function that sets its value (if already set, + will raise Invalid_argument) *) + + val subscribe : 'a t -> ('a -> unit) -> unit + (** Get notified exactly once with the value (maybe right now) *) + + val is_set : 'a t -> bool + (** Value already known? *) + + val return : 'a -> 'a t + (** Monadic return (returns immediately) *) + + val bind : 'a t -> ('a -> 'b t) -> 'b t + (** Monadic bind *) + + val next : 'a React.event -> 'a t + (** Next occurrence of the event *) + + val wait : 'a t -> 'a option React.signal + (** The value of the future (None while it's not set) *) + + val map : ('a -> 'b) -> 'a t -> 'b t + (** Simple map *) + + val first : 'a t list -> 'a t + (** First future of the list to be set (or any that is already + set if at least one is set) *) + + val last : 'a t list -> 'a t + (** Last future to be set (or any if they are all already set) *) + + val filter : ('a -> bool) -> 'a t list -> 'a option t + (** Filters out results that do not satisfy the predicate; returns the + first result that satisfy it, or None *) + + val l2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t + (** Binary lift *) +end + +(** {2 Run a tree} *) + +type result = bool Fut.t + +val run : ?delay:(float -> unit React.event) -> + tree -> + result + (** Run the tree. It returns a {! result}, which wraps + either true (success) or false (failure). + + [delay] is the function to call to get notified after the given amount of + seconds elapsed. *)