feat: consider values without absolute timestamps
This commit is contained in:
parent
b27d39562d
commit
1a4f950324
GPG key ID:
7065F57ED8856128
4 changed files with 60 additions and 75 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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. *)
|
||||
|
|
|
|||
|
|
@ -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) }
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue