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

feat: a lot of stuff

Browse source
This commit is contained in:
Henri Saudubray 2025-05-12 14:50:10 +02:00
parent dd6152833f
commit 6cec3d6c5d
Signed by: hms
GPG key ID: 7065F57ED8856128
22 changed files with 476 additions and 276 deletions
Download patch file Download diff file Expand all files Collapse all files

30
exm/sincos.ml
View file

@ -6,12 +6,15 @@ let of_array a = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
type state = { si : bool; sx : carray }
let yd = cmake 3
let zout = cmake 1
let csize = 3
let zsize = 1
let fzer _ _ _ = zout
let fder y yd omega =
yd.{0} <- omega *. y.{1}; yd.{1} <- -.omega *. y.{0}; yd.{2} <- 1.0; yd
let fout _ _ y = of_array [| y.{0}; y.{1}; y.{2} |]
let step { si; sx } sin0 cos0 =
let sx = if si then of_array [| sin0; cos0; 0.0 |] else sx in
of_array [| sx.{0}; sx.{1}; sx.{2} |], { sx; si=false }
let cget s = s.sx
let cset s lx = { s with sx=lx }
let zset s _ = s
@ -21,21 +24,20 @@ let horizon _ = max_float
let sinus_cosinus theta0 omega =
let sin0 = Float.sin theta0 in
let cos0 = Float.cos theta0 in
let fder _ _ y =
yd.{0} <- omega *. y.{1}; yd.{1} <- -.omega *. y.{0}; yd.{2} <- 1.0; yd in
let step { si; sx } _ =
let sx = if si then of_array [| sin0; cos0; 0.0 |] else sx in
of_array [| sx.{0}; sx.{1}; sx.{2} |], { sx; si=false } in
let state = { sx=of_array [| sin0; cos0; 0.0 |]; si=true } in
let reset _ _ = state in
HNode {
state; fder; fzer; fout; step; horizon; cset; cget; zset; zsize; reset; jump
}
let yd = cmake csize in
let zout = cmake zsize in
let fder _ _ y = fder y yd omega in
let fzer _ _ _ = zout in
let step s _ = step s sin0 cos0 in
let init _ = { sx=of_array [| sin0; cos0; 0.0 |]; si=true } in
let reset _ _ = init () in
HNode { init; fder; fzer; fout; step; reset; horizon;
jump; cset; cget; zset; csize; zsize }
let errmsg_invalid = "Invalid arguments to model (needed: 2 floats)"
let errmsg_few = "Too few arguments to model (needed: 2 floats)"
let errmsg_many = "Too many arguments to model (needed: 2 floats)"
let sinus_cosinus = function
let init = function
| [t0; om] ->
let t0, om = try float_of_string t0, float_of_string om
with Failure _ -> raise (Invalid_argument errmsg_invalid) in