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

feat: consider values without absolute timestamps

Browse source
This commit is contained in:
Henri Saudubray 2025-06-03 16:57:37 +02:00
parent b27d39562d
commit 1a4f950324
Signed by: hms
GPG key ID: 7065F57ED8856128
4 changed files with 60 additions and 75 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/bin/output.ml
View file

@ -12,17 +12,17 @@ let print_entry t y =
Format.printf "\n"; Format.printf "\n";
flush stdout flush stdout
let print samples { start; length; u } = let print samples { h; u } =
let step = length /. (float_of_int samples) in let step = h /. (float_of_int samples) in
let rec loop i = let rec loop i =
if i > samples then () if i > samples then ()
else if i = samples then print_entry (start +. length) (u length) else if i = samples then print_entry h (u h)
else let t = float_of_int i *. step in else let t = float_of_int i *. step in
(print_entry (start +. t) (u t); loop (i+1)) in (print_entry t (u t); loop (i+1)) in
if length <= 0.0 then begin Debug.print "D: "; print_entry start (u 0.0) end if h <= 0.0 then begin Debug.print "D: "; print_entry 0.0 (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; _ } = let print_limits { h; _ } =
if length <= 0.0 then Format.printf "D: % .10e\n" start if h <= 0.0 then Format.printf "D: % .10e\n" 0.0
else Format.printf "C: % .10e\t% .10e\n" start (start +. length) else Format.printf "C: % .10e\t% .10e\n" 0.0 h

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

@ -18,7 +18,7 @@ module LazySim (S : SimState) =
let ms, ss = get_mstate s, get_sstate s in let ms, ss = get_mstate s, get_sstate s in
match i, is_running s with match i, is_running s with
| Some i, _ -> | Some i, _ ->
let mode, now, stop = Discrete, 0.0, i.length in let mode, now, stop = Discrete, 0.0, i.h in
None, set_running ~mode ~input:i ~now ~stop s None, set_running ~mode ~input:i ~now ~stop s
| None, false -> None, s | None, false -> None, s
| None, true -> | None, true ->
@ -32,23 +32,21 @@ module LazySim (S : SimState) =
else if now >= stop then set_idle s else if now >= stop then set_idle s
else if model.jump ms then begin else if model.jump ms then begin
let init = model.cget ms and stop = stop -. now in let init = model.cget ms and stop = stop -. now in
let fder t = model.fder ms (Utils.offset i now t) in let fder t = model.fder ms (Utils.offset i.u now t) in
let fzer t = model.fzer ms (Utils.offset i now t) in let fzer t = model.fzer ms (Utils.offset i.u now t) in
let ivp = { fder; stop; init; size=model.csize } in let ivp = { fder; stop; init; size=model.csize } in
let zc = { init; fzer; size=model.zsize } in let zc = { init; fzer; size=model.zsize } in
let ss = solver.reset (ivp, zc) ss in let ss = solver.reset (ivp, zc) ss in
let i = { start=i.start +. now; length=i.length -. now; let i = { h=i.h -. now; u=Utils.offset i.u now } in
u=Utils.offset i now } in let mode, stop, now = Continuous, i.h, 0.0 in
let mode, stop, now = Continuous, i.length, 0.0 in
update ms ss (set_running ~mode ~input:i ~stop ~now s) update ms ss (set_running ~mode ~input:i ~stop ~now s)
end else set_running ~mode:Continuous s in end else set_running ~mode:Continuous s in
Some { start=i.start +. now; length=0.0; u=fun _ -> o }, s Some { h=0.0; u=fun _ -> o }, s
| Continuous -> | Continuous ->
let (h, f, z), ss = solver.step ss stop in let (h, f, z), ss = solver.step ss stop in
let ms = model.cset ms (f h) in let ms = model.cset ms (f h) in
let start = i.start +. now in
let fout t = model.fout ms (i.u (now +. t)) (f (now +. t)) in let fout t = model.fout ms (i.u (now +. t)) (f (now +. t)) in
let out = { start; length=h -. now; u=fout } in let out = { h=h -. now; u=fout } in
let s = match z with let s = match z with
| None -> | None ->
let s = if h >= stop let s = if h >= stop
@ -71,8 +69,8 @@ module LazySim (S : SimState) =
model stops answering. *) model stops answering. *)
let run_on model solver input use = let run_on model solver input use =
let DNode sim = run model solver in let DNode sim = run model solver in
let state = sim.step sim.state (Some input) in let out = sim.step sim.state (Some input) in
let state = match state with None, s -> s | _ -> assert false in let state = match out with None, s -> s | _ -> assert false in
let rec loop state = let rec loop state =
let o, state = sim.step state None in let o, state = sim.step state None in
match o with None -> () | Some o -> use o; loop state in match o with None -> () | Some o -> use o; loop state in
@ -89,19 +87,15 @@ module LazySim (S : SimState) =
match o with None -> state | Some o -> use o; loop state in match o with None -> state | Some o -> use o; loop state in
loop state) sim.state inputs loop state) sim.state inputs
(** Run the model autonomously until [length], or until the model stops (** Run the model autonomously until [h], or until the model stops
answering. *) answering. *)
let run_until model solver length = let run_until model solver h =
run_on model solver { start = 0.0; length; u = fun _ -> () } run_on model solver { h; u = fun _ -> () }
(** Run the model autonomously until [length], split in multiple [steps]. *) (** Run the model autonomously until [length], split in multiple [steps]. *)
let run_until_n model solver length steps = let run_until_n model solver length steps =
let step = length /. (float_of_int steps) in let h = length /. float_of_int steps in
let inputs = List.init steps (fun s -> run_on_n model solver (List.init steps (fun _ -> { h; u=fun _ -> () }))
let start = float_of_int s *. step in
let stop = min (float_of_int (s+1) *. step) length in
{ start; length = stop -. start; u = fun _ -> () }) in
run_on_n model solver inputs
end end
module GreedySim (S : SimState) = module GreedySim (S : SimState) =
@ -118,7 +112,7 @@ module GreedySim (S : SimState) =
let rec step s i = let rec step s i =
let ms, ss = get_mstate s, get_sstate s in let ms, ss = get_mstate s, get_sstate s in
if not (is_running s) then if not (is_running s) then
let mode, now, stop = Discrete, 0.0, i.length in let mode, now, stop = Discrete, 0.0, i.h in
step (set_running ~mode ~input:i ~now ~stop s) i step (set_running ~mode ~input:i ~now ~stop s) i
else let now, stop = get_now s, get_stop s in else let now, stop = get_now s, get_stop s in
match get_mode s with match get_mode s with
@ -130,24 +124,22 @@ module GreedySim (S : SimState) =
else if now >= stop then [], set_idle s else if now >= stop then [], set_idle s
else if model.jump ms then else if model.jump ms then
let init = model.cget ms in let init = model.cget ms in
let fder t = model.fder ms (Utils.offset i now t) in let fder t = model.fder ms (Utils.offset i.u now t) in
let fzer t = model.fzer ms (Utils.offset i now t) in let fzer t = model.fzer ms (Utils.offset i.u now t) in
let ivp = { fder; stop = stop -. now; init; size = model.csize } in let ivp = { fder; stop = stop -. now; init; size = model.csize } in
let zc = { init; fzer; size = model.zsize } in let zc = { init; fzer; size = model.zsize } in
let ss = solver.reset (ivp, zc) ss in let ss = solver.reset (ivp, zc) ss in
let i = { start=i.start +. now; length=i.length -. now; let i = { h=i.h -. now; u=Utils.offset i.u now } in
u=Utils.offset i now } in let mode, stop, now = Continuous, i.h, 0.0 in
let mode, stop, now = Continuous, i.length, 0.0 in step (update ms ss (set_running ~mode ~input:i ~stop ~now s)) i
let s = set_running ~mode ~input:i ~stop ~now s in
step (update ms ss s) i
else step (set_running ~mode:Continuous s) i in else step (set_running ~mode:Continuous s) i in
{ start = i.start +. now; length = 0.0; u = fun _ -> o }::rest, s { h=0.0; u=fun _ -> o }::rest, s
| Continuous -> | Continuous ->
let (h, f, z), ss = solver.step ss stop in let (h, f, z), ss = solver.step ss stop in
let ss = solver.copy ss in let ss = solver.copy ss in
let ms = model.cset ms (f h) in let ms = model.cset ms (f h) in
let fout t = model.fout ms (i.u (now +. t)) (f (now +. t)) 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 let out = { h=h -. now; u=fout } in
match z with match z with
| None -> | None ->
if h >= stop then if h >= stop then
@ -159,7 +151,7 @@ module GreedySim (S : SimState) =
let rest, s = step (update ms ss s) i in let rest, s = step (update ms ss s) i in
(match rest with (match rest with
| [] -> [out], s | [] -> [out], s
| f::rest -> Utils.compose [out;f] :: rest, s) | f::rest -> Utils.concat [out;f] :: rest, s)
| Some z -> | Some z ->
let s = set_running ~mode:Discrete ~now:h s in let s = set_running ~mode:Discrete ~now:h s in
let ms = model.zset ms z in let ms = model.zset ms z in
@ -188,17 +180,13 @@ module GreedySim (S : SimState) =
o::acc, state) ([], sim.state) inputs in o::acc, state) ([], sim.state) inputs in
List.iter use (List.concat (List.rev o)) List.iter use (List.concat (List.rev o))
(** Run the model autonomously until [length], or until the model stops (** Run the model autonomously until [h], or until the model stops
answering. *) answering. *)
let run_until model solver length = let run_until model solver h =
run_on model solver { start = 0.0; length; u = fun _ -> () } run_on model solver { h; u = fun _ -> () }
(** Run the model autonomously until [length], split in multiple [steps]. *) (** Run the model autonomously until [h], split in [n] steps. *)
let run_until_n model solver length steps = let run_until_n model solver h n =
let step = length /. (float_of_int steps) in let h = h /. float_of_int n in
let inputs = List.init steps (fun s -> run_on_n model solver (List.init n (fun _ -> { h; u=fun _ -> () }))
let start = float_of_int s *. step in
let stop = min (float_of_int (s+1) *. step) length in
{ start; length = stop -. start; u = fun _ -> () }) in
run_on_n model solver inputs
end end

31
src/lib/hsim/types.ml
View file

@ -3,14 +3,13 @@ type time = float
(** Input and output values are functions defined on intervals. *) (** Input and output values are functions defined on intervals. *)
type 'a value = type 'a value =
{ start : time; { h : time;
length : time; (* Relative: [end = start + length]. *) u : time -> 'a } (* Defined on [[0, h]]. *)
u : time -> 'a } (* Defined on [[start, end]]. *)
(** A time signal is a sequence of possibly absent α-values (** A time signal is a sequence of possibly absent α-values
[{ start; length; u }] where: [{ h; u }] where:
- [start] and [length] are positive (possibly null) floating-point numbers; - [h : R⁺]
- [u: [0, length] -> α] *) - [u: [0, h] -> α] *)
type 'a signal = 'a value option type 'a signal = 'a value option
(** A discrete node. *) (** A discrete node. *)
@ -42,16 +41,16 @@ type ('a, 'b, 'y, 'yder) cnode =
type ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode = type ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode =
HNode : HNode :
{ state: 's; { state: 's;
step : 's -> 'a -> 'b * 's; (** Discrete step function. *) step : 's -> 'a -> 'b * 's; (** Discrete step function. *)
fder : 's -> 'a -> 'y -> 'yder; (** Continuous derivative function. *) fder : 's -> 'a -> 'y -> 'yder; (** Continuous derivative function. *)
fout : 's -> 'a -> 'y -> 'b; (** Continuous output function. *) fout : 's -> 'a -> 'y -> 'b; (** Continuous output function. *)
fzer : 's -> 'a -> 'y -> 'zout; (** Continuous zero-crossing function. *) fzer : 's -> 'a -> 'y -> 'zout; (** Continuous zero-crossing function. *)
reset : 'p -> 's -> 's; (** Reset function. *) reset : 'p -> 's -> 's; (** Reset function. *)
horizon : 's -> time; (** Next integration horizon. *) horizon : 's -> time; (** Next integration horizon. *)
jump : 's -> bool; (** Discontinuity flag. *) jump : 's -> bool; (** Discontinuity flag. *)
cget : 's -> 'y; (** Get continuous state. *) cget : 's -> 'y; (** Get continuous state. *)
cset : 's -> 'y -> 's; (** Set continuous state. *) cset : 's -> 'y -> 's; (** Set continuous state. *)
zset : 's -> 'zin -> 's; (** Set zero-crossing state. *) zset : 's -> 'zin -> 's; (** Set zero-crossing state. *)
csize : int; csize : int;
zsize : int; zsize : int;
} -> ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode } -> ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode

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

@ -1,9 +1,9 @@
open Types open Types
(** Offset the [input.u] function by [now]. *) (** Offset the [u] function by [now]. *)
let offset (input : 'a value) (now : time) : time -> 'a = let offset (u : time -> 'a) (now : time) : time -> 'a =
fun t -> input.u ((now -. input.start) +. t) fun t -> u (t +. now)
(** (**
Concatenate functions. [ Concatenate functions. [
@ -13,12 +13,10 @@ Concatenate functions. [
| --' | --' | --' | --'
+--------------> +-------------->] +--------------> +-------------->]
*) *)
let rec compose = function let rec concat = function
| [] -> raise (Invalid_argument "Cannot concatenate an empty value list") | [] -> raise (Invalid_argument "Cannot concatenate an empty value list")
| [f] -> f | [f] -> f
| { start; u; _ } :: l -> | { u; h } :: l ->
let { start=sr; length=lr; u=ur } = compose l in let { h=hr; u=ur } = concat l in
let sw = sr -. start in { h=h+.hr; u=fun t -> if t <= h then u t else ur (t -. h) }
let length = sw +. lr in
{ start; length; u=fun t -> if t < sw then u t else ur (t -. sw) }