├── dune-project ├── .gitignore ├── lib ├── dune ├── c3.mli └── c3.ml ├── Makefile ├── .travis.yml ├── example ├── dune ├── index.html └── main.ml ├── CHANGES.md ├── c3.opam ├── README.md └── LICENSE /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *~ 3 | _opam 4 | *.install 5 | .merlin 6 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name c3) 3 | (public_name c3) 4 | (libraries js_of_ocaml) 5 | (preprocess (pps js_of_ocaml-ppx))) 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean example 2 | 3 | all: 4 | dune build 5 | 6 | clean: 7 | dune clean 8 | 9 | example: 10 | dune build @example 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh 3 | script: bash -ex .travis-opam.sh 4 | sudo: true 5 | env: 6 | - OCAML_VERSION=4.06 PACKAGE=c3 7 | -------------------------------------------------------------------------------- /example/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries c3 lwt js_of_ocaml-lwt) 4 | (preprocess (pps js_of_ocaml-ppx))) 5 | 6 | (alias 7 | (name example) 8 | (deps main.bc.js (source_tree .)) 9 | (action (run open index.html))) 10 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 0.4.0 (30-07-2018) 2 | - Update to dune and ppx (@samoht) 3 | - Update to c3 0.6.6 (@loxs) 4 | 5 | 0.3.0 (25-06-2015) 6 | - Fix the `update` function 7 | - Use a tail recursive List.map, for larger datasets 8 | - `flow` can take a `Time t` 9 | - Can set labels on x and y axis 10 | 11 | 0.2.1 (14-06-2015) 12 | - Fix uninstall and install Makefile targets 13 | 14 | 0.2 (14-06-2015) 15 | - Add `update` to allow segments to be replaced 16 | - Rename old `update` to `flow` 17 | 18 | 0.1 (14-06-2015) 19 | - Initial release 20 | -------------------------------------------------------------------------------- /c3.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "dave@recoil.org" 3 | authors: ["Dave Scott" "Thomas Gazagnaire"] 4 | license: "ISC" 5 | homepage: "https://github.com/djs55/ocaml-c3" 6 | bug-reports: "https://github.com/djs55/ocaml-c3/issues" 7 | dev-repo: "git+https://github.com/djs55/ocaml-c3.git" 8 | doc: "https://djs55.github.io/ocaml-c3/" 9 | 10 | build: ["dune" "build" "-p" name "-j" jobs] 11 | depends: [ 12 | "ocaml" {>= "4.01.0"} 13 | "js_of_ocaml" {>= "3.4.0" } 14 | "js_of_ocaml-ppx" {>= "3.4.0" } 15 | "lwt" 16 | "cohttp" 17 | ] 18 | synopsis: "OCaml bindings for the Javascript c3 charting library." 19 | description: 20 | "If you want to write a client-side web application in OCaml with js_of_ocaml and display some charts, this library is for you." 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-c3 2 | OCaml bindings for the Javascript c3 charting library. 3 | 4 | If you want to write a client-side web application in OCaml with 5 | `js_of_ocaml` and display some charts, this library is for you. 6 | 7 | - The [C3 library](http://c3js.org/): to see the kinds of things 8 | that are possible with the Javascript C3 library 9 | - The [OCaml demo](http://djs55.github.io/ocaml-c3/index.html): 10 | to see the example from this repo. 11 | 12 | # Getting started 13 | 14 | * install all the dependencies, for example by: 15 | 16 | ``` 17 | opam pin add c3 . 18 | ``` 19 | 20 | * build the library and example site: 21 | 22 | ``` 23 | make 24 | ``` 25 | 26 | * serve the example site: 27 | 28 | ``` 29 | make example 30 | ``` 31 | 32 | View the example on http://localhost:8080/ 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Everything except the examples/c3-0.4.10/ directory is: 2 | 3 | Copyright (c) 2015, Dave Scott 4 | 5 | Permission to use, copy, modify, and/or distribute this software for any 6 | purpose with or without fee is hereby granted, provided that the above 7 | copyright notice and this permission notice appear in all copies. 8 | 9 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | 17 | -------------------------------------------------------------------------------- /example/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

Normal distribution

16 |
17 |

Multiple line types chart

18 |
19 |

Pie chart

20 |
21 |

Donut chart

22 |
23 |

Gauge

24 |
25 |

XY chart

26 |
27 |

XY spline chart

28 |
29 |

XY area chart

30 |
31 |

XY area step chart

32 |
33 |

Timeseries

34 |
35 | 36 | 37 | -------------------------------------------------------------------------------- /lib/c3.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2015, Dave Scott 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | 15 | *) 16 | 17 | module Pie : sig 18 | (** Pie charts, with or without a hole in the middle ("donut" charts). *) 19 | 20 | type t 21 | (** An unrendered pie chart *) 22 | 23 | val make: sectors:(string * float) list -> ?hole:string -> unit -> t 24 | (** Create a pie chart with a list of sectors. If [hole] is supplied 25 | then the pie chart will be a donut containing a string label. *) 26 | 27 | val add: label:string -> value:float -> t:t -> unit -> t 28 | (** Add a single sector to an unrendered pie chart *) 29 | 30 | type display 31 | (** A rendered pie chart *) 32 | 33 | val render: bindto:string -> t -> display 34 | (** Render a pie chart in a named
*) 35 | end 36 | 37 | module Gauge : sig 38 | (** A Gauge shows a single value within a defined minimum and maximum range *) 39 | 40 | type t 41 | (** An unrendered gauge *) 42 | 43 | type colour = string 44 | (** A colour, e.g. "#ffffff" *) 45 | 46 | val make: ?min:float -> ?max:float -> ?units:string 47 | -> ?width:int -> ?thresholds:(float * colour) list 48 | -> value:float -> label:string 49 | -> unit -> t 50 | (** Create a gauge with a given value and label. By default a gauge will 51 | be a percentage i.e. with min = 0, max = 100, units = " %". The 52 | thresholds allow customisation of the colour, e.g. green, amber, red 53 | if that helps interpret the meaning of the value. *) 54 | 55 | type display 56 | (** A rendered gauge *) 57 | 58 | val render: bindto:string -> t -> display 59 | (** Render a gauge chart in a named
*) 60 | 61 | end 62 | 63 | module Segment : sig 64 | (** A line segment within a Line chart *) 65 | 66 | type kind = [ 67 | | `Line (** Render with straight lines *) 68 | | `Spline (** Render with splines to make it appear smooth *) 69 | | `Area (** Render with straight lines with a translucent fill underneath *) 70 | | `Area_spline (** Render with splines to make it appear smooth with a translucent fill underneath *) 71 | | `Area_step (** Render as horizontal steps with a translucent fill underneath *) 72 | | `Bar (** Render as discrete vertical bars *) 73 | ] 74 | val string_of_kind: kind -> string 75 | 76 | type t 77 | (** An unrendered line segment within a Line chart *) 78 | 79 | val make: points:(float * float) list -> label:string 80 | -> ?kind:kind -> unit -> t 81 | (** Create an unrendered line segment from a set of points and a label. 82 | By default it will render with straight lines. *) 83 | end 84 | 85 | 86 | type flow_to = [ 87 | | `OneInOneOut (** For every point added, remove the leftmost *) 88 | | `ToX of [ `Time of float | `X of float ] (** Move the minimum x co-ordinate to the given value *) 89 | | `Delete of int (** Delete exactly n points from the leftmost edge *) 90 | ] 91 | 92 | module Line : sig 93 | (** A line chart *) 94 | 95 | type kind = [ `Timeseries | `XY ] 96 | (** A line chart can show either timeseries data or arbitrary values on the 97 | X axis. *) 98 | 99 | type t 100 | (** An unrendered line chart *) 101 | 102 | val make: ?x_format:string -> ?x_label:string -> ?y_label:string -> kind:kind -> unit -> t 103 | (** Create an unrendered line chart, showing either `Timeseries or `XY data. 104 | The ?x_format is a format string for the labels on the x axis. *) 105 | 106 | val add: segment:Segment.t -> t -> t 107 | (** Add a line segment to an unrendered line chart. *) 108 | 109 | val add_group: segments:Segment.t list -> t -> t 110 | (** Add a group of line segments to an unrendered line chart. By grouping line 111 | segments they will be rendered stacked. *) 112 | 113 | type display 114 | (** A rendered line chart *) 115 | 116 | val render: bindto:string -> t -> display 117 | (** A rendered line chart *) 118 | 119 | val flow: segments:Segment.t list -> ?flow_to:flow_to -> display -> unit 120 | (** Dynamically extend a rendered line chart by adding a list of segments. 121 | The ?flow_to parameter customises how the chart will be added. *) 122 | 123 | val update: segments:Segment.t list -> display -> unit 124 | (** Replace the segments in an existing rendered chart with new ones. 125 | The old segments with the same label will be removed and replaced. *) 126 | end 127 | -------------------------------------------------------------------------------- /example/main.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2015, Dave Scott 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | *) 15 | 16 | open Lwt 17 | open Js_of_ocaml 18 | 19 | let d = Dom_html.document 20 | let get_by_id id = 21 | Js.Opt.get (d##getElementById(Js.string id)) 22 | (fun () -> assert false) 23 | 24 | let multichart name = 25 | let _ = 26 | C3.Line.make ~kind:`XY ~x_label:"Some x_label" ~y_label:"Some y_label" () 27 | |> C3.Line.add_group 28 | ~segments: [ C3.Segment.make ~kind:`Area_step 29 | ~points:[ 0.1,0.1; 0.2,0.2; 0.3,0.3; 0.4,0.2; 0.5,0.1] 30 | ~label:"Area_step 1" (); 31 | C3.Segment.make ~kind:`Area_step 32 | ~points:[ 0.1,0.1; 0.2,0.2; 0.3,0.3; 0.4,0.2; 0.5,0.1] 33 | ~label:"Area_step 2" (); ] 34 | |> C3.Line.add 35 | ~segment:(C3.Segment.make ~kind:`Line 36 | ~points:[ 0.1,0.5; 0.2,0.4; 0.3,0.3; 0.4,0.2; 0.5,0.1] 37 | ~label:"Line" ()) 38 | |> C3.Line.add 39 | ~segment:(C3.Segment.make ~kind:`Bar 40 | ~points:[ 0.1,0.1; 0.2,0.1; 0.3,0.1; 0.4,0.1; 0.5,0.1] 41 | ~label:"Bar" ()) 42 | |> C3.Line.render ~bindto:name in 43 | () 44 | 45 | 46 | let xychart kind name = 47 | let _ = 48 | C3.Line.make ~kind:`XY () 49 | |> C3.Line.add 50 | ~segment:(C3.Segment.make ~kind ~points:[0.1,0.1; 0.2,0.2; 0.3,0.3; 0.4,0.2; 0.5,0.1] 51 | ~label:(C3.Segment.string_of_kind kind) ()) 52 | |> C3.Line.render ~bindto:name in 53 | () 54 | 55 | let piechart name donut = 56 | let _ = 57 | C3.Pie.make 58 | ?hole:(if donut then Some "hello" else None) 59 | ~sectors:[ "a", 30.; "b", 120.; "c", 15.; "d", 90. ] () 60 | |> C3.Pie.render ~bindto:name in 61 | () 62 | 63 | let gauge name = 64 | let _ = 65 | C3.Gauge.make 66 | ~thresholds:[ 30., "#FF0000"; 60., "#F97600"; 90., "#F6C600"; 100., "#60B044" ] 67 | ~label:"hello" 68 | ~value:60. 69 | () 70 | |> C3.Gauge.render ~bindto:name in 71 | () 72 | 73 | 74 | 75 | module Histogram = struct 76 | type t = { 77 | bins: int array; 78 | start: float; 79 | width: float; 80 | } 81 | let make ~start ~width ~n () = 82 | let bins = Array.make n 0 in 83 | { start; width; bins } 84 | let add ~value t = 85 | try 86 | (* Discard values which are out of range *) 87 | let bin = int_of_float ((value -. t.start) /. t.width) in 88 | t.bins.(bin) <- t.bins.(bin) + 1 89 | with _ -> () 90 | let to_segment t = 91 | let points = 92 | t.bins 93 | |> Array.to_list 94 | |> List.mapi (fun idx v -> let t = float_of_int idx *. t.width +. t.start in t,float_of_int v) in 95 | 96 | C3.Segment.make ~label:"histogram" ~points ~kind:`Bar () 97 | end 98 | 99 | let pi = 4.0 *. atan(1.0) 100 | 101 | let normal () = 102 | let h = Histogram.make ~start:(-1.) ~width:0.01 ~n:200 () in 103 | let chart = 104 | C3.Line.make ~kind:`XY () 105 | |> C3.Line.add ~segment:(Histogram.to_segment h) 106 | |> C3.Line.render ~bindto:"#normal" in 107 | let sd = 0.1 in 108 | Lwt.async 109 | (fun () -> 110 | let rec loop iterations = 111 | for _i = 0 to 250 do 112 | let u_1 = Random.float 1. in 113 | let u_2 = Random.float 1. in 114 | (* Box-Muller transform *) 115 | let z_0 = sqrt (-2.0 *. log(u_1)) *. cos(2. *. pi *. u_2) *. sd in 116 | let z_1 = sqrt (-2.0 *. log(u_1)) *. sin(2. *. pi *. u_2) *. sd in 117 | Histogram.add ~value:z_0 h; 118 | Histogram.add ~value:z_1 h; 119 | done; 120 | C3.Line.update ~segments:[ Histogram.to_segment h ] chart; 121 | Js_of_ocaml_lwt.Lwt_js.sleep 1. 122 | >>= fun () -> 123 | loop (iterations + 1) in 124 | loop 0 125 | ) 126 | 127 | let rec range i n = 128 | if i >= n then [] else i :: range (i + 1) n 129 | 130 | let base = 131 | range 0 100 132 | |> List.map float_of_int 133 | |> List.map (fun x -> x /. 40.) 134 | 135 | let timeseries () = 136 | let chart = 137 | C3.Line.make ~kind:`Timeseries ~x_format:"%m/%d" () 138 | |> C3.Line.render ~bindto:"#timeserieschart" in 139 | 140 | let rec update_graph_forever chart t () = 141 | if t > 10. then return () 142 | else begin 143 | let points = List.map (fun x -> x, sin (t +. x)) base in 144 | C3.Line.update ~segments:[ C3.Segment.make ~label:"sin(t)" ~points 145 | ~kind:`Area_spline () ] 146 | chart; 147 | Js_of_ocaml_lwt.Lwt_js.sleep 0.1 148 | >>= fun () -> 149 | update_graph_forever chart (t +. 0.1) () 150 | end in 151 | Lwt.async (update_graph_forever chart 0.) 152 | 153 | let _ = 154 | Dom_html.window##.onload := Dom_html.handler 155 | (fun _ -> 156 | multichart "#multichart"; 157 | piechart "#piechart" false; 158 | piechart "#donutchart" true; 159 | gauge "#gauge"; 160 | xychart `Line "#xychart"; 161 | xychart `Area "#xyareachart"; 162 | xychart `Area_step "#xyareastepchart"; 163 | xychart `Spline "#xysplinechart"; 164 | normal (); 165 | timeseries (); 166 | Js._true 167 | ) 168 | -------------------------------------------------------------------------------- /lib/c3.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2015, Dave Scott 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | 15 | *) 16 | open Js_of_ocaml 17 | 18 | module List = struct 19 | include List 20 | (* make List tail recursive *) 21 | let map x f = rev_map x f |> rev 22 | end 23 | 24 | module Option = struct 25 | let value x ~default = match x with None -> default | Some x -> x 26 | let map x ~f = match x with None -> None | Some x -> Some (f x) 27 | end 28 | 29 | module Column_type = struct 30 | type t = [ 31 | | `Line 32 | | `Spline 33 | | `Area 34 | | `Area_spline 35 | | `Area_step 36 | | `Bar 37 | | `Pie (* columns are summed into individual sectors *) 38 | | `Donut (* same as pie *) 39 | | `Gauge (* single column *) 40 | ] 41 | 42 | let to_string = function 43 | | `Line -> "line" 44 | | `Spline -> "spline" 45 | | `Area -> "area" 46 | | `Area_spline -> "area-spline" 47 | | `Area_step -> "area-step" 48 | | `Bar -> "bar" 49 | | `Pie -> "pie" 50 | | `Donut -> "donut" 51 | | `Gauge -> "gauge" 52 | end 53 | 54 | module Tic = struct 55 | type t = [ 56 | | `Time of float (* seconds since epoch *) 57 | | `X of float 58 | ] 59 | 60 | let to_float = function 61 | | `Time t -> t *. 1000. (* JS takes milliseconds since epoch *) 62 | | `X x -> x 63 | end 64 | 65 | module Column = struct 66 | type t = { 67 | label: string; 68 | tics: Tic.t list; 69 | values: float list; 70 | ty: Column_type.t; 71 | } 72 | end 73 | 74 | module Axis_type = struct 75 | type t = [ 76 | | `Timeseries 77 | | `Line 78 | ] 79 | 80 | let to_string = function 81 | | `Timeseries -> "timeseries" 82 | | `Line -> "line" 83 | end 84 | 85 | module Axis = struct 86 | type t = { 87 | ty: Axis_type.t; 88 | format: string option; (* eg '%m/%d' *) 89 | label: string option; 90 | } 91 | 92 | let to_obj x = 93 | let open Js.Unsafe in 94 | [ 95 | "type", inject (Js.string (Axis_type.to_string x.ty)); 96 | ] @ (match x.format with 97 | | None -> [] 98 | | Some x -> [ 99 | "tick", obj [| 100 | "format", inject (Js.string x) 101 | |]; 102 | ] 103 | ) @ (match x.label with 104 | | None -> [] 105 | | Some x -> [ "label", inject @@ Js.string @@ x ] 106 | ) 107 | end 108 | 109 | module Gauge_info = struct 110 | type colour = string 111 | 112 | type t = { 113 | min: float option; 114 | max: float option; 115 | units: string option; 116 | width: int option; 117 | thresholds: (float * colour) list option; 118 | } 119 | 120 | let make ?min ?max ?units ?width ?thresholds () = 121 | { min; max; units; width; thresholds } 122 | 123 | let to_gauge_obj x = 124 | let open Js.Unsafe in 125 | match x with 126 | | None -> [] 127 | | Some x -> 128 | [ "gauge", obj (Array.of_list ( 129 | ( match x.min with 130 | | None -> [] 131 | | Some x -> [ "min", inject x ] 132 | ) @ ( 133 | match x.max with 134 | | None -> [] 135 | | Some x -> [ "max", inject x ] 136 | ) @ ( 137 | match x.units with 138 | | None -> [] 139 | | Some x -> [ "units", inject (Js.string x) ] 140 | ) @ ( 141 | match x.width with 142 | | None -> [] 143 | | Some x -> [ "width", inject x ] 144 | ))) 145 | ] 146 | 147 | let to_color_obj x = 148 | let open Js.Unsafe in 149 | match x with 150 | | None -> [] 151 | | Some { thresholds = None; _ } -> [] 152 | | Some { thresholds = Some ts; _ } -> 153 | [ "color", obj [| 154 | "pattern", inject @@ Js.array @@ Array.of_list @@ List.map (fun x -> inject @@ Js.string @@ snd x) ts; 155 | "threshold", obj [| 156 | "values", inject @@ Js.array @@ Array.of_list @@ List.map (fun x -> inject @@ fst x) ts; 157 | |] 158 | |] 159 | ] 160 | end 161 | 162 | module Donut = struct 163 | type t = { 164 | title: string; 165 | } 166 | 167 | let to_donut_obj x = 168 | let open Js.Unsafe in 169 | match x with 170 | | None -> [] 171 | | Some { title } -> [ "donut", obj [| "title", inject @@ Js.string title |] ] 172 | end 173 | 174 | module Chart = struct 175 | type t = { 176 | x_axis: Axis.t option; 177 | y_axis: Axis.t option; 178 | columns: Column.t list; 179 | donut: Donut.t option; 180 | gauge: Gauge_info.t option; 181 | groups: string list list; 182 | } 183 | 184 | let empty = { 185 | x_axis = None; 186 | y_axis = None; 187 | columns = 188 | [ { Column.label = ""; 189 | tics = []; 190 | values = []; 191 | ty = `Line; 192 | } ]; 193 | donut = None; 194 | gauge = None; 195 | groups = []; 196 | } 197 | end 198 | 199 | 200 | module Segment = struct 201 | 202 | type kind = [ 203 | | `Line 204 | | `Spline 205 | | `Area 206 | | `Area_spline 207 | | `Area_step 208 | | `Bar 209 | ] 210 | 211 | let string_of_kind = function 212 | | `Line -> "Line" 213 | | `Spline -> "Spline" 214 | | `Area -> "Area" 215 | | `Area_spline -> "Area spline" 216 | | `Area_step -> "Area step" 217 | | `Bar -> "Bar" 218 | 219 | type t = { 220 | points: (float * float) list; 221 | label: string; 222 | kind: kind; 223 | } 224 | 225 | let make ~points ~label ?(kind = `Line) () = 226 | { points; label; kind } 227 | 228 | let to_column kind t = 229 | let tics = match kind with 230 | | `XY -> List.map (fun x -> `X (fst x)) t.points 231 | | `Timeseries -> List.map (fun x -> `Time (fst x)) t.points in 232 | let values = List.map snd t.points in 233 | let ty = match t.kind with 234 | | `Line -> `Line 235 | | `Spline -> `Spline 236 | | `Area -> `Area 237 | | `Area_spline -> `Area_spline 238 | | `Area_step -> `Area_step 239 | | `Bar -> `Bar in 240 | { Column.label = t.label; tics; values; ty } 241 | end 242 | 243 | 244 | let js_of_columns columns = 245 | let tics = List.concat (List.map (fun c -> c.Column.tics) columns) in 246 | let data_columns = 247 | Js.Unsafe.( 248 | List.map (fun column -> 249 | Js.array (Array.of_list (inject (Js.string column.Column.label) :: (List.map inject column.Column.values))) 250 | ) columns 251 | ) in 252 | 253 | Js.Unsafe.( 254 | inject (Js.array (Array.of_list ( 255 | match tics with 256 | | [] -> data_columns 257 | | tics -> 258 | let tics = Js.array (Array.of_list (inject (Js.string "x") :: (List.map (fun x -> inject (Tic.to_float x)) tics))) in 259 | tics :: data_columns 260 | ))) 261 | ) 262 | 263 | let js_of_types columns = 264 | let open Js.Unsafe in 265 | obj (Array.of_list (List.map (fun column -> 266 | column.Column.label, inject (Js.string (Column_type.to_string column.Column.ty)) 267 | ) columns)) 268 | 269 | let generate bindto data = 270 | let columns = js_of_columns data.Chart.columns in 271 | let types = js_of_types data.Chart.columns in 272 | let x_axis = Option.(value ~default:[] (map ~f:Axis.to_obj data.Chart.x_axis)) in 273 | let y_axis = Option.(value ~default:[] (map ~f:Axis.to_obj data.Chart.y_axis)) in 274 | 275 | let axis = 276 | Js.Unsafe.([ 277 | "axis", obj [| 278 | "x", obj (Array.of_list x_axis); 279 | "y", obj (Array.of_list y_axis); 280 | |] 281 | ]) in 282 | 283 | let data' = 284 | Js.Unsafe.( 285 | (if data.Chart.x_axis = None then [] else [ 286 | "x", inject (Js.string "x"); 287 | "xFormat", inject (Js.string "%s") 288 | ]) @ [ 289 | "columns", columns; 290 | "types", types; 291 | "groups", inject @@ Js.array @@ Array.of_list @@ List.map (fun g -> inject @@ Js.array @@ Array.of_list @@ List.map (fun x -> inject @@ Js.string x) g) data.Chart.groups; 292 | ] 293 | ) in 294 | 295 | let arg = 296 | Js.Unsafe.(obj 297 | (Array.of_list 298 | (axis @ [ 299 | "bindto", inject (Js.string bindto); 300 | "data", obj (Array.of_list data') 301 | ] @ (Donut.to_donut_obj data.Chart.donut 302 | ) @ (Gauge_info.to_gauge_obj data.Chart.gauge 303 | ) @ (Gauge_info.to_color_obj data.Chart.gauge) 304 | ))) in 305 | Firebug.console##log(arg); 306 | 307 | let c3 = Js.Unsafe.global##.c3 in 308 | 309 | Js.Unsafe.meth_call c3 "generate" [| arg |] 310 | 311 | type flow_to = [ 312 | | `OneInOneOut 313 | | `ToX of Tic.t 314 | | `Delete of int 315 | ] 316 | 317 | let flow chart ?(flow_to = `OneInOneOut) cols : unit = 318 | let arg = 319 | Js.Unsafe.(obj 320 | (Array.of_list 321 | ((match flow_to with 322 | | `OneInOneOut -> [] 323 | | `ToX x -> [ "to", inject (Tic.to_float x) ] 324 | | `Delete n -> [ "length", inject n ] ) 325 | @ [ "columns", js_of_columns cols; "types", js_of_types cols ]) 326 | ) 327 | ) in 328 | Firebug.console##log(arg); 329 | Js.Unsafe.meth_call chart "flow" [| arg |] 330 | 331 | let load chart cols : unit = 332 | let arg = 333 | Js.Unsafe.(obj 334 | [| "columns", js_of_columns cols; "types", js_of_types cols |] 335 | ) in 336 | Js.Unsafe.meth_call chart "load" [| arg |] 337 | 338 | module Pie = struct 339 | type t = { 340 | values: (string * float) list; 341 | hole: string option; 342 | } 343 | 344 | let empty = { values = []; hole = None } 345 | 346 | let add ~label ~value ~t () = 347 | { t with values = (label, value) :: t.values } 348 | 349 | let make ~sectors ?hole () = 350 | let t = { empty with hole } in 351 | List.fold_left (fun acc (label, value) -> add ~label ~value ~t:acc ()) t sectors 352 | 353 | let to_chart t = 354 | let ty = if t.hole = None then `Pie else `Donut in 355 | let column (label, value) = 356 | { Column.label; tics = []; values = [ value ]; ty } in 357 | let columns = List.map column t.values in 358 | let donut = match t.hole with 359 | | None -> None 360 | | Some title -> Some { Donut.title } in 361 | { Chart.empty with Chart.columns; donut } 362 | 363 | type display = unit 364 | 365 | let render ~bindto t = generate bindto (to_chart t) 366 | end 367 | 368 | module Gauge = struct 369 | type t = { 370 | value: float; 371 | label: string; 372 | info: Gauge_info.t; 373 | } 374 | 375 | type colour = string 376 | 377 | let make ?min ?max ?units ?width ?thresholds ~value ~label () = 378 | let info = Gauge_info.make ?min ?max ?units ?width ?thresholds () in 379 | { value; label; info } 380 | 381 | let to_chart t = 382 | let columns = [ { Column.label = t.label; tics = []; values = [ t.value ]; ty = `Gauge} ] in 383 | let gauge = Some t.info in 384 | { Chart.empty with 385 | Chart.columns; 386 | gauge } 387 | 388 | 389 | type display = unit 390 | 391 | let render ~bindto t = generate bindto (to_chart t) 392 | end 393 | 394 | 395 | module Line = struct 396 | type kind = [ `Timeseries | `XY ] 397 | 398 | type t = { 399 | kind: kind; 400 | x_label: string option; 401 | x_format: string; 402 | y_label: string option; 403 | groups: Segment.t list list; 404 | } 405 | 406 | let make ?(x_format = "%d") ?x_label ?y_label ~kind () = 407 | { kind; x_format; x_label; y_label; groups = [] } 408 | 409 | let add ~segment t = 410 | { t with groups = [ segment ] :: t.groups } 411 | 412 | let add_group ~segments t = 413 | { t with groups = segments :: t.groups } 414 | 415 | let to_chart t = 416 | let columns = List.map (Segment.to_column t.kind) (List.concat t.groups) in 417 | let groups = List.map (List.map (fun s -> s.Segment.label)) t.groups in 418 | let ty = match t.kind with `XY -> `Line | `Timeseries -> `Timeseries in 419 | let x_axis = Some { 420 | Axis.ty = ty; format = Some t.x_format; label = t.x_label; 421 | } in 422 | let y_axis = Some { 423 | Axis.ty = `Line; format = None; label = t.y_label; 424 | } in 425 | { Chart.empty with Chart.x_axis; y_axis; columns; groups } 426 | 427 | type display = kind * unit 428 | 429 | let render ~bindto t = 430 | let chart = generate bindto (to_chart t) in 431 | t.kind, chart 432 | 433 | let flow ~segments ?flow_to (kind, chart) = 434 | let columns = List.map (Segment.to_column kind) segments in 435 | flow chart ?flow_to columns 436 | 437 | let update ~segments (kind, chart) = 438 | let columns = List.map (Segment.to_column kind) segments in 439 | load chart columns 440 | end 441 | --------------------------------------------------------------------------------