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 @@
-exception Empty_list
-let fold fn = function
-    | [] -> raise Empty_list
-    | head :: tail -> List.fold_left fn head tail
-let list_min ls = fold Stdlib.min ls
-let list_max ls = fold Stdlib.max ls
-let rec repeat n a =
-    if n <= 0
-    then []
-    else a :: repeat (n - 1) a
-let empty ls = (ls = [])
-let rec zip l1 l2 =
-    match (l1, l2) with
-    | ([], _) -> []
-    | (_, []) -> []
-    | (h1 :: t1, h2 :: t2) -> (h1, h2) :: zip t1 t2
-let rec transpose = function
-    | [] :: _ -> []
-    | ls -> List.(map hd ls) :: transpose List.(map tl ls)
-let flip f a b = f b a
-let rot_right ls = List.(rev ls |> transpose)
-let rot_left ls  = List.(transpose ls |> rev)
 let to_string c = String.make 1 c
 let space = to_string ' '
+let axis = "┬"
-let saturating_sub b a =
+let axis_spc = "─"
-    if a < b then 0
-    else a - b
+type t  = { vals: int list; opts: Options.t }
+let default = { vals = []; opts = Options.default }
-module type Marker = sig
+let plot v c = { c with vals = v; }
-    type t
+let with_options v c = { v with opts = c; }
-    val of_string : string -> t
+let pp channel {vals: int list; opts: Options.t } =
-    val to_string : t -> string
+    let open Utils in
-end
+    let height = opts.height in
+    let min_val = list_min vals in
-module Marker = struct
+    let max_val = list_max vals in
-    type t = Point 
+    let range = max_val - min_val in
-           | Pixel 
+    let scale v = ((v - min_val) * height) / range in
-           | Circle 
+    let new_vals = List.map scale vals in
-           | TriangleDown 
+    let rec pad left right s =
-           | TriangleUp
+        if left = 0
-           | TriangleLeft
+        then s :: repeat right space
-           | TriangleRight
+        else space :: pad (left - 1) right s
-           | Custom of string
+    in
+    let new_vals' = zip new_vals (List.tl new_vals) in
-    exception Invalid_marker_length
+    let make_marker prefix left right s =
-    let of_string s = 
+        prefix ::
-        if String.length s <> 1
+        (if left = 0
-        then raise Invalid_marker_length
+        then s :: repeat right space
-        else Custom(s)
+        else space :: pad (left - 1) right s)
+    in
-    let to_string = function
+    let make_connector s e =
-        | Point -> "."
+        match Stdlib.compare s e with
-        | Pixel -> ","
+        | 0 -> make_marker axis_spc s (height - s) "-"
-        | Circle  -> "o"
+        | x ->
-        | TriangleDown  -> "v"
+            let (ltr_chr, rtl_chr) =
-        | TriangleUp -> "^"
+                match x with
-        | TriangleLeft -> ">"
+                | 1 -> ("└", "┐")
-        | TriangleRight -> "<"
+                | _ -> ("┘", "┌")
-        | Custom(s) -> s
-end
-module type ChartOptions = sig
-    type t
-    val default : t
-    val with_height  : int -> t -> t
-    val with_marker  : string -> t -> t
-end
-module ChartOptions = struct
-    type t = { height: int; ascii: bool; marker: Marker.t}
-    let default =
-        { height = 14
-        ; ascii = false
-        ; marker = Marker.Point
-        }
-    let with_height v c = {c with height = v; }
-    let with_marker v c = {c with marker = v; }
-end
-module Chart = struct
-    let draw vals (opts: ChartOptions.t) =
-        let height = opts.height in
-        (* let width = List.length vals in *)
-        let min_val = list_min vals in
-        let max_val = list_max vals in
-        (*let range = max_val - min_val in*)
-        (* rescale from min-max to 0-height *)
-        let scale v = ((v - min_val) * height) / max_val in
-        let new_vals = List.map scale vals in
-        let rec pad left right s =
-            if left = 0
-            then s :: repeat right space
-            else space :: pad (left - 1) right s
-        in
-        let new_vals' = zip new_vals (List.tl new_vals) in
-        let make_connector s e =
-            match Stdlib.compare s e with
-            | 0 -> pad s (height - s - 1) "-"
-            | x ->
-                let (ltr_chr, rtl_chr) =
-                    match x with
-                    | 1 -> ("└", "┐")
-                    | _ -> ("┘", "┌")
-                in
-                let (st, en) = Stdlib.((min s e, max s e)) in
-                let l = en - st |> saturating_sub 1 in
-                let (left, right) = (repeat st space, repeat (height - l - st - 1) space)
-                in
-                List.flatten [left; [ltr_chr]; repeat l "│"; [rtl_chr]; right]
            in
-        let m = Marker.to_string opts.marker in
+            let (st, en) = Stdlib.((min s e, max s e)) in
-        let rec make_graph = function
+            let l = en - st |> saturating_sub 1 in
-            | [] -> []
+            let (left, right) = (repeat st space, repeat (height - l - st) space) in
-            | (s, e) :: [] ->
+            List.flatten [[axis_spc]; left; [ltr_chr]; repeat l "│"; [rtl_chr]; right]
-                    pad s (height - s - 1) m
-                    :: make_connector s e
-                    :: pad e (height - e - 1) m
-                    :: []
-            | (s, e) :: tl ->
-                    pad s (height - s - 1) m
-                    :: make_connector s e 
-                    :: make_graph tl
        in
-        make_graph new_vals' |> rot_left
+    let m = Printf.sprintf opts.marker in
-end
+    let rec make_graph = function
+        | [] -> []
+        | (s, e) :: [] ->
+                make_marker axis s (height - s) m
+                :: make_connector s e
+                :: make_marker axis e (height - e) m
+                :: []
+        | (s, e) :: tl ->
+                make_marker axis s (height - s) m
+                :: make_connector s e 
+                :: make_graph tl
+    in
+    make_graph new_vals' 
+        |> rot_left
+        |> List.map (String.concat "")
+        |> String.concat "\n"
+        |> Printf.fprintf channel "%s"

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 @@
1	exception Empty_list
2	let fold fn = function
3	\| [] -> raise Empty_list
4	\| head :: tail -> List.fold_left fn head tail
5
6	let list_min ls = fold Stdlib.min ls
7	let list_max ls = fold Stdlib.max ls
8
9	let rec repeat n a =
10	if n <= 0
11	then []
12	else a :: repeat (n - 1) a
13
14	let empty ls = (ls = [])
15
16	let rec zip l1 l2 =
17	match (l1, l2) with
18	\| ([], _) -> []
19	\| (_, []) -> []
20	\| (h1 :: t1, h2 :: t2) -> (h1, h2) :: zip t1 t2
21
22	let rec transpose = function
23	\| [] :: _ -> []
24	\| ls -> List.(map hd ls) :: transpose List.(map tl ls)
25
26	let flip f a b = f b a
27
28	let rot_right ls = List.(rev ls \|> transpose)
29	let rot_left ls = List.(transpose ls \|> rev)
30
31	let to_string c = String.make 1 c	1	let to_string c = String.make 1 c
32	let space = to_string ' '	2	let space = to_string ' '
33		3	let axis = "┬"
34	let saturating_sub b a =	4	let axis_spc = "─"
35	if a < b then 0	5
36	else a - b	6	type t = { vals: int list; opts: Options.t }
37		7	let default = { vals = []; opts = Options.default }
38	module type Marker = sig	8	let plot v c = { c with vals = v; }
39	type t	9	let with_options v c = { v with opts = c; }
40	val of_string : string -> t	10	let pp channel {vals: int list; opts: Options.t } =
41	val to_string : t -> string	11	let open Utils in
42	end	12	let height = opts.height in
43		13	let min_val = list_min vals in
44	module 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
69	end
70
71	module type ChartOptions = sig
72	type t
73	val default : t
74	val with_height : int -> t -> t
75	val with_marker : string -> t -> t
76	end
77
78	module 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; }
87	end
88
89	module 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
135	end	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"