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

BIN
exm/zelus/ballcos/ball.zci Normal file
View file

Binary file not shown.

41
exm/zelus/ballcos/ball.zls Normal file
View file

@ -0,0 +1,41 @@
(* Ball rolling on a cosine curve. *)
(* Illustrates the impact of an observer on the simulation. *)
let g = 9.81
let mu = 0.5 (* Friction coefficient. *)
let hybrid ball(v0) = (x, v) where
rec der x = v init 0.0
and der v = a *. (cos x) init v0
and a = g *. (sin x) -. mu *. v /. (cos x)
let hybrid vdp_c(mu) = (x, y) where
rec der x = y init 1.0
and der y = (mu *. (1.0 -. (x *. x)) *. y) -. x init 1.0
let hybrid print(p)(t, x, v, x', y) = () where
present(period(p)) -> do
() = print_endline(String.concat ",\t\t" (List.map string_of_float [t;x;v;x';y]))
done
(* Changing the period for [print] changes the result. *)
let hybrid main () = () where
rec der t = 1.0 init 0.0
and (x, v) = ball(2.953)
and (x', y) = vdp_c(0.5)
and () = print(0.5)(t, x, v, x', y)
(*
let input _ = 2.953
let node print_discrete (now, (x, v)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;v]))
let ball_discrete = Solve.solve_sundials(ball)
let node main_discrete () =
let input = Some (Solve.make(30.0, input)) fby None in
let o = run ball_discrete input in
Solve.period'_t 1.0 print_discrete o
*)

17
exm/zelus/ballcos/dune Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets ball.ml ball.zci)
(deps
(:zl ball.zls)
(:zli solve.zli))
(action
(run zeluc %{zli} %{zl})))
(executable
(public_name ballcos.exe)
(name main)
(libraries std))

4
exm/zelus/ballcos/main.ml Normal file
View file

@ -0,0 +1,4 @@
open Std
let () = Runtime.go_discrete ignore Ball.main_discrete ignore

27
exm/zelus/ballcos/solve.zli Normal file
View file

@ -0,0 +1,27 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val sustain : 'a -> 'a value
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

172
exm/zelus/ballcos/tmp/ball.ml Normal file
View file

@ -0,0 +1,172 @@
(* The Zelus compiler, version 2.2-dev
(2025-08-14-22:1) *)
open Ztypes
let g = 9.81
let mu = 0.5
type ('d , 'c , 'b , 'a) _ball =
{ mutable major_68 : 'd ;
mutable i_72 : 'c ; mutable x_71 : 'b ; mutable v_70 : 'a }
let ball (cstate_97:Ztypes.cstate) =
let ball_alloc _ =
cstate_97.cmax <- (+) cstate_97.cmax 2;
{ major_68 = false ;
i_72 = (false:bool) ;
x_71 = { pos = 42.; der = 0. } ; v_70 = { pos = 42.; der = 0. } } in
let ball_step self ((time_67:float) , (v0_66:float)) =
((let (cindex_98:int) = cstate_97.cindex in
let cpos_100 = ref (cindex_98:int) in
cstate_97.cindex <- (+) cstate_97.cindex 2 ;
self.major_68 <- cstate_97.major ;
(if cstate_97.major then
for i_1 = cindex_98 to 1 do Zls.set cstate_97.dvec i_1 0. done
else ((self.x_71.pos <- Zls.get cstate_97.cvec !cpos_100 ;
cpos_100 := (+) !cpos_100 1) ;
(self.v_70.pos <- Zls.get cstate_97.cvec !cpos_100 ;
cpos_100 := (+) !cpos_100 1))) ;
(let (result_102:(float * float)) =
(if self.i_72 then self.v_70.pos <- v0_66) ;
self.i_72 <- false ;
(let (a_69:float) =
(-.) (( *. ) g (sin self.x_71.pos))
((/.) (( *. ) mu self.v_70.pos) (cos self.x_71.pos)) in
self.v_70.der <- ( *. ) a_69 (cos self.x_71.pos) ;
self.x_71.der <- self.v_70.pos ; (self.x_71.pos , self.v_70.pos)) in
cpos_100 := cindex_98 ;
(if cstate_97.major then
(((Zls.set cstate_97.cvec !cpos_100 self.x_71.pos ;
cpos_100 := (+) !cpos_100 1) ;
(Zls.set cstate_97.cvec !cpos_100 self.v_70.pos ;
cpos_100 := (+) !cpos_100 1)))
else (((Zls.set cstate_97.dvec !cpos_100 self.x_71.der ;
cpos_100 := (+) !cpos_100 1) ;
(Zls.set cstate_97.dvec !cpos_100 self.v_70.der ;
cpos_100 := (+) !cpos_100 1)))) ; result_102)):float * float) in
let ball_reset self =
((self.i_72 <- true ; self.x_71.pos <- 0.):unit) in
Node { alloc = ball_alloc; step = ball_step ; reset = ball_reset }
type ('c , 'b , 'a) _vdp_c =
{ mutable major_75 : 'c ; mutable y_77 : 'b ; mutable x_76 : 'a }
let vdp_c (cstate_103:Ztypes.cstate) =
let vdp_c_alloc _ =
cstate_103.cmax <- (+) cstate_103.cmax 2;
{ major_75 = false ;
y_77 = { pos = 42.; der = 0. } ; x_76 = { pos = 42.; der = 0. } } in
let vdp_c_step self ((time_74:float) , (mu_73:float)) =
((let (cindex_104:int) = cstate_103.cindex in
let cpos_106 = ref (cindex_104:int) in
cstate_103.cindex <- (+) cstate_103.cindex 2 ;
self.major_75 <- cstate_103.major ;
(if cstate_103.major then
for i_1 = cindex_104 to 1 do Zls.set cstate_103.dvec i_1 0. done
else ((self.y_77.pos <- Zls.get cstate_103.cvec !cpos_106 ;
cpos_106 := (+) !cpos_106 1) ;
(self.x_76.pos <- Zls.get cstate_103.cvec !cpos_106 ;
cpos_106 := (+) !cpos_106 1))) ;
(let (result_108:(float * float)) =
self.y_77.der <- (-.) (( *. ) (( *. ) mu_73
((-.) 1.
(( *. ) self.x_76.pos
self.x_76.pos)))
self.y_77.pos) self.x_76.pos ;
self.x_76.der <- self.y_77.pos ; (self.x_76.pos , self.y_77.pos) in
cpos_106 := cindex_104 ;
(if cstate_103.major then
(((Zls.set cstate_103.cvec !cpos_106 self.y_77.pos ;
cpos_106 := (+) !cpos_106 1) ;
(Zls.set cstate_103.cvec !cpos_106 self.x_76.pos ;
cpos_106 := (+) !cpos_106 1)))
else (((Zls.set cstate_103.dvec !cpos_106 self.y_77.der ;
cpos_106 := (+) !cpos_106 1) ;
(Zls.set cstate_103.dvec !cpos_106 self.x_76.der ;
cpos_106 := (+) !cpos_106 1)))) ; result_108)):float * float) in
let vdp_c_reset self =
((self.y_77.pos <- 1. ; self.x_76.pos <- 1.):unit) in
Node { alloc = vdp_c_alloc; step = vdp_c_step ; reset = vdp_c_reset }
type ('g , 'f , 'e , 'd , 'c , 'b , 'a) _main =
{ mutable i_96 : 'g ;
mutable i_95 : 'f ;
mutable major_79 : 'e ;
mutable h_94 : 'd ;
mutable i_92 : 'c ; mutable h_90 : 'b ; mutable t_80 : 'a }
let main (cstate_109:Ztypes.cstate) =
let Node { alloc = i_96_alloc; step = i_96_step ; reset = i_96_reset } = ball
cstate_109 in
let Node { alloc = i_95_alloc; step = i_95_step ; reset = i_95_reset } = vdp_c
cstate_109 in
let main_alloc _ =
cstate_109.cmax <- (+) cstate_109.cmax 1;
{ major_79 = false ;
h_94 = 42. ;
i_92 = (false:bool) ;
h_90 = (42.:float) ; t_80 = { pos = 42.; der = 0. };
i_96 = i_96_alloc () (* continuous *) ;
i_95 = i_95_alloc () (* continuous *) } in
let main_step self ((time_78:float) , ()) =
((let (cindex_110:int) = cstate_109.cindex in
let cpos_112 = ref (cindex_110:int) in
cstate_109.cindex <- (+) cstate_109.cindex 1 ;
self.major_79 <- cstate_109.major ;
(if cstate_109.major then
for i_1 = cindex_110 to 0 do Zls.set cstate_109.dvec i_1 0. done
else ((self.t_80.pos <- Zls.get cstate_109.cvec !cpos_112 ;
cpos_112 := (+) !cpos_112 1))) ;
(let (result_114:unit) =
let h_93 = ref (infinity:float) in
(if self.i_92 then self.h_90 <- (+.) time_78 0.) ;
(let (z_91:bool) = (&&) self.major_79 ((>=) time_78 self.h_90) in
self.h_90 <- (if z_91 then (+.) self.h_90 0.01 else self.h_90) ;
h_93 := min !h_93 self.h_90 ;
self.h_94 <- !h_93 ;
self.i_92 <- false ;
(let ((x_82:float) , (v_81:float)) =
i_96_step self.i_96 (time_78 , 2.953) in
let ((x'_83:float) , (y_84:float)) =
i_95_step self.i_95 (time_78 , 0.0000000000000001) in
(begin match z_91 with
| true ->
let () =
print_endline (String.concat ",\t\t"
(List.map string_of_float
((::)
(
self.t_80.pos
,
(
(::)
(
x_82 ,
(
(::)
(
v_81 ,
(
(::)
(
x'_83 ,
(
(::)
(
y_84 ,
([]))))))))))))) in
() | _ -> () end) ; self.t_80.der <- 1. ; ())) in
cstate_109.horizon <- min cstate_109.horizon self.h_94 ;
cpos_112 := cindex_110 ;
(if cstate_109.major then
(((Zls.set cstate_109.cvec !cpos_112 self.t_80.pos ;
cpos_112 := (+) !cpos_112 1)))
else (((Zls.set cstate_109.dvec !cpos_112 self.t_80.der ;
cpos_112 := (+) !cpos_112 1)))) ; result_114)):unit) in
let main_reset self =
((self.i_92 <- true ;
self.t_80.pos <- 0. ; i_96_reset self.i_96 ; i_95_reset self.i_95 ):
unit) in
Node { alloc = main_alloc; step = main_step ; reset = main_reset }

8
exm/zelus/ballcos/tmp/dune Normal file
View file

@ -0,0 +1,8 @@
(env
(dev
(flags
(:standard -w -a))))
(executable
(name main_b)
(libraries zelus))

31
exm/zelus/ballcos/tmp/main_b.ml Normal file
View file

@ -0,0 +1,31 @@
open Ztypes
open Zls
(* simulation (continuous) function *)
let main =
let cstate =
{ dvec = cmake 0; cvec = cmake 0; zinvec = zmake 0; zoutvec = cmake 0;
cindex = 0; zindex = 0; cend = 0; zend = 0; cmax = 0; zmax = 0;
major = false; horizon = 0.0 } in
let Node { alloc = alloc; step = hstep; reset = reset } = Ball.main cstate in
let step mem cvec dvec zin t =
cstate.major <- true; cstate.cvec <- cvec; cstate.dvec <- dvec;
cstate.cindex <- 0; cstate.zindex <- 0; cstate.horizon <- infinity;
hstep mem (t, ()) in
let derivative mem cvec dvec zin zout t =
cstate.major <- false; cstate.cvec <- cvec; cstate.dvec <- dvec;
cstate.zinvec <- zin; cstate.zoutvec <- zout; cstate.cindex <- 0;
cstate.zindex <- 0; ignore (hstep mem (t, ())) in
let crossings mem cvec zin zout t =
cstate.major <- false; cstate.cvec <- cvec; cstate.zinvec <- zin;
cstate.zoutvec <- zout; cstate.cindex <- 0; cstate.zindex <- 0;
ignore (hstep mem (t, ())) in
let maxsize mem = cstate.cmax, cstate.zmax in
let csize mem = cstate.cend in
let zsize mem = cstate.zend in
let horizon mem = cstate.horizon in
Hsim { alloc; step; reset; derivative; crossings; maxsize; csize; zsize;
horizon };;
(* instantiate a numeric solver *)
module Runtime = Zlsrun.Make (Defaultsolver)
let _ = Runtime.go main

16
exm/zelus/ballcos/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end

28
exm/zelus/brusselator/brusselator.zls Normal file
View file

@ -0,0 +1,28 @@
(* The Brusselator. *)
let hybrid brusselator(a, b) = (x, y) where
rec der x = a +. x *. x *. y -. b *. x -. x init 1.0
and der y = b *. x -. x *. x *. y init 1.0
let pi = 3.141592653589793
(* Add another oscillator. *)
let hybrid harmonic(p) = x where
rec der x = v init 1.0
and der v = -2.0 *. pi *. x /. p init 0.0
(* Putting the harmonic besides the brusselator changes the output of the first.
To visualize:
dune exec ./run.exe -- -speedup 1000 -maxstep 1.0 | feedgnuplot --stream --domain --lines
*)
let hybrid print(t, x) =
present (period (100.0)) ->
(print_endline (String.concat " " (List.map string_of_float [t; x])))
else ()
let hybrid simu() =
let der t = 1.0 init 0.0 in
let (x, y) = brusselator(1.0, 2.001) in
let z = harmonic(1e-5) in
print(t, x)

17
exm/zelus/brusselator/dune.bak Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets brusselator.ml)
(deps
(:zl brusselator.zls))
(action
(run zeluc %{zl})))
(executable
(name main)
(public_name brusselator.exe)
(libraries std)
(promote (until-clean)))

6
exm/zelus/brusselator/main.ml Normal file
View file

@ -0,0 +1,6 @@
open Std
let input _ = ()
let output (_, ()) = ()
let () = Runtime.go input Brusselator.simu output

17
exm/zelus/odes/dune Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets odes.ml odes.zci)
(deps
(:zl odes.zls)
(:zli solve.zli))
(action
(run zeluc %{zli} %{zl})))
(executable
(public_name odes.exe)
(name main)
(libraries std))

9
exm/zelus/odes/main.ml Normal file
View file

@ -0,0 +1,9 @@
open Std
let input _ = ()
let output () = ()
let () = Runtime.go_discrete input Odes.main output

37
exm/zelus/odes/odes.zls Normal file
View file

@ -0,0 +1,37 @@
let hybrid vdp mu () = (x, y) where
rec der x = y init 1.0
and der y = (mu *. (1.0 -. (x *. x)) *. y) -. x init 1.0
let hybrid sincos () = (sin, cos) where
rec der sin = cos init 0.0
and der cos = -. sin init 1.0
let hybrid both () = (x, y, s, c) where
(x, y) = vdp 5.0 ()
and (s, c) = sincos ()
let vdp_d = Solve.solve_sundials (vdp 5.0)
let sincos_d = Solve.solve_sundials sincos
let both_d = Solve.solve_sundials both
let main_d = Solve.synchr sincos_d both_d
let node print_vdp (now, (x, y)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;y]))
let node print_sincos (now, (s, c)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;s;c]))
let node print_both (now, (x, y, s, c)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;y;s;c]))
let node print_main (now, ((s1, c1), (x, y, s2, c2))) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;y]))
let input _ = ()
let node main () =
let i = Some (Solve.make(1000.0, input)) fby None in
let o = run main_d i in
Solve.period'_t 0.01 print_main o

26
exm/zelus/odes/solve.zli Normal file
View file

@ -0,0 +1,26 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

16
exm/zelus/odes/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end

12
exm/zelus/parallel/dune Normal file
View file

@ -0,0 +1,12 @@
(env (dev (flags (:standard -w -a))))
(rule
(targets main.ml parallel.ml parallel.zci)
(deps (:zl parallel.zls) (:zli solve.zli))
(action
(run zeluc -deps -s main %{zli} %{zl})))
(executable
(public_name parallel.exe)
(name main)
(libraries std))

34
exm/zelus/parallel/parallel.zls Normal file
View file

@ -0,0 +1,34 @@
(* Parallel simulation of harmonic oscillators. *)
(* Illustrates the impact of unrelated parallel simulation. *)
let pi = 3.141592653589793
let hybrid harmonic(p) = x where
rec der x = v init 1.0
and der v = -2.0 *. pi *. x /. p init 0.0
let hybrid f () = (t, x, y) where
rec der t = 1.0 init 0.0
and x = harmonic(100.0)
and y = harmonic(1000.0)
let hybrid main' () =
let t, x, y = f () in
present (period (0.001)) ->
print_endline (String.concat ",\t" (List.map string_of_float [t;x;y]))
else ()
let hybrid f' () = harmonic(100.0)
let hybrid g' () = (harmonic(100.0), harmonic(1e-3))
let f_d = Solve.solve_sundials(f')
let g_d = Solve.solve_sundials(g')
let m = Solve.synchr f_d g_d
let node print (now, (xf, (xg, _))) =
print_endline (String.concat ",\t" (List.map string_of_float [now;xf;xg]))
let input _ = ()
let node main () =
let input = Some (Solve.make (100.0, input)) fby None in
Solve.period'_t 0.01 print (run m input)

27
exm/zelus/parallel/solve.zli Normal file
View file

@ -0,0 +1,27 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val sustain : 'a -> 'a value
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

16
exm/zelus/parallel/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end

8
exm/zelus/sincos/main.ml
View file

@ -1,6 +1,10 @@
open Std
(* let input _ = () *)
(* let output (now, (sin, cos)) = Format.printf "%.10e\t%.10e\t%.10e\n" now sin cos *)
(* let () = Runtime.go input Sincosz.g output *)
let input _ = ()
let output (now, (sin, cos)) = Format.printf "%.10e\t%.10e\t%.10e\n" now sin cos
let () = Runtime.go input Sincosz.g output
let output (now, sin, cos) = Format.printf "%.10e,%.10e,%.10e\n" now sin cos
let () = Runtime.go_discrete input Sincosz.sincos output

12
exm/zelus/sincos/sincosz.zls
View file

@ -1,4 +1,4 @@
(*
let hybrid g () = (sin, cos) where
rec der sin = cos init 0.0
and der cos = -. sin init 1.0
@ -15,3 +15,13 @@ let hybrid f () =
print_float cos;
print_newline ()
); ()
*)
let h = 0.01
let node integr(x0, x') = (x) where
rec x = x0 -> pre(x +. x' *. h)
let node sincos() = (now, sin, cos) where
rec sin = integr(0.0, cos)
and cos = integr(1.0, -. sin)
and now = integr(0.0, 1.0)

44
exm/zelus/solve/time.zls
View file

@ -3,6 +3,16 @@ let epsilon = 0.0001
let input _ = ()
let time t = t
let hybrid fsin t = s where der s = cos t init 0.0
let hybrid fcos t = c where der c = -. (sin t) init 1.0
let hybrid fboth t = (s, c) where (s, c) = (fsin t, fcos t)
let fsind = Solve.solve_sundials(fsin)
let fcosd = Solve.solve_sundials(fcos)
let fbothd = Solve.solve_sundials(fboth)
let hybrid sincos() =
let rec der sin = cos init 0.0
and der cos = -. sin init 1.0
@ -22,38 +32,36 @@ let ball_ode45 = Solve.solve_ode45(ball)
let ball_sundials = Solve.solve_sundials(ball)
let ball_both = Solve.synchr(ball_ode45)(ball_sundials)
let node print_ball_both (now, (y1, y2)) =
print_float(now); print_string("\t");
print_float(y1); print_string("\t");
print_float(y2); print_string("\n");
()
let node print1 (now, v) =
print_float(now); print_string "\t";
print_float v; print_string "\n"
let node print_sincos (now, (sin, cos)) =
let node print2 (now, (l, r)) =
print_float now; print_string "\t";
print_float sin; print_string "\t";
print_float cos; print_string "\n"
print_float l; print_string "\t";
print_float r; print_string "\n"
let node print_sincos2 (now, ((sin1, cos1), (sin2, cos2))) =
let node print22 (now, ((ll, rl), (lr, rr))) =
print_float now; print_string "\t";
print_float sin1; print_string "\t";
print_float sin2; print_string "\t";
print_float cos1; print_string "\t";
print_float cos2; print_string "\n"
print_float ll; print_string "\t";
print_float lr; print_string "\t";
print_float rl; print_string "\t";
print_float rr; print_string "\n"
let node check_sincos (now, (sin, cos)) =
print_sincos (now, (sin, cos));
print2 (now, (sin, cos));
sin <= 1.0 +. epsilon && sin >= -1.0 -. epsilon &&
cos <= 1.0 +. epsilon && cos >= -1.0 -. epsilon
let node check_sincos2 (now, ((sin1, cos1), (sin2, cos2))) =
print_sincos2 (now, ((sin1, cos1), (sin2, cos2)));
print22 (now, ((sin1, cos1), (sin2, cos2)));
sin1 <= 1.0 +. epsilon && sin1 >= -1.0 -. epsilon &&
cos1 <= 1.0 +. epsilon && cos1 >= -1.0 -. epsilon &&
sin2 <= 1.0 +. epsilon && sin2 >= -1.0 -. epsilon &&
cos2 <= 1.0 +. epsilon && cos2 >= -1.0 -. epsilon
let node main() =
let input = Some (Solve.make (30.0, input)) fby None in
let o = run sincos_sundials input in
Solve.check_t 100 check_sincos o
let input = Some (Solve.make (100.0, time)) fby None in
let o = run fbothd input in
Solve.iter_t 100 print2 o

17
exm/zelus/vdp/dune Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets main.ml vdp.ml vdp.zci)
(deps
(:zl vdp.zls)
(:zli solve.zli))
(action
(run zeluc -deps -s main_d -o main %{zli} %{zl})))
(executable
(public_name vdp.exe)
(name main)
(libraries std))

27
exm/zelus/vdp/solve.zli Normal file
View file

@ -0,0 +1,27 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val sustain : 'a -> 'a value
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

54
exm/zelus/vdp/vdp.zls Normal file
View file

@ -0,0 +1,54 @@
let mu = 5.0
let hybrid vdp_c() = (x, y) where
rec der x = y init 1.0
and der y = (mu *. (1.0 -. (x *. x)) *. y) -. x init 1.0
let node forward(h)(x0, x') = x where
rec x = x0 fby (x +. h *. x')
let node backward(h)(x0, x') = x where
rec x = x0 -> pre x +. h *. x'
let node vdp_d(h)() = (x, y) where
rec x = backward(h)(1.0, y)
and y = forward(h)(1.0, (mu *. (1.0 -. (x *. x)) *. y) -. x)
let stop_time = 50.0
let node print (t, (x, y)) =
print_endline (String.concat ",\t" (List.map string_of_float [t;x;y]))
let node main_d() =
let rec t = 0.0 -> pre t +. 0.001 in
print(t, vdp_d(0.001)())
let node main_dc() =
let rec (t0, (x0, y0)) = ((0.0 -> pre t0 +. 0.1), vdp_d(0.1)()) in
let rec (t1, (x1, y1)) = ((0.0 -> pre t1 +. 0.2), vdp_d(0.2)()) in
let rec (t2, (x2, y2)) = ((0.0 -> pre t2 +. 0.3), vdp_d(0.3)()) in
let rec (t3, (x3, y3)) = ((0.0 -> pre t3 +. 0.4), vdp_d(0.4)()) in
let rec (t4, (x4, y4)) = ((0.0 -> pre t4 +. 0.5), vdp_d(0.5)()) in
let rec (t5, (x5, y5)) = ((0.0 -> pre t5 +. 0.6), vdp_d(0.6)()) in
let rec (t6, (x6, y6)) = ((0.0 -> pre t6 +. 0.7), vdp_d(0.7)()) in
let rec (t7, (x7, y7)) = ((0.0 -> pre t7 +. 0.8), vdp_d(0.8)()) in
let rec (t8, (x8, y8)) = ((0.0 -> pre t8 +. 0.9), vdp_d(0.9)()) in
let rec (t9, (x9, y9)) = ((0.0 -> pre t9 +. 1.0), vdp_d(1.0)()) in
print_endline (String.concat "\t" [string_of_float t0; "x0"; string_of_float x0; "y0"; string_of_float y0]);
print_endline (String.concat "\t" [string_of_float t1; "x1"; string_of_float x1; "y1"; string_of_float y1]);
print_endline (String.concat "\t" [string_of_float t2; "x2"; string_of_float x2; "y2"; string_of_float y2]);
print_endline (String.concat "\t" [string_of_float t3; "x3"; string_of_float x3; "y3"; string_of_float y3]);
print_endline (String.concat "\t" [string_of_float t4; "x4"; string_of_float x4; "y4"; string_of_float y4]);
print_endline (String.concat "\t" [string_of_float t5; "x5"; string_of_float x5; "y5"; string_of_float y5]);
print_endline (String.concat "\t" [string_of_float t6; "x6"; string_of_float x6; "y6"; string_of_float y6]);
print_endline (String.concat "\t" [string_of_float t7; "x7"; string_of_float x7; "y7"; string_of_float y7]);
print_endline (String.concat "\t" [string_of_float t8; "x8"; string_of_float x8; "y8"; string_of_float y8]);
print_endline (String.concat "\t" [string_of_float t9; "x9"; string_of_float x9; "y9"; string_of_float y9])
let input _ = ()
let vdp_s = Solve.solve_sundials vdp_c
let node main_c() =
let o = run vdp_s (Some (Solve.make(stop_time, input)) fby None) in
Solve.period'_t 1.0 print o

16
exm/zelus/vdp/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end