feat: runtime as library

exm/builtins/ball.ml

@@ -0,0 +1,58 @@
+
+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
+     and der x  = x' init x0
+     and der x' = .0 init x'0 *)
+
+let of_array = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout
+
+type state =
+  { zin : zarray;
+    lx  : carray; (* [h';h;x';x] *)
+    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 zsize = 1
+let csize = 4
+
+let fder y yd =
+  if true (* y.{1} >= 0.0 *) then
+    begin yd.{0} <- g; yd.{1} <- y.{0}; yd.{2} <- 0.0; yd.{3} <- y.{2} end
+  else begin yd.{0} <- 0.0; yd.{1} <- 0.0; yd.{2} <- 0.0; yd.{3} <- 0.0 end;
+  yd
+let fzer y zo  = zo.{0} <- -. y.{1}; zo
+let fout _ _ _ y = of_array [| y.{1}; y.{0} |]
+let jump _     = true
+let horizon _  = max_float
+let cget s     = s.lx
+let cset s lx  = { s with lx }
+let zset s zin = { s with zin }
+let step ({ zin; lx; _ } as s) zfalse =
+  let lx = if zin.{0} = 1l then
+    of_array [| -. 0.8 *. lx.{0}; 0.0; lx.{2}; lx.{3} |] else lx in
+  of_array [| s.lx.{1}; s.lx.{0} |], { zin=zfalse; lx; i=false }
+
+let bouncing_ball () : (_, _, _, carray, carray, carray, zarray, carray) hrec =
+  let yd         = cmake csize in
+  let zout       = cmake zsize in
+  let zfalse     = zmake 1 in
+  let fder _ _ _ y = fder y yd in
+  let fzer _ _ _  y = fzer y zout in
+  let step s _ _   = step s zfalse in
+  let state      = { zin=zfalse; lx=of_array [|y'0;y0;x'0;x0|]; i=true } in
+  let reset _ _  = state in
+  { state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset;
+    csize; zsize }
+
+let errmsg = "Too many arguments for the model (needed: 0)"
+let init = function
+  | [] -> HNode (bouncing_ball ())
+  | _  -> raise (Invalid_argument errmsg)

exm/builtins/dune

@@ -0,0 +1,9 @@
+(env
+ (dev
+  (flags
+   (:standard -w -a))))
+
+(executable
+ (public_name examples.exe)
+ (name main)
+ (libraries std))

exm/builtins/main.ml

@@ -0,0 +1,93 @@
+
+open Hsim
+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 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
+let opt r s = r := Some s
+let modelargs = ref []
+
+let set_model s =
+  match !model with
+  | None   -> model := Some s
+  | Some _ -> modelargs := s :: !modelargs
+
+let opts = [
+  "-sample", Arg.Int (gt0i sample), "n \tSample count (default=10)";
+  "-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";
+  "-sundials", Arg.Set sundials, "\tUse sundials (doesn't support -accelerate)";
+  "-inplace", Arg.Set inplace, "\tUse imperative solvers";
+  "-steps", Arg.Int (gt0i steps), "n \tSplit into [n] steps (default=1)";
+  "-speed", Arg.Set speed, "\tLog the step length";
+  "-minstep", Arg.String (opt minstep), "\tSet minimum solver step length";
+  "-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";
+]
+
+let errmsg = "Usage: " ^ Sys.executable_name ^ " [OPTIONS] MODEL\nOptions are:"
+
+let () = try Arg.parse (Arg.align opts) set_model errmsg with _ -> exit 2
+
+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 s        -> Format.eprintf "Unknown model: %s\n" s; exit 2
+  with Invalid_argument s -> Format.eprintf "%s\n" s; exit 2
+
+let st = if !inplace then (module State.InPlaceSimState    : State.SimState)
+                     else (module State.FunctionalSimState : State.SimState)
+
+let output =
+  if !no_print then Hsim.Utils.ignore
+  else if !speed then Std.Output.print_h
+  else Std.Output.print (* Output.ignore *)
+
+let sim =
+  if !sundials then
+    let open StatefulSundials 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 open Sim.Sim(val st) in
+    run_until_n (output !sample (run m s))
+  else
+    let open StatefulRK45 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 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
+    run_until_n (output !sample n)
+
+let () = sim !stop !steps ignore
+

exm/builtins/model.ml

@@ -0,0 +1,7 @@
+open Hsim.Types
+open Solvers.Zls
+
+module type Model =
+  sig
+    val init : string list -> ('b, 'c, carray, carray, carray, zarray, carray) hnode
+  end

exm/builtins/sin1x.ml

@@ -0,0 +1,72 @@
+
+(* Example due to JB. Jeannin - zero-crossing detection *)
+(* the signal x(t) is expected to have a zero-crossing at [t = 0.3] *)
+
+(* to draw: ./main.exe -s sin_1_x -stop 2 -sample 10000 | feedgnuplot --stream --domain --lines *)
+
+open Hsim.Types
+open Solvers.Zls
+
+(* let hybrid sin_1_x() =
+     let der t = 1.0 init 0.0 in
+     let t = t -. 0.3 in
+     let v = sin(1/t) in
+     let o = t *. (v *. v) in [that is: t *. (sin(1/t)^2]
+     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 csize = 1
+let zsize = 1
+
+let fder _ _ yd = yd.{0} <- 1.0
+
+let fzer _ y zout =
+  let t = y.{0} in
+  let t = t -. 0.3 in
+  let v = sin(1.0 /. t) in
+  let o = t *. (v *. v) in
+  zout.{0} <- o
+
+let fout s y =
+  let z = if s.zin.{0} = 1l then 1.0 else 0.0 in
+  let t = y.{0} in
+  let t = t -. 0.3 in
+  let v = sin(1.0 /. t) in
+  let o = t *. (v *. v) in
+  of_array [| z; o |]
+
+let step ({ s_x; zin } as s) zfalse =
+  let z = if zin.{0} = 1l then 1.0 else 0.0 in
+  let t = s_x.{0} in
+  let t = t -. 0.3 in
+  let v = sin(1.0 /. t) in
+  let o = t *. (v *. v) 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 jump _ = true
+let horizon _ = max_float
+
+let sin_1_x () =
+  let zfalse = zmake 1 in
+  let yd     = cmake 1 in
+  let zout   = cmake 1 in
+  let fder _ _ _ y = fder 0.0 y yd; yd in
+  let fzer _ _ _ y = fzer 0.0 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 |]; zin = zfalse } in
+  { state; fder; fzer; fout; step; reset; horizon;
+    cset; cget; zset; csize; zsize; jump }
+
+let errmsg = "Too many arguments for the model (needed: 0)"
+let init = function
+  | [] -> HNode (sin_1_x ())
+  | _  -> raise (Invalid_argument errmsg)

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)

exm/builtins/sincos.ml

@@ -0,0 +1,46 @@
+
+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 csize = 3
+let zsize = 1
+
+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
+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 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 state      = { sx=of_array [| sin0; cos0; 0.0 |]; si=true } in
+  let reset _ _  = state in
+  HNode { state; fder; fzer; fout; step; reset; horizon;
+          jump; cset; cget; zset; csize; zsize }
+
+let errmsg_invalid = "Invalid arguments to model (needed: [float, float])"
+let errmsg_few     = "Too few arguments to model (needed: [float, float])"
+let errmsg_many    = "Too many arguments to model (needed: [float, float])"
+let init = function
+  | [om; t0] ->
+      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/builtins/sqrt.ml

@@ -0,0 +1,79 @@
+
+open Hsim.Types
+open Solvers.Zls
+
+let of_array a = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
+
+type s = Good | Bad
+
+let with_nan = false
+
+type state =
+  { s_auto: s; (* active state of the automaton *)
+    s_pos : carray;
+    s_zin : zarray;
+    s_encore : bool }
+
+let sqrt () =
+  let zfalse = zmake 1 in
+  let fder s y yd =
+    yd.{0} <- -1.0;
+    match s.s_auto with
+    | Good ->
+        let o = if with_nan then sqrt y.{0}
+                else if y.{0} >= 0.0 then sqrt y.{0} else 0.0 in
+        yd.{1} <- o
+    | Bad ->
+        yd.{1} <- 0.0 in
+  let fzero _ y zout = zout.{0} <- -. y.{0} in
+  let fout state y =
+    let o =
+      match state.s_auto with
+      | Good -> let o =
+                  if with_nan then sqrt y.{0}
+                  else if y.{0} >= 0.0 then sqrt y.{0} else 0.0 in
+                o
+      | Bad -> let o = 42.0 in o in
+    of_array [| o; state.s_pos.{0}; state.s_pos.{1} |] in
+  let fstep ({ s_auto; s_pos; s_zin; _ } as state) _ =
+    match s_auto with
+      | Good ->
+         let o = if with_nan then sqrt s_pos.{0}
+                 else if s_pos.{0} >= 0.0 then sqrt s_pos.{0} else 0.0 in
+         let state =
+           if s_zin.{0} = 1l then { state with s_auto=Bad; s_encore=true }
+           else state in
+         let pos = of_array [| state.s_pos.{0}; state.s_pos.{1} |] in
+         of_array [| o; state.s_pos.{0}; state.s_pos.{1} |],
+         { state with s_zin=zfalse; s_pos=pos }
+    | Bad ->
+       let o = 42.0 in
+       let state = { state with s_encore=false;
+                                s_pos=of_array [| s_pos.{0}; 0.0 |] } in
+       of_array [| o; state.s_pos.{0}; state.s_pos.{1} |], state in
+  let cget { s_pos; _ } = s_pos in
+  let cset s l_x = { s with s_pos=l_x } in
+  let zset s zin = { s with s_zin=zin } in
+  let yd = cmake 2 in
+  let zout = cmake 1 in
+  let zsize = 1 in
+  let csize = 2 in
+  let s_init =
+    { s_encore = false;
+      s_auto = Good;
+      s_pos = of_array [| 13.3; 0.0 |];
+      s_zin = zmake 1 } in
+  let reset _ _ = s_init in
+  let jump _ = true in
+  HNode { state = s_init;
+    fder = (fun s _ _ y -> fder s y yd; yd);
+    fzer = (fun s _ _ y -> fzero s y zout; zout);
+    fout = (fun s _ _ y -> fout s y);
+    step = (fun s _ a -> fstep s a);
+    horizon = (fun s -> if s.s_encore then 0.0 else max_float);
+    cset; cget; zset; zsize; csize; reset; jump }
+
+let errmsg = "Too many arguments to model (needed: 0)"
+let init = function
+  | [] -> sqrt ()
+  | _  -> raise (Invalid_argument errmsg)

exm/builtins/vdp.ml

@@ -0,0 +1,45 @@
+
+open Hsim.Types
+open Solvers.Zls
+
+let of_array a : carray =
+  Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
+
+type state = { lx : carray; i : bool }
+
+let mu = 5.0
+let x0 = 1.0
+let y0 = 1.0
+
+let csize = 2
+let zsize = 1
+
+let fder y yd =
+  yd.{0} <- y.{1};
+  yd.{1} <- (mu *. (1.0 -. (y.{0} *. y.{0})) *. y.{1}) -. y.{0};
+  yd
+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 zset s _  = s
+let jump _    = true
+let horizon _ = max_float
+
+let van_der_pol () : (_, _, carray, carray, carray, zarray, carray) hnode =
+  let yd         = cmake csize in
+  let zout       = cmake zsize in
+  let fder _ _ _ y = fder y yd in
+  let fzer _ _ _ _ = zout in
+  let state      = { lx=of_array [| x0; y0 |]; i=true } in
+  let reset _ _  = state in
+  HNode { state; fder; fzer; fout; step; reset; horizon;
+          jump; cset; cget; zset; csize; zsize }
+
+let errmsg = "Too many arguments for the model (needed: 0)"
+let init = function
+  | [] -> van_der_pol ()
+  | _  -> raise (Invalid_argument errmsg)
+