hms/hsim
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Henri Saudubray 2025-04-28 15:13:15 +02:00
parent b037dacccf
commit 5bce9e5b01
Signed by: hms
GPG key ID: 7065F57ED8856128
12 changed files with 117 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

37
src/bin/main.ml
View file

@ -6,17 +6,26 @@ open Common
let sample = ref 10
let stop = ref 30.0
let greedy = ref false
let inplace = ref false
let steps = ref 1
let doc_sample = "n \tSample count [10]"
let doc_stop = "n \tStop time [10.0]"
let gt0i v i = v := if i <= 0 then 1 else i
let gt0f v f = v := if f <= 0.0 then 1.0 else f
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;
"-stop", Arg.Set_float stop, doc_stop;
"-sample", Arg.Int (gt0i sample), doc_sample;
"-stop", Arg.Float (gt0f stop), doc_stop;
"-debug", Arg.Set Debug.debug, doc_debug;
"-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 !inplace then
let module S = State.InPlaceSimState in
if !greedy then
let open Sim.GreedySim(State.FunctionalSimState) in
run_until model solver !stop (Output.print !sample)
let open Sim.GreedySim(S) in
run_until_multiple model solver !stop !steps (Output.print !sample)
else
let open Sim.LazySim(State.FunctionalSimState) in
run_until model (Solver.solver_from_c solver) !stop (Output.print !sample)
let open Sim.LazySim(S) in
run_until_multiple model (Solver.solver_from_c solver) !stop !steps (Output.print !sample)
else
let module S = State.FunctionalSimState in
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)

14
src/bin/output.ml
View file

@ -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
Printf.printf "% .10e" t;
else (Format.printf "\t% .10e" y.{i}; loop (i+1)) in
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
begin Debug.print "D: "; print_entry start (u 0.0) end
else
begin Debug.print "C: "; loop 0 end
if length <= 0.0 then begin Debug.print "D: "; print_entry start (u 0.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)

5
src/lib/common/debug.ml
View file

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

44
src/lib/hsim/sim.ml
View file

@ -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

16
src/lib/hsim/state.ml
View file

@ -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