{ libs: ["d3", "lwt", "js_of_ocaml-lwt"],
html_scripts: ["https://d3js.org/d3.v4.min.js"]
}
Here we go, let's try D3.
Let's make some types first of all.
open D3
open Js_of_ocaml
type twodim_point = {
i_x: float
; i_y: float }
type line = {
index: int (* starts at 0 *)
; line: twodim_point list
; highlight: bool }
type lines = line list
type paddings = {
top: float
; right: float
; left: float
; bottom: float }
open Js;;
let _ = Printf.printf "Hello, world";;
][
{%html: <script type="text/javascript">function
id_1(a){"use strict";return 0}if(typeof
module==="object"&&module.exports)module["exports"]=id_1;
</script> %}
Now we need to do some bindings for things that the library doesn't do yet.
module D3_libs = struct
let d3 () = Unsafe.global##.d3
let get_line () = (d3 ())##line
let get_scale s = match s with
| `scaleLinear -> (d3 ())##scaleLinear ()
let get_curve c = match c with
| `curveBasis -> fun x -> (d3 ())##curveBasis x
| `curveLinear -> fun x -> (d3 ())##curveLinear x
let get_axis c = match c with
| `Bottom -> fun x -> (d3 ())##axisBottom x
| `Left -> fun x -> (d3 ())##axisLeft x
end;;
][
{%html: <script type="text/javascript">function
id_2(j){"use strict";var
l=j.jsoo_runtime;function
n(j,a,k){return l.caml_stack_check_depth()?j(a,k):l.caml_trampoline_return(j,[a,k],0)}var
m=0,a=l.caml_get_global_data(),o=a.Js_of_ocaml__Js;function
k(j,a){return a(o[52][1].d3)}return l.caml_callback(a.Toploop[2],["D3_libs/970",[0,k,function(j,a){return n(k,m,function(j){return a(l.caml_js_meth_call(j,"line",[0]))})},function(j,a){var
o=0;return n(k,m,function(j){return a(l.caml_js_meth_call(j,"scaleLinear",l.caml_make_array([0,o])))})},function(j,a){return 234504180<=j?a(function(o,a){return n(k,m,function(j){return a(l.caml_js_meth_call(j,"curveLinear",l.caml_make_array([0,o])))})}):a(function(o,a){return n(k,m,function(j){return a(l.caml_js_meth_call(j,"curveBasis",l.caml_make_array([0,o])))})})},function(j,a){return 847852583<=j?a(function(o,a){return n(k,m,function(j){return a(l.caml_js_meth_call(j,"axisLeft",l.caml_make_array([0,o])))})}):a(function(o,a){return n(k,m,function(j){return a(l.caml_js_meth_call(j,"axisBottom",l.caml_make_array([0,o])))})})}]])}if(typeof
module==="object"&&module.exports)module["exports"]=id_2;
</script> %}
Some class types to make our lives easier:
module Line = struct
class type data_point = object
method x : float readonly_prop
method y : float readonly_prop
end
type scaleU
class type scale = object
method range : float js_array t -> scale t meth
method domain : float js_array t -> scaleU t meth
end
class type axis = object
method scale : scale t -> axis t meth
method tickSize : int -> axis t meth
method tickSubdivide : bool -> axis t meth
end
class type line = object
method x : (line t, data_point t -> int -> float) meth_callback
-> line t meth
method y : (line t, data_point t -> int -> float) meth_callback
-> line t meth
method curve : (line t, 'a) meth_callback -> line t meth
end
end;;
][
{%html: <script type="text/javascript">function
id_3(a){"use strict";var
b=a.jsoo_runtime;return b.caml_callback(b.caml_get_global_data().Toploop[2],["Line/984",[0]])}if(typeof
module==="object"&&module.exports)module["exports"]=id_3;
</script> %}
Now we want to deal with some interactivity. Let's define an event type for highlighting specific lines in the chart.
module Event = struct
type t =
| Highlight of int
| NoHighlight
let highlight (m:lines) i =
List.map
(fun l -> let highlight = l.index = i in { l with highlight })
m
let handle t m : lines = match t with
| Highlight i -> highlight m i
| NoHighlight -> highlight m (-1)
end;;
][
{%html: <script type="text/javascript">function
id_4(d){"use strict";var
g=d.jsoo_runtime;function
i(d,b,e,f){return g.caml_stack_check_depth()?(d.l>=0?d.l:d.l=d.length)===3?d(b,e,f):g.caml_call_gen(d,[b,e,f]):g.caml_trampoline_return(d,[b,e,f],0)}function
h(d,b,e,f){return g.caml_stack_check_depth()?d(b,e,f):g.caml_trampoline_return(d,[b,e,f],0)}var
b=g.caml_get_global_data(),a=b.Stdlib__List;function
f(d,f,e){return i(a[20],function(d,b){return b([0,d[1],d[2],d[1]===f?1:0])},d,e)}return g.caml_callback(b.Toploop[2],["Event/1065",[0,f,function(d,b,e){return d?h(f,b,d[1],e):h(f,b,-1,e)}]])}if(typeof
module==="object"&&module.exports)module["exports"]=id_4;
</script> %}
With these defined, we can now get down to the business of drawing some lines.
module View = struct
let palette_loop i =
let choices = [|
(* these colors are grouped by 2: strong tone followed by soft *)
"#1f7q8b4"; "#a6cee3"; (* blue *)
"#33a02c"; "#b2df8a"; (* green *)
"#e31a1c"; "#fb9a99"; (* red *)
"#ff7f00"; "#fdbf6f"; (* orange *)
"#6a3d9a"; "#cab2d6"; (* purple *)
|]
in
choices.(i mod 10)
let make_range ~range ~domain =
let obj = D3_libs.get_scale `scaleLinear in
ignore @@ obj##range (Js.array [| fst range; snd range |]);
ignore @@ obj##domain (Js.array [| fst domain; snd domain |]);
(fun (x:float) -> Js.Unsafe.fun_call obj [| Js.Unsafe.inject x |]), obj
let make_axis pos range_o m =
let a = (D3_libs.get_axis pos) range_o in
Js.Unsafe.fun_call a [|Js.Unsafe.inject m|]
let data_to_js (l: line) : Line.data_point t js_array t =
let curve_to_js { line=c } =
c
|> List.map
(fun (x: twodim_point) : Line.data_point t -> object%js
val x = x.i_x
val y = x.i_y
end)
|> Array.of_list
|> array
in
curve_to_js l
let line xrange yrange m: Line.line t =
let open D3_libs in
let l = get_line () in
ignore @@ l##x (fun (o:Line.data_point t) _ -> xrange o##.x);
ignore @@ l##y (fun (o:Line.data_point t) _ -> yrange o##.y);
ignore @@ l##curve (fun x -> get_curve `curveLinear x);
Js.Unsafe.fun_call l [|Js.Unsafe.inject m|]
let get_size size_ratio node =
(* take 100% of available width in [node] and relative height *)
let w = (Js.coerce node Dom_html.CoerceTo.div (fun _ -> assert false))
##.clientWidth
in
let h = int_of_float @@ (float_of_int w) *. size_ratio in
w, h
let items ~size_ratio ~node ~pad ~data_preview f =
let open D3 in
let w, h = get_size size_ratio node in
let min_max l : float*float = match l with
| [] -> 0., 100.
| a :: [] -> a, a
| a :: b -> let ls = List.fast_sort compare (a::b) in
(List.hd ls), List.hd @@ List.rev ls
in
let map_tuple f = fun (a, b) -> (f a), f b in
let xdom, ydom =
map_tuple min_max @@
List.split @@ List.map (fun { i_x; i_y } -> i_x, i_y) @@
List.flatten @@ List.map (fun { line } -> line) data_preview
in
let ydom = (min (fst ydom) 0.), snd ydom in
let xrange = 0., (float_of_int @@ w) -. pad.right -. pad.left in
let xrange, xrange_o = make_range ~range:xrange ~domain:xdom in
let yrange = ((float_of_int h) -. pad.top -. pad.bottom), 0. in
let yrange, yrange_o = make_range ~range:yrange ~domain:ydom in
let stroke_width = "3" in
selectAll "path"
|. data (fun m _ -> m)
|- nest enter [
append "path"
|. str attr "fill" "none"
|. attr "stroke" (fun _ { index } _ -> palette_loop index)
|. str attr "stroke-linejoin" "round"
|. str attr "stroke-linecap" "round"
|. str attr "stroke-width" stroke_width
|. E.mouseover (fun _ { index } _ -> f (Event.Highlight index))
|. E.mouseout (fun _ _ _ -> f (Event.NoHighlight))
|. attr_obj "d" (fun _ m _ -> line xrange yrange @@ data_to_js m)
]
|- nest enter [
static "g"
|. attr "transform" (fun _ _ _ -> Format.sprintf "translate(0,%.1f)"
((float_of_int h) -. pad.top -. pad.bottom))
|. call (fun m _ -> make_axis `Bottom xrange_o m)
]
|- nest enter [
static "g"
|. call (fun m _ -> make_axis `Left yrange_o m)
]
|- nest update [
transition
|. fun_call "duration" (fun _ _ _ -> "200")
|. style "stroke-width"
(fun _ { highlight } _ -> if highlight then "15" else stroke_width)
]
let make ~size_ratio ~node ~pad ~data_preview f =
let open D3 in
let w, h = get_size size_ratio node in
static "svg"
|. int attr "width" w
|. int attr "height" h
|. style "padding"
(fun _ _ _ -> Format.sprintf "%.1f %.1f %.1f %.1f"
pad.top pad.right pad.bottom pad.left)
|. static "g"
|- items ~size_ratio ~node ~data_preview ~pad f
end;;
][
{%html: <script type="text/javascript">function
id_5(D){"use strict";var
ab="round",_=140,aa="x",$="y",Z="path",G="g",W="stroke-width",a=D.jsoo_runtime;function
K(D,E,F){return a.caml_stack_check_depth()?(D.l>=0?D.l:D.l=D.length)===2?D(E,F):a.caml_call_gen(D,[E,F]):a.caml_trampoline_return(D,[E,F],0)}function
O(D,E,F){return a.caml_stack_check_depth()?D(E,F):a.caml_trampoline_return(D,[E,F],0)}function
J(D,E,F,G){return a.caml_stack_check_depth()?(D.l>=0?D.l:D.l=D.length)===3?D(E,F,G):a.caml_call_gen(D,[E,F,G]):a.caml_trampoline_return(D,[E,F,G],0)}function
P(D,E,F,G){return a.caml_stack_check_depth()?D(E,F,G):a.caml_trampoline_return(D,[E,F,G],0)}function
M(D,E,F,G,H){return a.caml_stack_check_depth()?(D.l>=0?D.l:D.l=D.length)===4?D(E,F,G,H):a.caml_call_gen(D,[E,F,G,H]):a.caml_trampoline_return(D,[E,F,G,H],0)}function
S(D,E,F,G,H){return a.caml_stack_check_depth()?D(E,F,G,H):a.caml_trampoline_return(D,[E,F,G,H],0)}function
aJ(D,E,F,G,H,I,J){return a.caml_stack_check_depth()?(D.l>=0?D.l:D.l=D.length)===6?D(E,F,G,H,I,J):a.caml_call_gen(D,[E,F,G,H,I,J]):a.caml_trampoline_return(D,[E,F,G,H,I,J],0)}function
aK(D,E,F,G,H,I,J){return a.caml_stack_check_depth()?D(E,F,G,H,I,J):a.caml_trampoline_return(D,[E,F,G,H,I,J],0)}var
E=a.caml_get_global_data(),X="3",I=E.Toploop,Y=E.Stdlib__Format,F=E.D3,L=E.Stdlib__List;E.CamlinternalOO;var
al=E.Stdlib,ah=E.Assert_failure,ai=E.Js_of_ocaml__Dom_html,aj=E.Js_of_ocaml__Js,af=E.Stdlib__Array,H=a.caml_callback(I[1],["D3_libs/970"]),ac=[0,"#1f7q8b4","#a6cee3","#33a02c","#b2df8a","#e31a1c","#fb9a99","#ff7f00","#fdbf6f","#6a3d9a","#cab2d6"],ad=$,ae=aa,ag=[0,"",48,60],ak=[0,0.,100.],am="15",an=W,ao="200",ap="duration",aq=G,ar=[0,[11,"translate(0,",[8,[0,0,0],0,[0,1],[12,41,0]]],"translate(0,%.1f)"],as="transform",at=G,au="d",av=W,aw=ab,ax="stroke-linecap",ay=ab,az="stroke-linejoin",aA="stroke",b="none",aB="fill",aC=Z,aD=Z,aE=G,aF=[0,[8,[0,0,0],0,[0,1],[12,32,[8,[0,0,0],0,[0,1],[12,32,[8,[0,0,0],0,[0,1],[12,32,[8,[0,0,0],0,[0,1],0]]]]]]],"%.1f %.1f %.1f %.1f"],aG="padding",d="height",aH="width",aI="svg";function
T(D,E){var
F=D%10|0;return E(a.caml_check_bound(ac.slice(),F)[1+F])}function
Q(D,E,F){return K(H[3],-660334577,function(G){a.caml_js_meth_call(G,"range",a.caml_make_array([0,a.caml_js_from_array(a.caml_make_array([0,D[1],D[2]]))]));a.caml_js_meth_call(G,"domain",a.caml_make_array([0,a.caml_js_from_array(a.caml_make_array([0,E[1],E[2]]))]));return F([0,function(D,E){return E(a.caml_js_fun_call(G,a.caml_make_array([0,D])))},G])})}function
c(D,E,F,G){return J(H[5],D,E,function(D){return G(a.caml_js_fun_call(D,a.caml_make_array([0,F])))})}function
U(D,E){return J(L[20],function(D,E){return E(a.caml_js_object([0,[0,ae,D[1]],[0,ad,D[2]]]))},D[2],function(D){return K(af[10],D,function(D){return E(a.caml_js_from_array(D))})})}function
V(L,I,F,G){return K(H[2],0,function(D){a.caml_js_meth_call(D,aa,a.caml_make_array([0,function(D,E,F){return K(L,D.x,F)}]));a.caml_js_meth_call(D,$,a.caml_make_array([0,function(D,E,F){return K(I,D.y,F)}]));a.caml_js_meth_call(D,"curve",a.caml_make_array([0,function(D,E){return J(H[4],234504180,D,E)}]));return G(a.caml_js_fun_call(D,a.caml_make_array([0,F])))})}function
R(G,E,F){return M(aj[48],E,ai[118][16],function(D,E){var
F=a.caml_pop_trap();return F(a.caml_maybe_attach_backtrace([0,ah,ag],1))},function(D){var
E=D.clientWidth;return F([0,E,a.caml_float_of_int(E)*G|0])})}function
N(D,E,N,G,H,I){a.caml_ensure_stack_capacity(40);return P(R,D,E,function(E){var
R=E[2];function
W(D,E){if(!D)return E(ak);var
F=D[1];return D[2]?J(L[61],function(D,E,F){return F(a.caml_float_compare(D,E))},[0,F,D[2]],function(F){return K(L[10],F,function(D){return K(L[6],D,function(G){return K(L[6],F,function(D){return E([0,D,G])})})})}):E([0,F,F])}return J(L[20],function(D,E){return E(D[2])},G,function(D){return K(L[15],D,function(D){return J(L[20],function(D,E){return E([0,D[1],D[2]])},D,function(D){return K(L[57],D,function(G){return O(W,G[2],function(D){return O(W,G[1],function(G){var
L=D[2];return J(al[16],D[1],0.,function(D){var
Z=N[3],$=N[2],W=[0,D,L];return P(Q,[0,0.,a.caml_float_of_int(E[1])-$-Z],G,function(D){var
G=D[2],L=D[1],E=N[4],Z=N[1];return P(Q,[0,a.caml_float_of_int(R)-Z-E,0.],W,function(D){var
P=D[2],Q=D[1],E=0;return J(F[6],an,function(D,E,F,G){return E[3]?G(am):G(X)},function(W){return J(F[33],ap,function(D,E,F,G){return G(ao)},function(D){return J(F[23],F[32],D,function(D){return J(F[23],D,W,function(D){return J(F[28],F[18],[0,D,E],function(E){var
W=0;return K(F[16],function(D,E,F){return S(c,847852583,P,D,F)},function(P){return K(F[13],aq,function(D){return J(F[23],D,P,function(D){return J(F[28],F[17],[0,D,W],function(P){var
W=0;return K(F[16],function(D,E,F){return S(c,437082891,G,D,F)},function(G){return J(F[3],as,function(D,E,F,G){var
H=N[4],I=N[1],K=a.caml_float_of_int(R)-I-H;return J(Y[_],ar,K,G)},function(a){return K(F[13],at,function(D){return J(F[23],D,a,function(D){return J(F[23],D,G,function(D){return J(F[28],F[17],[0,D,W],function(G){var
a=0;return J(F[4],au,function(D,E,F,G){return O(U,E,function(D){return S(V,L,Q,D,G)})},function(L){return K(F[34][7],function(D,E,F,G){return K(H,0,G)},function(N){return K(F[34][5],function(D,E,F,G){return K(H,[0,E[1]],G)},function(H){return M(F[29],F[3],av,X,function(Q){return M(F[29],F[3],ax,aw,function(c){return M(F[29],F[3],az,ay,function(R){return J(F[3],aA,function(D,E,F,G){return O(T,E[1],G)},function(O){return M(F[29],F[3],aB,b,function(M){return K(F[10],aC,function(D){return J(F[23],D,M,function(D){return J(F[23],D,O,function(D){return J(F[23],D,R,function(D){return J(F[23],D,c,function(D){return J(F[23],D,Q,function(D){return J(F[23],D,H,function(D){return J(F[23],D,N,function(D){return J(F[23],D,L,function(D){return J(F[28],F[17],[0,D,a],function(H){return K(F[14],function(D,E,F){return F(D)},function(a){return K(F[2],aD,function(D){return J(F[23],D,a,function(D){return J(F[25],D,H,function(D){return J(F[25],D,G,function(D){return J(F[25],D,P,function(D){return J(F[25],D,E,I)})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})})}return a.caml_callback(I[2],["View/2208",[0,T,Q,c,U,V,R,N,function(L,E,a,G,H,I){return P(R,L,E,function(D){return aK(N,L,E,a,G,H,function(E){return K(F[13],aE,function(G){return J(F[6],aG,function(D,E,F,G){return aJ(Y[_],aF,a[1],a[2],a[4],a[3],G)},function(H){return M(F[30],F[3],d,D[2],function(a){return M(F[30],F[3],aH,D[1],function(L){return K(F[13],aI,function(D){return J(F[23],D,L,function(D){return J(F[23],D,a,function(D){return J(F[23],D,H,function(D){return J(F[23],D,G,function(D){return J(F[25],D,E,I)})})})})})})})})})})})}]])}if(typeof
module==="object"&&module.exports)module["exports"]=id_5;
</script> %}
Let's have a function to draw:
let n_random_curves n =
let rec range debut fin tl =
if fin > debut
then range debut (fin - 1) (fin :: tl)
else debut :: tl
in
List.map
(fun i ->
{
highlight = false;
index = i-1;
line = List.map
(fun x -> {
i_x = float_of_int x;
i_y = 0.5 *. (float_of_int i) *. (float_of_int x ** 3.)
})
(range 1 100 [])
}
)
(range 1 n [])
;;
][
{%html: <script type="text/javascript">function
id_6(e){"use strict";var
a=e.jsoo_runtime;function
i(e,d,f,g){return a.caml_stack_check_depth()?(e.l>=0?e.l:e.l=e.length)===3?e(d,f,g):a.caml_call_gen(e,[d,f,g]):a.caml_trampoline_return(e,[d,f,g],0)}var
d=a.caml_get_global_data(),h=d.Stdlib__List;return a.caml_callback(d.Toploop[2],["n_random_curves",function(e,d){function
f(e,d,f){var
g=d,a=f;for(;;){if(e>=g)return[0,e,a];var
h=[0,g,a];g=g-1|0;a=h}}var
g=f(1,e,0);return i(h[20],function(g,d){var
e=f(1,100,0),j=0;return i(h[20],function(e,d){var
f=Math.pow(a.caml_float_of_int(e),3.),h=0.5*a.caml_float_of_int(g)*f;return d([254,a.caml_float_of_int(e),h])},e,function(e){return d([0,g-1|0,e,j])})},g,d)}])}if(typeof
module==="object"&&module.exports)module["exports"]=id_6;
</script> %}
And now let's draw it!
open Lwt
open Js_of_ocaml_lwt
let make_stream () =
let stream, push = Lwt_stream.create () in
stream, (fun x -> push (Some x)), (fun () -> push None)
let fold_stream ~stream ~handler ~node ~view ~data =
Lwt_stream.fold_s
(fun e m ->
let m' = handler e m in
D3.run ~node view m';
Lwt.return m')
stream data
let async_draw_update ~size_ratio ~node ~pad data () =
let stream, push, _ = make_stream () in
let view = View.make ~size_ratio ~node ~pad ~data_preview:data push in
D3.run ~node view data;
Lwt.bind (fold_stream ~handler:(Event.handle) ~node ~view ~data ~stream)
(fun _ -> Lwt.return ())
let _ =
let size_ratio = 0.5 in
let node = match (Dom_html.getElementById_opt "output-6") with
| Some d -> d
| _ -> assert false
in
let pad = {top=40.; bottom=40.; right=120.; left=150.} in
let data = n_random_curves 6 in
Lwt_js_events.async (async_draw_update ~size_ratio ~node ~pad data)
;;
][
{%html: <script type="text/javascript">function
id_7(h){"use strict";var
u=40.,t="async_draw_update",l="fold_stream",k="make_stream",n=h.jsoo_runtime;function
m(h,i,j){return n.caml_stack_check_depth()?(h.l>=0?h.l:h.l=h.length)===2?h(i,j):n.caml_call_gen(h,[i,j]):n.caml_trampoline_return(h,[i,j],0)}function
r(h,i,j,c){return n.caml_stack_check_depth()?(h.l>=0?h.l:h.l=h.length)===3?h(i,j,c):n.caml_call_gen(h,[i,j,c]):n.caml_trampoline_return(h,[i,j,c],0)}function
p(h,i,j,c,k){return n.caml_stack_check_depth()?(h.l>=0?h.l:h.l=h.length)===4?h(i,j,c,k):n.caml_call_gen(h,[i,j,c,k]):n.caml_trampoline_return(h,[i,j,c,k],0)}function
s(h,i,j,c,k,l,m){return n.caml_stack_check_depth()?(h.l>=0?h.l:h.l=h.length)===6?h(i,j,c,k,l,m):n.caml_call_gen(h,[i,j,c,k,l,m]):n.caml_trampoline_return(h,[i,j,c,k,l,m],0)}var
j=n.caml_get_global_data(),i=j.Toploop,o=j.Lwt,a=j.D3,q=j.Lwt_stream,B=j.Js_of_ocaml__Dom_html,G=j.Assert_failure,e=j.Js_of_ocaml_lwt__Lwt_js_events;n.caml_callback(i[2],[k,function(h,i){return m(q[4],0,function(h){var
j=h[2];return i([0,h[1],function(h,i){return m(j,[0,h],i)},function(h,i){return m(j,0,i)}])})}]);n.caml_callback(i[2],[l,function(h,s,n,c,k,l){return p(q[48],function(h,i,j){return r(s,h,i,function(i){return p(a[35],[0,n],c,i,function(h){return m(o[4],i,j)})})},h,k,l)}]);var
b=n.caml_callback(i[1],[l]),v=n.caml_callback(i[1],[k]),w=n.caml_callback(i[1],["View/2208"]),x=n.caml_callback(i[1],["Event/1065"]);n.caml_callback(i[2],[t,function(h,i,j,c,k,l){return m(v,0,function(k){return s(w[8],h,i,j,c,k[2],function(j){return p(a[35],[0,i],j,c,function(h){function
n(h,i){return m(o[4],0,i)}return s(b,k[1],x[2],i,j,c,function(h){return r(o[6],h,n,l)})})})})}]);var
y=n.caml_callback(i[1],[t]),z=n.caml_callback(i[1],["n_random_curves"]),c=n.caml_callback(B[3],["output-6"]),F=[0,"",27,11],D=[254,u,120.,150.,u],A=0.5;if(!c)throw n.caml_maybe_attach_backtrace([0,G,F],1);var
C=c[1],E=n.caml_callback(y,[A,C,D,n.caml_callback(z,[6])]);return n.caml_callback(e[5],[E])}if(typeof
module==="object"&&module.exports)module["exports"]=id_7;
</script> %}