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

feat: a LOT of stuff (final report, examples, simulation of a single assert, move from node instances to node definitions, etc.)

Browse source
This commit is contained in:
Henri Saudubray 2025-08-20 18:20:46 +02:00
parent ba5db5bd99
commit f2c545ce2c
Signed by: hms
GPG key ID: 7065F57ED8856128
49 changed files with 12377 additions and 1898 deletions
Download patch file Download diff file Expand all files Collapse all files

83
exm/builtins/ball_assert.ml Normal file
View file

@ -0,0 +1,83 @@
open Hsim.Types
open Solvers.Zls
(* let hybrid bouncing () = (x, y) where
rec der y = y' init y0
and der y' = -. g init y'0 reset z -> -0.8 *. last y'
and z = up (-. y)
and assert (up (-. (y +. epsilon))) *)
let of_array (a : time array) : carray =
Bigarray.(Array1.of_array Float64 c_layout) a
type state =
{ zin : zarray;
lx : carray; (* [| y'; y |] *)
i : bool; }
let g = -9.81
let y0 = 50.0
let y'0 = 0.0
let x0 = 0.0
let x'0 = 1.0
let ball ()
: (state, unit, unit, carray, carray, carray, zarray, carray) hrec
= let zsize = 1 in
let csize = 2 in
let yd = cmake csize in
let zout = cmake zsize in
let zfalse = zmake 1 in
let state = { zin=zfalse; lx=of_array [| y'0; y0 |]; i=true } in
let fder _ _ () y = yd.{0} <- g; yd.{1} <- y.{0}; yd in
let fzer _ _ () y = zout.{0} <- -. y.{1}; zout in
let fout _ _ _ y = y in
let step s _ () =
let lx =
if s.zin.{0} = 1l then of_array [| -. 0.8 *. s.lx.{0}; s.lx.{1} |]
else s.lx in
s.lx, { zin=zfalse; lx; i=false } in
let reset () _ = state in
let horizon _ = max_float in
let jump _ = true in
let cset s lx = { s with lx } in
let cget s = s.lx in
let zset s zin = { s with zin } in
{ state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset;
csize; zsize }
type astate = { zin_a: zarray }
let aball epsilon
: (astate, unit, state, bool, carray, carray, zarray, carray) hrec
= let zsize = 1 in
let csize = 0 in
let zin_a = zmake zsize in
let yd = cmake csize in
let zout = cmake zsize in
let state = { zin_a } in
let fder _ _ _ _ = yd in
let fzer _ _ st _ = zout.{0} <- -. (st.lx.{1} +. epsilon); zout in
let fout _ _ st _ = st.lx.{1} +. epsilon >= 0.0 in
let step { zin_a } _ st =
zin_a.{0} <> 1l && st.lx.{1} +. epsilon >= 0.0, { zin_a } in
let reset _ _ = state in
let horizon _ = max_float in
let jump _ = true in
let cset s _ = s in
let cget s = yd in
let zset _ zin_a = { zin_a } in
{ state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset; csize; zsize }
let errmsg_invalid = "Invalid arguments to model (needed: [float])"
let errmsg_few = "Too few arguments to model (needed: [float])"
let errmsg_many = "Too many arguments to model (needed: [float])"
let init = function
| [eps] ->
let eps = try float_of_string eps
with Failure _ -> raise (Invalid_argument errmsg_invalid) in
let a = HNodeA { body=aball eps; assertions=[] } in
HNodeA { body=ball (); assertions=[a] }
| [] -> raise (Invalid_argument errmsg_few)
| _ -> raise (Invalid_argument errmsg_many)

74
exm/builtins/main.ml
View file

@ -4,19 +4,21 @@ open Solvers
open Common
open Types
let sample = ref 1
let stop = ref 10.0
let accel = ref false
let inplace = ref false
let sundials = ref false
let speed = ref false
let steps = ref 1
let model = ref None
let minstep = ref None
let maxstep = ref None
let mintol = ref None
let maxtol = ref None
let no_print = ref false
let sample = ref 1
let stop = ref 10.0
let accel = ref false
let inplace = ref false
let sundials = ref false
let speed = ref false
let steps = ref 1
let model = ref None
let minstep = ref None
let maxstep = ref None
let mintol = ref None
let maxtol = ref None
let no_print = ref false
let no_assert = ref false
let c_assert = ref false
let gt0i v i = v := if i <= 0 then 1 else i
let gt0f v f = v := if f <= 0.0 then 1.0 else f
@ -29,7 +31,7 @@ let set_model s =
| Some _ -> modelargs := s :: !modelargs
let opts = [
"-sample", Arg.Int (gt0i sample), "n \tSample count (default=10)";
"-sample", Arg.Int (gt0i sample), "n \tSample count (default=1)";
"-stop", Arg.Float (gt0f stop), "n \tStop time (default=10.0)";
"-debug", Arg.Set Debug.debug, "\tPrint debug information";
"-accelerate", Arg.Set accel, "\tConcatenate continuous functions";
@ -41,7 +43,9 @@ let opts = [
"-maxstep", Arg.String (opt maxstep), "\tSet maximum solver step length";
"-mintol", Arg.String (opt mintol), "\tSet minimum solver tolerance";
"-maxtol", Arg.String (opt maxtol), "\tSet maximum solver tolerance";
"-no-print", Arg.Set no_print, "\tDo not print output values";
"-noprint", Arg.Set no_print, "\tDo not print output values";
"-noassert", Arg.Set no_assert, "\tDo not check assertions";
"-cassert", Arg.Set c_assert, "\tCheck assertions continuously";
]
let errmsg = "Usage: " ^ Sys.executable_name ^ " [OPTIONS] MODEL\nOptions are:"
@ -53,12 +57,13 @@ let args = List.rev !modelargs
let m =
try match !model with
| None -> Format.eprintf "Missing model\n"; exit 2
| Some "ball" -> Ball.init args
| Some "vdp" -> Vdp.init args
| Some "sincos" -> Sincos.init args
| Some "sqrt" -> Sqrt.init args
| Some "sin1x" -> Sin1x.init args
| Some "sin1xd" -> Sin1x_der.init args
| Some "ball" -> a_of_h @@ Ball.init args
| Some "vdp" -> a_of_h @@ Vdp.init args
| Some "sincos" -> a_of_h @@ Sincos.init args
| Some "sqrt" -> a_of_h @@ Sqrt.init args
| Some "sin1x" -> a_of_h @@ Sin1x.init args
| Some "sin1xd" -> a_of_h @@ Sin1x_der.init args
| Some "aball" -> Ball_assert.init args
| Some s -> Format.eprintf "Unknown model: %s\n" s; exit 2
with Invalid_argument s -> Format.eprintf "%s\n" s; exit 2
@ -73,21 +78,30 @@ let output =
let sim =
if !sundials then
let open StatefulSundials in
let c = if !inplace then InPlace.csolve () else Functional.csolve () in
let c = if !inplace then InPlace.csolve else Functional.csolve in
let open StatefulZ in
let z = if !inplace then InPlace.zsolve () else Functional.zsolve () in
let s = Solver.solver c (d_of_dc z) in
let z = if !inplace then InPlace.zsolve else Functional.zsolve in
let s = Solver.solver c (fun () -> d_of_dc (z ())) in
let open Sim.Sim(val st) in
Hsim.Utils.run_until_n (output !sample (run m s))
let sim = if !no_assert then run (fun () -> h_of_a m) s
else if !c_assert then run_assert_continuous (fun () -> m) s
else run_assert_sample !sample (fun () -> m) s in
Hsim.Utils.run_until_n (output !sample sim ())
else
let open StatefulRK45 in
let c = if !inplace then InPlace.csolve () else Functional.csolve () in
let c = if !inplace then InPlace.csolve else Functional.csolve in
let open StatefulZ in
let z = if !inplace then InPlace.zsolve () else Functional.zsolve () in
let z = if !inplace then InPlace.zsolve else Functional.zsolve in
let s = Solver.solver_c c z in
let open Sim.Sim(val st) in
let n = if !accel then accelerate m s else run m (d_of_dc s) in
Hsim.Utils.run_until_n (output !sample n)
let sim =
if !no_assert then
if !accel then accelerate (fun () -> h_of_a m) s
else run (fun () -> h_of_a m) (fun () -> d_of_dc (s ()))
else
if !c_assert then run_assert_continuous (fun () -> m) (fun () -> d_of_dc (s ()))
else run_assert_sample !sample (fun () -> m) (fun () -> d_of_dc (s ())) in
Hsim.Utils.run_until_n (output !sample sim ())
let () = sim !stop !steps ignore
let () = ignore @@ sim !stop !steps ignore