feat: runtime as library

exm/builtins/sin1x_der.ml

@@ -0,0 +1,79 @@
+
+(* Example due to JB. Jeannin - zero-crossing detection. *)
+
+(* The same as [sin1x.ml] but with an integrator.
+
+   d(t . (sin(1/t))^2))/dt = sin(1/t)(sin(1/t) - (2 . cos(1/t)) / t)
+
+   d(sin(f(x)))/dx = cos(f(x)) f'(x) *)
+
+open Hsim.Types
+open Solvers.Zls
+
+(* let hybrid sin_1_x() =
+     let der t0 = 1.0 init 0.0 in
+     let d = 0.6 in
+     let t = t0 -. d in
+     let der o = sin(1.0 /. t) *. (sin(1.0 /. t) -. (2.0 *. cos(1.0 /. t)) /. t)
+         init (-. d *. (sin(1.0 /. (-. d))) ** 2.0) in
+     present up(o) -> 1.0 else 0.0, o *)
+
+let of_array a = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
+
+type ('a, 'b) state = { s_x: 'a; zin: 'b }
+
+let d = 0.66
+let y0 = -. d *. let v = (sin(1.0 /. (-. d))) in v *. v
+let csize = 2
+let zsize = 1
+
+let fder d y yd =
+  yd.{0} <- 1.0;
+  let t = y.{0} -. d in
+  yd.{1} <- sin(1.0 /. t) *. (sin(1.0 /. t) -. (2.0 *. cos(1.0 /. t)) /. t)
+
+let fzer z y zout =
+  let o = y.{1} in
+  zout.{0} <- if z then o else 1.0
+
+let fout s y =
+  let z = if s.zin.{0} = 1l then 1.0 else 0.0 in
+  let o = y.{1} in
+  of_array [| z; o |]
+
+let step ({ s_x; zin } as s) zfalse =
+  let z = if zin.{0} = 1l then 1.0 else -1.0 in
+  let o = s_x.{1} in
+  of_array [| z; o |], { s with zin = zfalse }
+
+let reset _ s = s
+
+let cget { s_x; _ } = s_x
+let cset s l_x = { s with s_x = l_x }
+let zset s zin = { s with zin }
+let horizon _ = max_float
+let jump _ = true
+
+let sin_1_x z d =
+  let zfalse = zmake 1 in
+  let yd     = cmake 2 in
+  let zout   = cmake 1 in
+  let fder _ _ _ y = fder d y yd; yd in
+  let fzer _ _ _ y = fzer z y zout; zout in
+  let fout s _ _ y = fout s y in
+  let step s _  _ = step s zfalse in
+  let state = { s_x = of_array [| 0.0; y0 |]; zin = zfalse } in
+  { state; fder; fzer; fout; step; horizon;
+    cset; cget; zset; csize; zsize; reset; jump }
+
+let errmsg_many    = "Too many arguments to model (needed: [bool, float])"
+let errmsg_few     = "Too few arguments to model (needed: [bool, float])"
+let errmsg_invalid = "Invalid arguments to model (needed: [bool, float])"
+
+let init = function
+  | [zer; d] ->
+      let zer, d = try bool_of_string zer, float_of_string d
+      with _ -> raise (Invalid_argument errmsg_invalid) in
+      HNode (sin_1_x zer d)
+  | [] | [_] -> raise (Invalid_argument errmsg_few)
+  | _  -> raise (Invalid_argument errmsg_many)