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

feat: greedy simulation

Browse source
This commit is contained in:
Henri Saudubray 2025-04-25 16:41:41 +02:00
parent c867859cce
commit b037dacccf
Signed by: hms
GPG key ID: 7065F57ED8856128
6 changed files with 164 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/lib/common/debug.ml Normal file
View file

@ -0,0 +1,6 @@
let debug = ref false
let print (s: string) =
if !debug then begin Format.printf "%s" s; flush stdout end else ()

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

@ -41,7 +41,7 @@ module LazySim (S : SimState) =
let mode, stop, now = Continuous, i.length, 0.0 in
S.update ms ss (S.set_running ~mode ~input:i ~stop ~now s)
else S.set_running ~mode:Continuous s in
Some { start = i.start+. now; length = 0.0; u = fun _ -> o }, s
Some { start = i.start +. now; length = 0.0; u = fun _ -> o }, s
| Continuous ->
let (h, f, z), ss = solver.step ss stop in
let ms = model.cset ms (f h) in
@ -120,31 +120,29 @@ module GreedySim (S : SimState) =
let s = S.set_running ~mode ~input:i ~stop ~now s in
step (S.update ms ss s) i
else step (S.set_running ~mode:Continuous s) i in
let start = i.start +. now in
{ start; length = 0.0; u = fun _ -> o }::rest, s
{ start = i.start +. now; length = 0.0; u = fun _ -> o }::rest, s
| Continuous ->
let (h, f, z), ss = solver.step ss stop in
(* Copy the state to allow [f] to remain independent from further
modifications. *)
let ss = solver.copy ss in
let ms = model.cset ms (f h) in
let h' = i.start +. h in
let fout t = model.fout ms (i.u (now +. t)) (f (now +. t)) in
let out = { start = i.start +. now; length = h -. now; u = fout } in
match z with
| None ->
if h >= stop then
let s = S.set_running ~mode:Discrete ~now:h' s in
let s = S.set_running ~mode:Discrete ~now:h s in
let rest, s = step (S.update ms ss s) i in
out::rest, s
else
let s = S.set_running ~now:h' s in
let s = S.set_running ~now:h s in
let rest, s = step (S.update ms ss s) i in
(match rest with
| [] -> [out], s
| f::rest -> Utils.compose [out;f] :: rest, s)
| Some z ->
let s = S.set_running ~mode:Discrete ~now:h' s in
let s = S.set_running ~mode:Discrete ~now:h s in
let ms = model.zset ms z in
let rest, s = step (S.update ms ss s) i in
out::rest, s in
@ -156,4 +154,16 @@ module GreedySim (S : SimState) =
DNode { state; step; reset }
(** Run the model on the given input until the end of the input or until the
model stops answering. *)
let run_on model solver input use =
let DNode sim = run model solver in
let o, _ = sim.step sim.state input in
List.iter use 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 _ -> () }
end

19
src/lib/hsim/utils.ml
View file

@ -1,15 +1,24 @@
open Types
(** Offset the [input] function by [now]. *)
(** Offset the [input.u] function by [now]. *)
let offset (input : 'a value) (now : time) : time -> 'a =
fun t -> input.u ((now -. input.start) +. t)
(**
Concatenate functions. [
^ ^
| ---, | ---,
| ___ `--- = | _ `---
| --' | --'
+--------------> +-------------->]
*)
let rec compose = function
| [] -> assert false
| [] -> raise (Invalid_argument "Cannot concatenate an empty value list")
| [f] -> f
| { start=sl; u=ul; _ } :: l ->
| { start; u; _ } :: l ->
let { start=sr; length=lr; u=ur } = compose l in
let length = sr +. lr -. sl in
{ start=sl; length; u=fun t -> if t <= sr then ur t else ul t }
let sw = sr -. start in
let length = sw +. lr in
{ start; length; u=fun t -> if t < sw then u t else ur (t -. sw) }