feat (sim): greedy simulation
This commit is contained in:
parent
b4a29bbb97
commit
3d317f65a0
GPG key ID:
7065F57ED8856128
5 changed files with 421 additions and 262 deletions
|
|
@ -6,19 +6,28 @@ open State
|
|||
let offset (input : 'a value) (now : time) : time -> 'a =
|
||||
fun t -> input.u ((now -. input.start) +. t)
|
||||
|
||||
let rec compose = function
|
||||
| [] -> assert false
|
||||
| [f] -> f
|
||||
| { start=sl; u=ul; _ } :: 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 }
|
||||
|
||||
module LazySim (S : SimState) =
|
||||
struct
|
||||
|
||||
(* TODO: figure out where we initialize the solvers; the initialization
|
||||
function already supposes an initialized solver state, but could we
|
||||
parameterize [LazySim] with a solver state module that provides its
|
||||
own initialization function ? *)
|
||||
(* TODO: figure out where we initialize the solvers; the initialization and
|
||||
reset functions already suppose an initialized solver state, but
|
||||
could we parameterize simulation with a solver state module that
|
||||
provides its own initialization function ? *)
|
||||
|
||||
let sim
|
||||
(HNode model : ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode)
|
||||
(DNode solver : ('y, 'yder, 'zin, 'zout) solver)
|
||||
: ('p, 'a, 'b) sim
|
||||
= let s = S.init ~mstate:model.state ~sstate:solver.state in
|
||||
: ('p, 'a, 'b) lazy_sim
|
||||
= let state = S.init ~mstate:model.state ~sstate:solver.state in
|
||||
|
||||
let step state input =
|
||||
let mstate = S.mstate state and sstate = S.sstate state
|
||||
and status = S.status state in
|
||||
|
|
@ -39,8 +48,9 @@ module LazySim (S : SimState) =
|
|||
let h = model.horizon mstate in
|
||||
if h <= 0.0 then S.update ~mstate state
|
||||
else if now >= stop then
|
||||
(* TODO: equivalent of [s] (initial state of model and
|
||||
solvers) ? *)
|
||||
(* TODO: Build an initial state with the initial states for
|
||||
both the solver and model - an equivalent of [s] in
|
||||
the original version. *)
|
||||
raise Common.Utils.TODO
|
||||
else if model.jump mstate then
|
||||
let y = model.cget mstate in
|
||||
|
|
@ -75,77 +85,97 @@ module LazySim (S : SimState) =
|
|||
let mstate = model.zset mstate z in
|
||||
S.update ~status ~mstate ~sstate state in
|
||||
Some out, state in
|
||||
let reset m s =
|
||||
let mstate = model.reset m (S.mstate s) in
|
||||
|
||||
let reset p s =
|
||||
(* TODO: does [model.cget mstate] make sense before the first discrete
|
||||
step - can we use [mstate] to reinitialize [sstate] ? *)
|
||||
let mstate = model.reset p (S.mstate s) in
|
||||
let y = model.cget mstate in
|
||||
(* TODO: what initial stop time do we use ? *)
|
||||
let stop = raise Common.Utils.TODO in
|
||||
let ivp = { fder = model.fder mstate; stop; init = y } in
|
||||
let zc = { fzer = model.fzer mstate; yc = y } in
|
||||
let sstate = solver.reset (ivp, zc) (S.sstate s) in
|
||||
let status = S.idle (S.status s) in
|
||||
S.update ~status ~mstate ~sstate s in
|
||||
DNode { state = s; step; reset }
|
||||
|
||||
DNode { state; step; reset }
|
||||
|
||||
end
|
||||
|
||||
module GreedySim (S : SimState) =
|
||||
struct
|
||||
|
||||
(* TODO: greedy simulation *)
|
||||
(* TODO: greedy simulation: call the solvers and the subsystems as often as
|
||||
needed until we reach the horizon. *)
|
||||
|
||||
let sim
|
||||
(HNode model : ('p, 'a, 'b, 'y, 'yder, 'zin, 'zout) hnode)
|
||||
(DNode solver : ('y, 'yder, 'zin, 'zout) solver)
|
||||
: ('p, 'a, 'b) sim
|
||||
: ('p, 'a, 'b) greedy_sim
|
||||
= let state = S.init ~mstate:model.state ~sstate:solver.state in
|
||||
|
||||
let rec step state input =
|
||||
let status = S.status state and mstate = S.mstate state
|
||||
and sstate = S.sstate state in
|
||||
match input, S.is_running state with
|
||||
| Some input, _ ->
|
||||
let mode = Discrete and now = 0.0 and stop = input.length in
|
||||
let status = S.running ~mode ~input ~now ~stop (S.status state) in
|
||||
let state = S.update ~status state in
|
||||
step state None
|
||||
| None, false -> None, state
|
||||
| None, true ->
|
||||
let input = S.input state and now = S.now state
|
||||
and stop = S.stop state in
|
||||
match S.mode state with
|
||||
| Discrete ->
|
||||
let o, mstate = model.step mstate (input.u now) in
|
||||
let state =
|
||||
let h = model.horizon mstate in
|
||||
if h <= 0.0 then S.update ~mstate state
|
||||
else if now >= stop then raise Common.Utils.TODO
|
||||
else if model.jump mstate then
|
||||
let y = model.cget mstate in
|
||||
let fder t = model.fder mstate (offset input now t) in
|
||||
let fzer t = model.fzer mstate (offset input now t) in
|
||||
let ivp = { fder; stop = stop -. now; init = y } in
|
||||
let zc = { yc = y; fzer } in
|
||||
let sstate = solver.reset (ivp, zc) sstate in
|
||||
let status = S.running ~mode:Continuous status in
|
||||
S.update ~status ~mstate ~sstate state
|
||||
else
|
||||
let status = S.running ~mode:Continuous status in
|
||||
S.update ~status state in
|
||||
let start = input.start +. now in
|
||||
Some { start; length = 0.0; u = fun _ -> o }, state
|
||||
| Continuous ->
|
||||
let (h, f, z), sstate = solver.step sstate stop in
|
||||
let mstate = model.cset mstate (f h) in
|
||||
let h' = input.start +. h in
|
||||
let fout t =
|
||||
model.fout mstate (input.u (now +. t)) (f (now +. t)) in
|
||||
let out =
|
||||
{ start = input.start +. now; length = h -. now; u = fout } in
|
||||
match z with
|
||||
| None ->
|
||||
let status =
|
||||
if h >= stop then S.running ~mode:Discrete ~now:h' status
|
||||
in
|
||||
if not (S.is_running state) then
|
||||
let mode = Discrete and now = 0.0 and stop = input.length in
|
||||
let status = S.running ~mode ~input ~now ~stop (S.status state) in
|
||||
let state = S.update ~status state in
|
||||
step state input
|
||||
else let now = S.now state and stop = S.stop state in
|
||||
match S.mode state with
|
||||
| Discrete ->
|
||||
let o, mstate = model.step mstate (input.u now) in
|
||||
let h = model.horizon mstate in
|
||||
let rest, state =
|
||||
if h <= 0.0 then step (S.update ~mstate state) input
|
||||
else if now >= stop then [], state
|
||||
else if model.jump mstate then
|
||||
let y = model.cget mstate in
|
||||
let fder t = model.fder mstate (offset input now t) in
|
||||
let fzer t = model.fzer mstate (offset input now t) in
|
||||
let ivp = { fder; stop = stop -. now; init = y } in
|
||||
let zc = { yc = y; fzer } in
|
||||
let sstate = solver.reset (ivp, zc) sstate in
|
||||
let status = S.running ~mode:Continuous status in
|
||||
step (S.update ~status ~mstate ~sstate state) input
|
||||
else
|
||||
let status = S.running ~mode:Continuous status in
|
||||
step (S.update ~status state) input in
|
||||
let start = input.start +. now in
|
||||
{ start; length = 0.0; u = fun _ -> o }::rest, state
|
||||
| Continuous ->
|
||||
let (h, f, z), _sstate = solver.step sstate stop in
|
||||
let mstate = model.cset mstate (f h) in
|
||||
let h' = input.start +. h in
|
||||
let fout t =
|
||||
model.fout mstate (input.u (now +. t)) (f (now +. t)) in
|
||||
let out =
|
||||
{ start = input.start +. now; length = h -. now; u = fout } in
|
||||
match z with
|
||||
| None ->
|
||||
if h >= stop then
|
||||
let status = S.running ~mode:Discrete ~now:h' status in
|
||||
let rest, state =
|
||||
step (S.update ~status ~mstate ~sstate state) input in
|
||||
out::rest, state
|
||||
else
|
||||
let status = S.running ~now:h' status in
|
||||
let rest, state =
|
||||
step (S.update ~status ~mstate ~sstate state) input in
|
||||
(match rest with
|
||||
| [] -> [out], state
|
||||
| f::rest -> compose [out;f] :: rest, state)
|
||||
| Some z ->
|
||||
let status = S.running ~mode:Discrete ~now:h' status in
|
||||
let mstate = model.zset mstate z in
|
||||
let rest, state =
|
||||
step (S.update ~status ~mstate ~sstate state) input in
|
||||
out::rest, state in
|
||||
|
||||
let reset = assert false in
|
||||
|
||||
DNode { state; step; reset }
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,20 +1,6 @@
|
|||
|
||||
open Types
|
||||
|
||||
(* Model *)
|
||||
|
||||
module type ModelState =
|
||||
sig
|
||||
type state
|
||||
end
|
||||
|
||||
(* Solvers *)
|
||||
|
||||
module type SolverState =
|
||||
sig
|
||||
type state
|
||||
end
|
||||
|
||||
(* Simulation *)
|
||||
|
||||
(** Step mode: discrete or continuous *)
|
||||
|
|
@ -52,7 +38,7 @@ module type SimState =
|
|||
val idle : 'a status -> 'a status
|
||||
|
||||
(** Update the status to running. *)
|
||||
val running :
|
||||
val running :
|
||||
?mode:mode -> ?input:'a value ->
|
||||
?now:time -> ?stop:time -> 'a status -> 'a status
|
||||
|
||||
|
|
@ -81,7 +67,7 @@ module FunctionalSimState : SimState =
|
|||
|
||||
(** Simulation status:
|
||||
- [Idle]: Waiting for input, no activity;
|
||||
- [Running]: Currently integrating: step [mode], current [input], [now]
|
||||
- [Running]: Currently integrating: step [mode], current [input], [now]
|
||||
timestamp, and [stop] time. *)
|
||||
type 'a status =
|
||||
| Idle : 'a status
|
||||
|
|
@ -92,7 +78,7 @@ module FunctionalSimState : SimState =
|
|||
stop : time; (** How long until we stop. *)
|
||||
} -> 'a status
|
||||
|
||||
(** Internal state of the simulation node: model state, solver state and
|
||||
(** Internal state of the simulation node: model state, solver state and
|
||||
current simulation status. *)
|
||||
type ('a, 'ms, 'ss) state =
|
||||
{ status : 'a status; (** Current simulation status. *)
|
||||
|
|
@ -137,7 +123,7 @@ module FunctionalSimState : SimState =
|
|||
match s.status with Running r -> r.input | Idle -> raise Not_running
|
||||
let now s =
|
||||
match s.status with Running r -> r.now | Idle -> raise Not_running
|
||||
let stop s =
|
||||
let stop s =
|
||||
match s.status with Running r -> r.stop | Idle -> raise Not_running
|
||||
|
||||
let init ~mstate ~sstate = { status = Idle; mstate; sstate }
|
||||
|
|
@ -198,7 +184,7 @@ module InPlaceSimState : SimState =
|
|||
match s.status with Running r -> r.input | Idle -> raise Not_running
|
||||
let now s =
|
||||
match s.status with Running r -> r.now | Idle -> raise Not_running
|
||||
let stop s =
|
||||
let stop s =
|
||||
match s.status with Running r -> r.stop | Idle -> raise Not_running
|
||||
|
||||
let init ~mstate ~sstate = { status = Idle; mstate; sstate }
|
||||
|
|
|
|||
|
|
@ -81,5 +81,10 @@ type ('y, 'yder, 'zin, 'zout) solver =
|
|||
|
||||
(** The simulation of a hybrid system is a synchronous function on streams of
|
||||
functions. *)
|
||||
type ('p, 'a, 'b) sim =
|
||||
type ('p, 'a, 'b) lazy_sim =
|
||||
('p, 'a signal, 'b signal) dnode
|
||||
|
||||
(** Greedy simulation takes in an input and computes as many solver and
|
||||
subsystem steps as needed to reach the input's horizon. *)
|
||||
type ('p, 'a, 'b) greedy_sim =
|
||||
('p, 'a value, 'b value list) dnode
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue