feat: correct greedy/lazy and inplace/functional, split into multiple inputs

src/bin/main.ml

@@ -3,20 +3,29 @@ open Hsim
 open Examples
 open Common
 
-let sample = ref 10
+let sample  = ref 10
-let stop   = ref 30.0
+let stop    = ref 30.0
-let greedy = ref false
+let greedy  = ref false
+let inplace = ref false
+let steps   = ref 1
 
-let doc_sample = "n \tSample count [10]"
+let gt0i v i = v := if i <= 0   then 1   else i
-let doc_stop   = "n \tStop time [10.0]"
+let gt0f v f = v := if f <= 0.0 then 1.0 else f
-let doc_debug  = "\tPrint debug information"
+
-let doc_greedy = "\tUse greedy simulation"
+let doc_sample  = "n \tSample count (default=10)"
+let doc_stop    = "n \tStop time (default=10.0)"
+let doc_debug   = "\tPrint debug information"
+let doc_greedy  = "\tUse greedy simulation"
+let doc_inplace = "\tUse greedy simulation"
+let doc_steps   = "n \tSplit simulation into [n] steps (default=1)"
 
 let opts = [
-  "-sample", Arg.Set_int sample, doc_sample;
+  "-sample",  Arg.Int (gt0i sample), doc_sample;
-  "-stop", Arg.Set_float stop, doc_stop;
+  "-stop",    Arg.Float (gt0f stop), doc_stop;
-  "-debug", Arg.Set Debug.debug, doc_debug;
+  "-debug",   Arg.Set Debug.debug,   doc_debug;
-  "-greedy", Arg.Set greedy, doc_greedy;
+  "-greedy",  Arg.Set greedy,        doc_greedy;
+  "-inplace", Arg.Set inplace,       doc_inplace;
+  "-steps",   Arg.Int (gt0i steps),  doc_steps;
 ]
 
 let errmsg = "Usage: " ^ Sys.executable_name ^ " [OPTIONS]\nOptions are:"
@@ -30,11 +39,19 @@ let () =
   let zsolver = StatefulZ.Functional.zsolve in
   let solver = Solver.solver_c csolver zsolver in
   let model = Ball.bouncing_ball () in
-  if !greedy then
+  if !inplace then
-    let open Sim.GreedySim(State.FunctionalSimState) in
+    let module S = State.InPlaceSimState in
-    run_until model solver !stop (Output.print !sample)
+    if !greedy then
+      let open Sim.GreedySim(S) in
+      run_until_multiple model solver !stop !steps (Output.print !sample)
+    else
+      let open Sim.LazySim(S) in
+      run_until_multiple model (Solver.solver_from_c solver) !stop !steps (Output.print !sample)
   else
-    let open Sim.LazySim(State.FunctionalSimState) in
+    let module S = State.FunctionalSimState in
-    run_until model (Solver.solver_from_c solver) !stop (Output.print !sample)
+    if !greedy then
-
+      let open Sim.GreedySim(S) in
-
+      run_until_multiple model solver !stop !steps (Output.print !sample)
+    else
+      let open Sim.LazySim(S) in
+      run_until_multiple model (Solver.solver_from_c solver) !stop !steps (Output.print !sample)

src/bin/output.ml

@@ -6,23 +6,23 @@ let print_entry t y =
   let n = Bigarray.Array1.dim y in
   let rec loop i =
     if i = n then ()
-    else (Printf.printf "\t% .10e" y.{i}; loop (i+1)) in
+    else (Format.printf "\t% .10e" y.{i}; loop (i+1)) in
-  Printf.printf "% .10e" t;
+  Format.printf "% .10e" t;
   loop 0;
-  Printf.printf "\n";
+  Format.printf "\n";
   flush stdout
 
 let print samples { start; length; u } =
   let step = length /. (float_of_int samples) in
   let rec loop i =
     if i > samples then ()
+    else if i = samples then print_entry (start +. length) (u length)
     else let t = float_of_int i *. step in
     (print_entry (start +. t) (u t); loop (i+1)) in
-  if length <= 0.0 then
+  if length <= 0.0 then begin Debug.print "D: "; print_entry start (u 0.0) end
-    begin Debug.print "D: "; print_entry start (u 0.0) end
+  else begin Debug.print "C: "; loop 0 end
-  else
-    begin Debug.print "C: "; loop 0 end
 
 let print_limits { start; length; _ } =
   if length <= 0.0 then Format.printf "D: % .10e\n" start
   else Format.printf "C: % .10e\t% .10e\n" start (start +. length)
+

src/lib/common/debug.ml

@@ -1,6 +1,7 @@
 
 let debug = ref false
 
-let print (s: string) =
+let fmt () = if !debug then Format.std_formatter
-  if !debug then begin Format.printf "%s" s; flush stdout end else ()
+             else Format.make_formatter (fun _ _ _ -> ()) (fun () -> ())
 
+let print = Format.fprintf (fmt ()) "%s"

src/lib/hsim/sim.ml

@@ -78,11 +78,34 @@ module LazySim (S : SimState) =
         | Some o -> use o; loop (DNode { s with state }) in
       loop (DNode { sim with state })
 
+    (** Run the model on multiple inputs. *)
+    let run_on_multiple model solver inputs use =
+      ignore @@ List.fold_left (fun (DNode sim) i ->
+        Common.Debug.print
+          (Format.sprintf "New input: %.10e\t%.10e\n" i.start i.length);
+        let state = match sim.step sim.state (Some i) with
+        | None, s -> s | _ -> assert false in
+        let rec loop (DNode s) =
+          let o, state = s.step s.state None in
+          match o with
+          | None -> DNode { s with state }
+          | Some o -> use o; loop (DNode { s with state }) in
+        loop (DNode { sim with state })) (run model solver) inputs
+
     (** Run the model autonomously until [length], or until the model stops 
         answering. *)
     let run_until model solver length =
       run_on model solver { start = 0.0; length; u = fun _ -> () }
 
+    let run_until_multiple model solver length steps =
+      let step = length /. (float_of_int steps) in
+      let inputs = List.init steps (fun s ->
+        let start  = float_of_int s *. step in
+        let stop   = min (float_of_int (s+1) *. step) length in
+        let length = stop -. start in
+        { start; length; u = fun _ -> () }) in
+      run_on_multiple model solver inputs
+
   end
 
 module GreedySim (S : SimState) =
@@ -106,7 +129,7 @@ module GreedySim (S : SimState) =
             let h = model.horizon ms in
             let rest, s =
               if h <= 0.0 then step (S.set_mstate ms s) i
-              else if now >= stop then [], s
+              else if now >= stop then [], S.set_idle s
               else if model.jump ms then
                 let init   = model.cget ms in
                 let fder t = model.fder ms (Utils.offset i now t) in
@@ -161,9 +184,28 @@ module GreedySim (S : SimState) =
       let o, _ = sim.step sim.state input in
       List.iter use o
 
+    (** Run the model on the given input list. *)
+    let run_on_multiple model solver inputs use =
+      let o, _ = List.fold_left (fun (acc, DNode sim) i ->
+        Common.Debug.print
+          (Format.sprintf "new input: %.10e\t%.10e\n" i.start i.length);
+        let o, state = sim.step sim.state i in
+        o::acc, DNode { sim with state }) ([], run model solver) inputs in
+      List.iter use (List.concat (List.rev o))
+
     (** Run the model autonomously until [length], or until the model stops 
         answering. *)
     let run_until model solver length =
       run_on model solver { start = 0.0; length; u = fun _ -> () }
 
+    (** Run the model autonomously until [length], split in multiple [steps]. *)
+    let run_until_multiple model solver length steps =
+      let step = length /. (float_of_int steps) in
+      let inputs = List.init steps (fun s ->
+        let start  = float_of_int s *. step in
+        let stop   = min (float_of_int (s+1) *. step) length in
+        let length = stop -. start in
+        { start; length; u = fun _ -> () }) in
+      run_on_multiple model solver inputs
+
   end

src/lib/hsim/state.ml

@@ -39,8 +39,6 @@ module type SimState =
         ⚠ Should only be called when running (see [is_running]). *)
     val get_stop : ('a, 'ms, 'ss) state -> time
 
-    val get_t0 : ('a, 'ms, 'ss) state -> time
-
     (** Build an initial state. *)
     val get_init : 'ms -> 'ss -> ('a, 'ms, 'ss) state
 
@@ -86,7 +84,6 @@ module FunctionalSimState : SimState =
             input : 'a value;                (** Function to integrate.       *)
             now   : time;                    (** Current time of integration. *)
             stop  : time;                    (** How long until we stop.      *)
-            t0    : time;                    (** Initial start time.          *)
           } -> 'a status
 
     (** Internal state of the simulation node: model state, solver state and
@@ -111,15 +108,15 @@ module FunctionalSimState : SimState =
       | Idle ->
           begin match mode, input, now, stop with
           | Some mode, Some input, Some now, Some stop ->
-              { state with status = Running { mode; input; now; stop; t0 = input.start } }
+              { state with status = Running { mode; input; now; stop } }
           | _ -> raise (Invalid_argument "")
           end
-      | Running { mode=m; input=i; now=n; stop=s; t0 } ->
+      | Running { mode=m; input=i; now=n; stop=s } ->
           let mode  = Option.value mode  ~default:m in
           let input = Option.value input ~default:i in
           let now   = Option.value now   ~default:n in
           let stop  = Option.value stop  ~default:s in
-          { state with status = Running { mode; input; now; stop; t0 } }
+          { state with status = Running { mode; input; now; stop } }
 
     let set_mstate mstate state = { state with mstate }
     let set_sstate sstate state = { state with sstate }
@@ -134,8 +131,6 @@ module FunctionalSimState : SimState =
       match s.status with Running r -> r.now | Idle -> raise Not_running
     let get_stop s =
       match s.status with Running r -> r.stop | Idle -> raise Not_running
-    let get_t0 s =
-      match s.status with Running r -> r.t0 | Idle -> raise Not_running
 
     let get_init mstate sstate = { status = Idle; mstate; sstate }
   end
@@ -149,7 +144,6 @@ module InPlaceSimState : SimState =
             mutable input : 'a value;
             mutable now   : time;
             mutable stop  : time;
-            mutable t0    : time;
           } -> 'a status
 
     type ('a, 'ms, 'ss) state =
@@ -172,7 +166,7 @@ module InPlaceSimState : SimState =
       | Idle ->
           begin match mode, input, now, stop with
           | Some mode, Some input, Some now, Some stop ->
-              state.status <- Running { mode; input; now; stop; t0 = input.start };
+              state.status <- Running { mode; input; now; stop };
               state
           | _ -> raise (Invalid_argument "")
           end
@@ -197,8 +191,6 @@ module InPlaceSimState : SimState =
       match s.status with Running r -> r.now | Idle -> raise Not_running
     let get_stop s =
       match s.status with Running r -> r.stop | Idle -> raise Not_running
-    let get_t0 s =
-      match s.status with Running r -> r.t0 | Idle -> raise Not_running
 
     let get_init mstate sstate = { status = Idle; mstate; sstate }
   end