hsim-live/lib/hsim/lift.ml
2026-03-30 13:28:49 +02:00

60 lines
2.9 KiB
OCaml

type ('s, 'a) state =
{ mutable state : 's;
mutable input : 'a option;
mutable time : Ztypes.time;
mutable jump : bool; }
let lift_hsim_full (n : unit Ztypes.hsimu)
: (unit, unit, unit, Ztypes.cvec, Ztypes.dvec, Ztypes.zoutvec, Ztypes.zinvec option) Full.hnode * int
= let Hsim { alloc; step; reset; derivative; crossings; maxsize; _ } = n in
let state = { state = alloc (); input = None; time = 0.0; jump = false } in
let csize, zsize = maxsize state.state in
let no_zin, no_zout = Zls.zmake zsize, Zls.cmake zsize in
let no_der, pos = Zls.cmake csize, Zls.cmake csize in
let no_time = -1.0 in reset state.state;
let fder { state; time; _ } offset () y =
derivative state y no_der no_zin no_zout (time +. offset);
no_der in
let fzer { state; time; _ } offset () y =
crossings state y no_zin no_zout (time +. offset); no_zout in
let fout _ _ () _ = () in
let step { state; time; _ } offset () =
{ state; time=time +. offset; input=Some (); jump = false },
step state pos no_der no_zin (time +. offset) in
let reset ({ state; _ } as st) () = reset state; st in
let jump s = s.jump in
let cset ({ state; _ } as st) _ =
derivative state pos no_der no_zin no_zout no_time; st in
let zset ({ state; _ } as st) = function None -> st | Some zinvec ->
derivative state pos no_der zinvec no_zout no_time; { st with jump = true } in
let cget { state; _ } =
derivative state pos no_der no_zin no_zout no_time; pos in
HNode { state; fder; fzer; fout; step; reset; jump; cget; cset; zset }, zsize
let lift_hsim (n : unit Ztypes.hsimu)
: (unit, unit, unit, Ztypes.cvec, Ztypes.dvec, Ztypes.zoutvec, Ztypes.zinvec option) Fill.hnode * int
= let Hsim { alloc; step; reset; derivative; crossings; maxsize; _ } = n in
let state = { state = alloc (); input = None; time = 0.0; jump = false } in
let csize, zsize = maxsize state.state in
let no_zin, no_zout = Zls.zmake zsize, Zls.cmake zsize in
let no_der, pos = Zls.cmake csize, Zls.cmake csize in
let no_time = -1.0 in reset state.state;
let fder { state; time; _ } offset () y =
derivative state y no_der no_zin no_zout (time +. offset);
no_der in
let fzer { state; time; _ } offset () y =
crossings state y no_zin no_zout (time +. offset); no_zout in
let fout _ _ () _ = () in
let step { state; time; _ } offset () =
{ state; time=time +. offset; input=Some (); jump = false },
step state pos no_der no_zin (time +. offset) in
let reset ({ state; _ } as st) () = reset state; st in
let jump s = s.jump in
let cset ({ state; _ } as st) _ =
derivative state pos no_der no_zin no_zout no_time; st in
let zset ({ state; _ } as st) = function None -> st | Some zinvec ->
derivative state pos no_der zinvec no_zout no_time; { st with jump = true } in
let cget { state; _ } =
derivative state pos no_der no_zin no_zout no_time; pos in
HNode { state; fder; fzer; fout; step; reset; jump; cget; cset; zset }, zsize