summaryrefslogtreecommitdiff
path: root/src/chart.ml
diff options
context:
space:
mode:
authorAkshay <[email protected]>2021-08-08 13:08:33 +0100
committerAkshay <[email protected]>2021-08-08 13:08:33 +0100
commitc9e8dff919c49a13bff601e78cc1e78a7cc8f506 (patch)
treeb9015effe9dc995b083658b12b0de17d61230364 /src/chart.ml
parented2a97502cb825877562c05881da4fb2e8eecad6 (diff)
dump
Diffstat (limited to 'src/chart.ml')
-rw-r--r--src/chart.ml188
1 files changed, 57 insertions, 131 deletions
diff --git a/src/chart.ml b/src/chart.ml
index 0aee05d..0826092 100644
--- a/src/chart.ml
+++ b/src/chart.ml
@@ -1,135 +1,61 @@
1exception Empty_list
2let fold fn = function
3 | [] -> raise Empty_list
4 | head :: tail -> List.fold_left fn head tail
5
6let list_min ls = fold Stdlib.min ls
7let list_max ls = fold Stdlib.max ls
8
9let rec repeat n a =
10 if n <= 0
11 then []
12 else a :: repeat (n - 1) a
13
14let empty ls = (ls = [])
15
16let rec zip l1 l2 =
17 match (l1, l2) with
18 | ([], _) -> []
19 | (_, []) -> []
20 | (h1 :: t1, h2 :: t2) -> (h1, h2) :: zip t1 t2
21
22let rec transpose = function
23 | [] :: _ -> []
24 | ls -> List.(map hd ls) :: transpose List.(map tl ls)
25
26let flip f a b = f b a
27
28let rot_right ls = List.(rev ls |> transpose)
29let rot_left ls = List.(transpose ls |> rev)
30
31let to_string c = String.make 1 c 1let to_string c = String.make 1 c
32let space = to_string ' ' 2let space = to_string ' '
33 3let axis = "┬"
34let saturating_sub b a = 4let axis_spc = "─"
35 if a < b then 0 5
36 else a - b 6type t = { vals: int list; opts: Options.t }
37 7let default = { vals = []; opts = Options.default }
38module type Marker = sig 8let plot v c = { c with vals = v; }
39 type t 9let with_options v c = { v with opts = c; }
40 val of_string : string -> t 10let pp channel {vals: int list; opts: Options.t } =
41 val to_string : t -> string 11 let open Utils in
42end 12 let height = opts.height in
43 13 let min_val = list_min vals in
44module Marker = struct 14 let max_val = list_max vals in
45 type t = Point 15 let range = max_val - min_val in
46 | Pixel 16 let scale v = ((v - min_val) * height) / range in
47 | Circle 17 let new_vals = List.map scale vals in
48 | TriangleDown 18 let rec pad left right s =
49 | TriangleUp 19 if left = 0
50 | TriangleLeft 20 then s :: repeat right space
51 | TriangleRight 21 else space :: pad (left - 1) right s
52 | Custom of string 22 in
53 23 let new_vals' = zip new_vals (List.tl new_vals) in
54 exception Invalid_marker_length 24 let make_marker prefix left right s =
55 let of_string s = 25 prefix ::
56 if String.length s <> 1 26 (if left = 0
57 then raise Invalid_marker_length 27 then s :: repeat right space
58 else Custom(s) 28 else space :: pad (left - 1) right s)
59 29 in
60 let to_string = function 30 let make_connector s e =
61 | Point -> "." 31 match Stdlib.compare s e with
62 | Pixel -> "," 32 | 0 -> make_marker axis_spc s (height - s) "-"
63 | Circle -> "o" 33 | x ->
64 | TriangleDown -> "v" 34 let (ltr_chr, rtl_chr) =
65 | TriangleUp -> "^" 35 match x with
66 | TriangleLeft -> ">" 36 | 1 -> ("└", "┐")
67 | TriangleRight -> "<" 37 | _ -> ("┘", "┌")
68 | Custom(s) -> s
69end
70
71module type ChartOptions = sig
72 type t
73 val default : t
74 val with_height : int -> t -> t
75 val with_marker : string -> t -> t
76end
77
78module ChartOptions = struct
79 type t = { height: int; ascii: bool; marker: Marker.t}
80 let default =
81 { height = 14
82 ; ascii = false
83 ; marker = Marker.Point
84 }
85 let with_height v c = {c with height = v; }
86 let with_marker v c = {c with marker = v; }
87end
88
89module Chart = struct
90 let draw vals (opts: ChartOptions.t) =
91 let height = opts.height in
92 (* let width = List.length vals in *)
93 let min_val = list_min vals in
94 let max_val = list_max vals in
95 (*let range = max_val - min_val in*)
96
97 (* rescale from min-max to 0-height *)
98 let scale v = ((v - min_val) * height) / max_val in
99 let new_vals = List.map scale vals in
100 let rec pad left right s =
101 if left = 0
102 then s :: repeat right space
103 else space :: pad (left - 1) right s
104 in
105 let new_vals' = zip new_vals (List.tl new_vals) in
106 let make_connector s e =
107 match Stdlib.compare s e with
108 | 0 -> pad s (height - s - 1) "-"
109 | x ->
110 let (ltr_chr, rtl_chr) =
111 match x with
112 | 1 -> ("└", "┐")
113 | _ -> ("┘", "┌")
114 in
115 let (st, en) = Stdlib.((min s e, max s e)) in
116 let l = en - st |> saturating_sub 1 in
117 let (left, right) = (repeat st space, repeat (height - l - st - 1) space)
118 in
119 List.flatten [left; [ltr_chr]; repeat l "│"; [rtl_chr]; right]
120 in 38 in
121 let m = Marker.to_string opts.marker in 39 let (st, en) = Stdlib.((min s e, max s e)) in
122 let rec make_graph = function 40 let l = en - st |> saturating_sub 1 in
123 | [] -> [] 41 let (left, right) = (repeat st space, repeat (height - l - st) space) in
124 | (s, e) :: [] -> 42 List.flatten [[axis_spc]; left; [ltr_chr]; repeat l "│"; [rtl_chr]; right]
125 pad s (height - s - 1) m
126 :: make_connector s e
127 :: pad e (height - e - 1) m
128 :: []
129 | (s, e) :: tl ->
130 pad s (height - s - 1) m
131 :: make_connector s e
132 :: make_graph tl
133 in 43 in
134 make_graph new_vals' |> rot_left 44 let m = Printf.sprintf opts.marker in
135end 45 let rec make_graph = function
46 | [] -> []
47 | (s, e) :: [] ->
48 make_marker axis s (height - s) m
49 :: make_connector s e
50 :: make_marker axis e (height - e) m
51 :: []
52 | (s, e) :: tl ->
53 make_marker axis s (height - s) m
54 :: make_connector s e
55 :: make_graph tl
56 in
57 make_graph new_vals'
58 |> rot_left
59 |> List.map (String.concat "")
60 |> String.concat "\n"
61 |> Printf.fprintf channel "%s"