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

feat: somewhat compatible with zelus output

Browse source
This commit is contained in:
Henri Saudubray 2025-06-23 15:48:58 +02:00
parent 589f89c768
commit 6d92261afd
Signed by: hms
GPG key ID: 7065F57ED8856128
19 changed files with 107 additions and 515 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -7,12 +7,13 @@ module Sim (S : SimState) =
struct
include S
let step_discrete s step hor fder fzer cget csize zsize jump reset =
Common.Debug.print "SIMU :: DISCRETE :: start";
let ms, ss = get_mstate s, get_sstate s in
let step_discrete s step hor fder fzer cget zset csize zsize jump reset =
let ms, ss, zin = get_mstate s, get_sstate s, get_zin s in
let ms = match zin with Some z -> zset ms z | None -> ms in
let i, now, stop = get_input s, get_now s, get_stop s in
let o, ms = step ms (i.u now) in
let s =
let s = set_zin None s in
let h = hor ms in
if h <= 0.0 then set_mstate ms s
else if now >= stop then set_idle s
@ -27,30 +28,25 @@ module Sim (S : SimState) =
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
Common.Debug.print "SIMU :: DISCRETE :: end";
Utils.dot o, s
let step_continuous s step cset fout zset =
Common.Debug.print "SIMU :: CONTINUOUS :: start";
let step_continuous s step cset fout hor =
let ms, ss = get_mstate s, get_sstate s in
let i, now, stop = get_input s, get_now s, get_stop s in
let (h, f, z), ss = step ss stop in
let stop = min stop (hor ms) in
let (h, f, z), ss = step ss (min stop (hor ms)) in
let ms = cset ms (f h) in
let fy t = f (now +. t) in
let fms t = cset ms (fy t) in
let fout t = fout ms (i.u (now +. t)) (fy t) in
let s, c = match z with
| None ->
let s, c = if h >= stop
then set_running ~mode:Discrete ~now:h s, Discontinuous
else set_running ~now: h s, Continuous in
update ms ss s, c
| Some z ->
let s = set_running ~mode:Discrete ~now:h s in
update (zset ms z) ss s, Discontinuous in
if h >= stop
then set_running ~mode:Discrete ~now:h s, Discontinuous
else set_running ~now: h s, Continuous
| Some _ -> set_running ~mode:Discrete ~now:h s, Discontinuous in
let h = h -. now in
Common.Debug.print "SIMU :: CONTINUOUS :: end";
{ h; u=fout; c }, s, { h; c; u=fms }
{ h; u=fout; c }, update ms ss (set_zin z s), { h; c; u=fms }
(** Simulation of a model with any solver. *)
let run
@ -59,11 +55,11 @@ module Sim (S : SimState) =
: ('p * (('y, 'yder) ivp * ('y, 'zout) zc), 'a, 'b) sim
= let state = get_init m.state s.state in
let step_discrete st =
let o, s = step_discrete st m.step m.horizon m.fder m.fzer m.cget
let o, s = step_discrete st m.step m.horizon m.fder m.fzer m.cget m.zset
m.csize m.zsize m.jump s.reset in
Some o, s in
let step_continuous st =
let o, s, _ = step_continuous st s.step m.cset m.fout m.zset in
let o, s, _ = step_continuous st s.step m.cset m.fout m.horizon in
Some o, s in
let step st = function
@ -95,8 +91,8 @@ module Sim (S : SimState) =
let step_discrete (st, al) =
let m=m.body in
let o, st =
step_discrete st m.step m.horizon m.fder m.fzer m.cget m.csize m.zsize
m.jump s.reset in
step_discrete st m.step m.horizon m.fder m.fzer m.cget m.zset m.csize
m.zsize m.jump s.reset in
let al = List.map (fun (DNode a) ->
let _, state = a.step a.state @@ Some (Utils.dot @@ get_mstate st) in
DNode { a with state }) al in
@ -104,7 +100,7 @@ module Sim (S : SimState) =
let step_continuous (st, al) =
let ({ h; _ } as o), st, u =
step_continuous st s.step m.body.cset m.body.fout m.body.zset in
step_continuous st s.step m.body.cset m.body.fout m.body.horizon in
let al = List.map (fun (DNode a) ->
(* Step assertions repeatedly until they reach the horizon. *)
let rec step s =
@ -140,10 +136,10 @@ module Sim (S : SimState) =
= let state = get_init m.state s.state in
let step_discrete st =
let o, st = step_discrete st m.step m.horizon m.fder m.fzer m.cget
m.csize m.zsize m.jump s.reset in
m.zset m.csize m.zsize m.jump s.reset in
Some o, st in
let step_continuous st =
let o, st, _ = step_continuous st s.step m.cset m.fout m.zset in
let o, st, _ = step_continuous st s.step m.cset m.fout m.horizon in
o, st in
let rec step st = function

54
src/lib/hsim/state.ml
View file

@ -15,59 +15,65 @@ module type SimState =
- Idle: waiting for input;
- Running: currently integrating; in this case, we have access to the
step mode, current input, timestamp and stop time. *)
type ('a, 'ms, 'ss) state
type ('a, 'ms, 'ss, 'zin) state
(** Get the model state. *)
val get_mstate : ('a, 'ms, 'ss) state -> 'ms
val get_mstate : ('a, 'ms, 'ss, 'zin) state -> 'ms
(** Get the solver state. *)
val get_sstate : ('a, 'ms, 'ss) state -> 'ss
val get_sstate : ('a, 'ms, 'ss, 'zin) state -> 'ss
(** Get the last zero-crossing value. *)
val get_zin : ('a, 'ms, 'ss, 'zin) state -> 'zin option
(** Get the current step mode.
⚠ Should only be called when running (see [is_running]). *)
val get_mode : ('a, 'ms, 'ss) state -> mode
val get_mode : ('a, 'ms, 'ss, 'zin) state -> mode
(** Get the current input.
⚠ Should only be called when running (see [is_running]). *)
val get_input : ('a, 'ms, 'ss) state -> 'a value
val get_input : ('a, 'ms, 'ss, 'zin) state -> 'a value
(** Get the current timestamp.
⚠ Should only be called when running (see [is_running]). *)
val get_now : ('a, 'ms, 'ss) state -> time
val get_now : ('a, 'ms, 'ss, 'zin) state -> time
(** Get the current stop time.
⚠ Should only be called when running (see [is_running]). *)
val get_stop : ('a, 'ms, 'ss) state -> time
val get_stop : ('a, 'ms, 'ss, 'zin) state -> time
(** Build an initial state. *)
val get_init : 'ms -> 'ss -> ('a, 'ms, 'ss) state
val get_init : 'ms -> 'ss -> ('a, 'ms, 'ss, 'zin) state
(** Is the simulation running or idle ? *)
val is_running : ('a, 'ms, 'ss) state -> bool
val is_running : ('a, 'ms, 'ss, 'zin) state -> bool
(** Update the model state. *)
val set_mstate : 'ms -> ('a, 'ms, 'ss) state -> ('a, 'ms, 'ss) state
val set_mstate : 'ms -> ('a, 'ms, 'ss, 'zin) state -> ('a, 'ms, 'ss, 'zin) state
(** Update the solver state. *)
val set_sstate : 'ss -> ('a, 'ms, 'ss) state -> ('a, 'ms, 'ss) state
val set_sstate : 'ss -> ('a, 'ms, 'ss, 'zin) state -> ('a, 'ms, 'ss, 'zin) state
(** Update the zero-crossing value. *)
val set_zin : 'zin option -> ('a, 'ms, 'ss, 'zin) state -> ('a, 'ms, 'ss, 'zin) state
(** Update both the solver and model states. *)
val update : 'ms -> 'ss -> ('a, 'ms, 'ss) state -> ('a, 'ms, 'ss) state
val update : 'ms -> 'ss -> ('a, 'ms, 'ss, 'zin) state -> ('a, 'ms, 'ss, 'zin) state
(** Update the status to running. *)
val set_running :
?mode:mode -> ?input:'a value -> ?now:time -> ?stop:time ->
('a, 'ms, 'ss) state -> ('a, 'ms, 'ss) state
('a, 'ms, 'ss, 'zin) state -> ('a, 'ms, 'ss, 'zin) state
(** Update the status to idle. *)
val set_idle : ('a, 'ms, 'ss) state -> ('a, 'ms, 'ss) state
val set_idle : ('a, 'ms, 'ss, 'zin) state -> ('a, 'ms, 'ss, 'zin) state
end
module type SimStateCopy =
sig
include SimState
val copy : ('a, 'ms, 'ss) state -> ('a, 'ms, 'ss) state
val copy : ('a, 'ms, 'ss, 'zin) state -> ('a, 'ms, 'ss, 'zin) state
end
module FunctionalSimState : SimState =
@ -88,15 +94,17 @@ module FunctionalSimState : SimState =
(** Internal state of the simulation node: model state, solver state and
current simulation status. *)
type ('a, 'ms, 'ss) state =
type ('a, 'ms, 'ss, 'zin) state =
{ status : 'a status; (** Current simulation status. *)
mstate : 'ms; (** Model state. *)
sstate : 'ss } (** Solver state. *)
sstate : 'ss; (** Solver state. *)
zin : 'zin option; } (** Last zero-crossing vector *)
exception Not_running
let get_mstate state = state.mstate
let get_sstate state = state.sstate
let get_zin state = state.zin
let is_running state =
match state.status with Running _ -> true | Idle -> false
@ -120,6 +128,7 @@ module FunctionalSimState : SimState =
let set_mstate mstate state = { state with mstate }
let set_sstate sstate state = { state with sstate }
let set_zin zin state = { state with zin }
let update mstate sstate state = { state with mstate; sstate }
@ -132,7 +141,7 @@ module FunctionalSimState : SimState =
let get_stop s =
match s.status with Running r -> r.stop | Idle -> raise Not_running
let get_init mstate sstate = { status = Idle; mstate; sstate }
let get_init mstate sstate = { status = Idle; mstate; sstate; zin = None }
end
module InPlaceSimState : SimState =
@ -146,15 +155,17 @@ module InPlaceSimState : SimState =
mutable stop : time;
} -> 'a status
type ('a, 'ms, 'ss) state =
type ('a, 'ms, 'ss, 'zin) state =
{ mutable status : 'a status;
mutable mstate : 'ms;
mutable sstate : 'ss }
mutable sstate : 'ss;
mutable zin : 'zin option }
exception Not_running
let get_mstate state = state.mstate
let get_sstate state = state.sstate
let get_zin state = state.zin
let is_running state =
match state.status with Running _ -> true | Idle -> false
@ -179,6 +190,7 @@ module InPlaceSimState : SimState =
let set_mstate mstate state = state.mstate <- mstate; state
let set_sstate sstate state = state.sstate <- sstate; state
let set_zin zin state = state.zin <- zin; state
let update mstate sstate state =
state.mstate <- mstate; state.sstate <- sstate; state
@ -192,6 +204,6 @@ module InPlaceSimState : SimState =
let get_stop s =
match s.status with Running r -> r.stop | Idle -> raise Not_running
let get_init mstate sstate = { status = Idle; mstate; sstate }
let get_init mstate sstate = { status = Idle; mstate; sstate; zin=None }
end

1
src/lib/solvers/illinois.ml
View file

@ -154,7 +154,6 @@ let num_roots { f0; _ } = Zls.length f0
(* f0/t0 take the previous values of f1/t1, f1/t1 are refreshed by g *)
let step ({ g; f0 = f0; f1 = f1; t1 = t1; _ } as s) t c =
Common.Debug.print "ZSOL :: Calling [step]";
(* swap f0 and f1; f0 takes the previous value of f1 *)
s.f0 <- f1;
s.t0 <- t1;

2
src/lib/solvers/statefulRK45.ml
View file

@ -22,8 +22,6 @@ module Functional =
{ state; vec = init } in
let step ({ state ; vec=v } as s) h =
Common.Debug.print "SOLVER STEP";
Common.Debug.print_entry v;
let y_nv = vec v in
let h = step state h y_nv in
let state = copy state in

2
src/lib/solvers/statefulZ.ml
View file

@ -17,8 +17,6 @@ module Functional =
let reset { fzer; init; size } { vec; _ } =
let fzer t cvec zout =
let zout' = fzer t cvec in blit zout' zout in
Common.Debug.print "ZSolver Reset";
Common.Debug.print_entry init;
{ state = initialize size fzer init;
vec = if length vec = size then vec else zmake size } in