feat (exm): sincos example

exm/ball.ml

@@ -52,3 +52,7 @@ let bouncing_ball () =
     horizon = (fun _ -> max_float);
     cset; cget; zset; reset; jump; zsize }
 
+let errmsg = "Too many arguments for the model (needed: 0)"
+let bouncing_ball = function
+  | [] -> bouncing_ball ()
+  | _  -> raise (Invalid_argument errmsg)

exm/sincos.ml

@@ -0,0 +1,44 @@
+
+open Hsim.Types
+open Solvers.Zls
+
+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 zsize = 1
+
+let fzer _ _ _ = zout
+let fout _ _ y = of_array [| y.{0}; y.{1}; y.{2} |]
+let cget s     = s.sx
+let cset s lx  = { s with sx = lx }
+let zset s _   = s
+let jump _     = true
+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 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
+  | [t0; om] ->
+      let t0, om = try float_of_string t0, float_of_string om
+      with Failure _ -> raise (Invalid_argument errmsg_invalid) in
+      sinus_cosinus t0 om
+  | [] | [_] -> raise (Invalid_argument errmsg_few)
+  | _        -> raise (Invalid_argument errmsg_many)

exm/vdp.ml

@@ -1,59 +1,43 @@
 
 open Hsim.Types
-open Solvers
+open Solvers.Zls
 
-let of_array a = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
+let of_array a : carray =
+  Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
 
-type state = { lx : Zls.carray; i : bool }
+type state = { lx : carray; i : bool }
 
 let mu = 5.0
 let x0 = 1.0
 let y0 = 1.0
 
-let fder _ y yd =
-  yd.{0} <- y.{1}; yd.{1} <- (mu *. (1.0 -. (y.{0} *. y.{0})) *. y.{1}) -. y.{0}
-let fzero _ _ _ = ()
-let fout _ y     = of_array [| y.{0}; y.{1} |]
+let zsize = 1
+let yd    = cmake 2
+let zout  = cmake 1
+
+let fder _ _ y =
+  yd.{0} <- y.{1};
+  yd.{1} <- (mu *. (1.0 -. (y.{0} *. y.{0})) *. y.{1}) -. y.{0};
+  yd
+let fzer _ _ _ = zout
+let fout _ _ y = of_array [| y.{0}; y.{1} |]
 let step { i; lx } _ =
   let lx = if i then of_array [| x0; y0 |] else lx in
   of_array [| lx.{0}; lx.{1} |], { lx; i = false }
-
 let cget s     = s.lx
-let cset s lx = { s with lx }
+let cset s lx  = { s with lx }
 let zset s _   = s
-let yd         = Zls.cmake 2
-let zout       = Zls.cmake 1
-let zsize      = 1
-let s_init     = { lx = of_array [| x0; y0 |]; i = true }
-let reset _ _  = s_init
+let state      = { lx = of_array [| x0; y0 |]; i = true }
+let reset _ _  = state
 let jump _     = true
+let horizon _  = max_float
 
-let van_der_pol () =
-  HNode { state = s_init;
-          fder = (fun _ _ y -> fder 0.0 y yd; yd);
-          fzer = (fun _ _ y -> fzero 0.0 y zout; zout);
-          fout = (fun s _ y -> fout s y);
-          step;
-          horizon = (fun _ -> max_float);
-          cset; cget; zset; zsize; reset; jump }
+let van_der_pol () = HNode {
+  state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset; zsize
+}
+
+let errmsg = "Too many arguments for the model (needed: 0)"
+let van_der_pol = function
+  | [] -> van_der_pol ()
+  | _  -> raise (Invalid_argument errmsg)
 
-(* let van_der_pol_prop_record () = *)
-(*   let s_init =  *)
-(*       { lx = of_array [| x0; y0 |]; i = true } in *)
-(*   { name = "van_der_pol_prop"; *)
-(*     s = s_init; *)
-(*     fder = (fun s a y -> fder 0.0 y yd; yd); *)
-(*     fzero = (fun s a y -> fzero 0.0 y zout; zout); *)
-(*     fout = (fun s { lx } y -> 1.0 /. (abs_float (s.lx.{0} -. lx.{0}))); *)
-(*     fstep = (fun s { lx } -> *)
-(*       let v, s = fstep s () in *)
-(*       s.lx.{0} -. lx.{0}, s); *)
-(*     horizon = (fun s -> max_float); *)
-(*     cset; cget; zset; csize; zsize; reset; jump } *)
-(* let van_der_pol_with_assert () = *)
-(*   Fun_hybrid *)
-(*     { body = van_der_pol_record (); *)
-(*       assertions = *)
-(*         [Fun_hybrid { body = *)
-(*                         van_der_pol_prop_record (); *)
-(*                       assertions = [] }] } *)