From 1a4f950324824ab4549590f1ace0b39eacc58ab0 Mon Sep 17 00:00:00 2001 From: Henri Saudubray Date: Tue, 3 Jun 2025 16:57:37 +0200 Subject: [PATCH] feat: consider values without absolute timestamps --- src/bin/output.ml | 16 +++++----- src/lib/hsim/sim.ml | 72 ++++++++++++++++++------------------------- src/lib/hsim/types.ml | 31 +++++++++---------- src/lib/hsim/utils.ml | 16 +++++----- 4 files changed, 60 insertions(+), 75 deletions(-) diff --git a/src/bin/output.ml b/src/bin/output.ml index 715a739..a5aceab 100644 --- a/src/bin/output.ml +++ b/src/bin/output.ml @@ -12,17 +12,17 @@ let print_entry t y = Format.printf "\n"; flush stdout -let print samples { start; length; u } = - let step = length /. (float_of_int samples) in +let print samples { h; u } = + let step = h /. (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 if i = samples then print_entry h (u h) 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 + (print_entry t (u t); loop (i+1)) in + 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 -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) +let print_limits { h; _ } = + if h <= 0.0 then Format.printf "D: % .10e\n" 0.0 + else Format.printf "C: % .10e\t% .10e\n" 0.0 h diff --git a/src/lib/hsim/sim.ml b/src/lib/hsim/sim.ml index 346b1db..0066293 100644 --- a/src/lib/hsim/sim.ml +++ b/src/lib/hsim/sim.ml @@ -18,7 +18,7 @@ module LazySim (S : SimState) = let ms, ss = get_mstate s, get_sstate s in match i, is_running s with | 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, false -> None, s | None, true -> @@ -32,23 +32,21 @@ module LazySim (S : SimState) = else if now >= stop then set_idle s else if model.jump ms then begin let init = model.cget ms and stop = stop -. now in - let fder t = model.fder ms (Utils.offset i now t) in - let fzer t = model.fzer 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.u now t) in let ivp = { fder; stop; init; size=model.csize } in let zc = { init; fzer; size=model.zsize } in let ss = solver.reset (ivp, zc) ss in - let i = { start=i.start +. now; length=i.length -. now; - u=Utils.offset i now } in - let mode, stop, now = Continuous, i.length, 0.0 in + let i = { h=i.h -. now; u=Utils.offset i.u now } in + let mode, stop, now = Continuous, i.h, 0.0 in update ms ss (set_running ~mode ~input:i ~stop ~now s) 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 -> let (h, f, z), ss = solver.step ss stop 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 out = { start; length=h -. now; u=fout } in + let out = { h=h -. now; u=fout } in let s = match z with | None -> let s = if h >= stop @@ -71,8 +69,8 @@ module LazySim (S : SimState) = model stops answering. *) let run_on model solver input use = let DNode sim = run model solver in - let state = sim.step sim.state (Some input) in - let state = match state with None, s -> s | _ -> assert false in + let out = sim.step sim.state (Some input) in + let state = match out with None, s -> s | _ -> assert false in let rec loop state = let o, state = sim.step state None 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 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. *) - let run_until model solver length = - run_on model solver { start = 0.0; length; u = fun _ -> () } + let run_until model solver h = + run_on model solver { h; u = fun _ -> () } (** Run the model autonomously until [length], split in multiple [steps]. *) let run_until_n 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 - { start; length = stop -. start; u = fun _ -> () }) in - run_on_n model solver inputs + let h = length /. float_of_int steps in + run_on_n model solver (List.init steps (fun _ -> { h; u=fun _ -> () })) end module GreedySim (S : SimState) = @@ -118,7 +112,7 @@ module GreedySim (S : SimState) = let rec step s i = let ms, ss = get_mstate s, get_sstate s in 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 else let now, stop = get_now s, get_stop s in match get_mode s with @@ -130,24 +124,22 @@ module GreedySim (S : SimState) = else if now >= stop then [], 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 - let fzer t = model.fzer 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.u now t) in let ivp = { fder; stop = stop -. now; init; size = model.csize } in let zc = { init; fzer; size = model.zsize } in let ss = solver.reset (ivp, zc) ss in - let i = { start=i.start +. now; length=i.length -. now; - u=Utils.offset i now } in - let mode, stop, now = Continuous, i.length, 0.0 in - let s = set_running ~mode ~input:i ~stop ~now s in - step (update ms ss s) i + let i = { h=i.h -. now; u=Utils.offset i.u now } in + let mode, stop, now = Continuous, i.h, 0.0 in + step (update ms ss (set_running ~mode ~input:i ~stop ~now s)) i 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 -> let (h, f, z), ss = solver.step ss stop in let ss = solver.copy ss in let ms = model.cset ms (f 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 + let out = { h=h -. now; u=fout } in match z with | None -> if h >= stop then @@ -159,7 +151,7 @@ module GreedySim (S : SimState) = let rest, s = step (update ms ss s) i in (match rest with | [] -> [out], s - | f::rest -> Utils.compose [out;f] :: rest, s) + | f::rest -> Utils.concat [out;f] :: rest, s) | Some z -> let s = set_running ~mode:Discrete ~now:h s in let ms = model.zset ms z in @@ -188,17 +180,13 @@ module GreedySim (S : SimState) = o::acc, state) ([], sim.state) inputs in 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. *) - let run_until model solver length = - run_on model solver { start = 0.0; length; u = fun _ -> () } + let run_until model solver h = + run_on model solver { h; u = fun _ -> () } - (** Run the model autonomously until [length], split in multiple [steps]. *) - let run_until_n 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 - { start; length = stop -. start; u = fun _ -> () }) in - run_on_n model solver inputs + (** Run the model autonomously until [h], split in [n] steps. *) + let run_until_n model solver h n = + let h = h /. float_of_int n in + run_on_n model solver (List.init n (fun _ -> { h; u=fun _ -> () })) end diff --git a/src/lib/hsim/types.ml b/src/lib/hsim/types.ml index e452591..bf9007a 100644 --- a/src/lib/hsim/types.ml +++ b/src/lib/hsim/types.ml @@ -3,14 +3,13 @@ type time = float (** Input and output values are functions defined on intervals. *) type 'a value = - { start : time; - length : time; (* Relative: [end = start + length]. *) - u : time -> 'a } (* Defined on [[start, end]]. *) + { h : time; + u : time -> 'a } (* Defined on [[0, h]]. *) (** A time signal is a sequence of possibly absent α-values - [{ start; length; u }] where: - - [start] and [length] are positive (possibly null) floating-point numbers; - - [u: [0, length] -> α] *) + [{ h; u }] where: + - [h : R⁺] + - [u: [0, h] -> α] *) type 'a signal = 'a value option (** A discrete node. *) @@ -42,16 +41,16 @@ type ('a, 'b, 'y, 'yder) cnode = type ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode = HNode : { state: 's; - step : 's -> 'a -> 'b * 's; (** Discrete step function. *) - fder : 's -> 'a -> 'y -> 'yder; (** Continuous derivative function. *) - fout : 's -> 'a -> 'y -> 'b; (** Continuous output function. *) - fzer : 's -> 'a -> 'y -> 'zout; (** Continuous zero-crossing function. *) - reset : 'p -> 's -> 's; (** Reset function. *) - horizon : 's -> time; (** Next integration horizon. *) - jump : 's -> bool; (** Discontinuity flag. *) - cget : 's -> 'y; (** Get continuous state. *) - cset : 's -> 'y -> 's; (** Set continuous state. *) - zset : 's -> 'zin -> 's; (** Set zero-crossing state. *) + step : 's -> 'a -> 'b * 's; (** Discrete step function. *) + fder : 's -> 'a -> 'y -> 'yder; (** Continuous derivative function. *) + fout : 's -> 'a -> 'y -> 'b; (** Continuous output function. *) + fzer : 's -> 'a -> 'y -> 'zout; (** Continuous zero-crossing function. *) + reset : 'p -> 's -> 's; (** Reset function. *) + horizon : 's -> time; (** Next integration horizon. *) + jump : 's -> bool; (** Discontinuity flag. *) + cget : 's -> 'y; (** Get continuous state. *) + cset : 's -> 'y -> 's; (** Set continuous state. *) + zset : 's -> 'zin -> 's; (** Set zero-crossing state. *) csize : int; zsize : int; } -> ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode diff --git a/src/lib/hsim/utils.ml b/src/lib/hsim/utils.ml index e4da67f..0286344 100644 --- a/src/lib/hsim/utils.ml +++ b/src/lib/hsim/utils.ml @@ -1,9 +1,9 @@ open Types -(** Offset the [input.u] function by [now]. *) -let offset (input : 'a value) (now : time) : time -> 'a = - fun t -> input.u ((now -. input.start) +. t) +(** Offset the [u] function by [now]. *) +let offset (u : time -> 'a) (now : time) : time -> 'a = + fun t -> u (t +. now) (** 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") | [f] -> f - | { start; u; _ } :: l -> - let { start=sr; length=lr; u=ur } = compose l in - 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) } + | { u; h } :: l -> + let { h=hr; u=ur } = concat l in + { h=h+.hr; u=fun t -> if t <= h then u t else ur (t -. h) }