diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/chart.ml | 135 | ||||
-rw-r--r-- | src/dune | 3 | ||||
-rw-r--r-- | src/grump.ml | 1 |
3 files changed, 139 insertions, 0 deletions
diff --git a/src/chart.ml b/src/chart.ml new file mode 100644 index 0000000..0aee05d --- /dev/null +++ b/src/chart.ml | |||
@@ -0,0 +1,135 @@ | |||
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 | ||
32 | let space = to_string ' ' | ||
33 | |||
34 | let saturating_sub b a = | ||
35 | if a < b then 0 | ||
36 | else a - b | ||
37 | |||
38 | module type Marker = sig | ||
39 | type t | ||
40 | val of_string : string -> t | ||
41 | val to_string : t -> string | ||
42 | end | ||
43 | |||
44 | module Marker = struct | ||
45 | type t = Point | ||
46 | | Pixel | ||
47 | | Circle | ||
48 | | TriangleDown | ||
49 | | TriangleUp | ||
50 | | TriangleLeft | ||
51 | | TriangleRight | ||
52 | | Custom of string | ||
53 | |||
54 | exception Invalid_marker_length | ||
55 | let of_string s = | ||
56 | if String.length s <> 1 | ||
57 | then raise Invalid_marker_length | ||
58 | else Custom(s) | ||
59 | |||
60 | let to_string = function | ||
61 | | Point -> "." | ||
62 | | Pixel -> "," | ||
63 | | Circle -> "o" | ||
64 | | TriangleDown -> "v" | ||
65 | | TriangleUp -> "^" | ||
66 | | TriangleLeft -> ">" | ||
67 | | TriangleRight -> "<" | ||
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 | ||
121 | let m = Marker.to_string opts.marker in | ||
122 | let rec make_graph = function | ||
123 | | [] -> [] | ||
124 | | (s, e) :: [] -> | ||
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 | ||
134 | make_graph new_vals' |> rot_left | ||
135 | end | ||
diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..6b1e6d9 --- /dev/null +++ b/src/dune | |||
@@ -0,0 +1,3 @@ | |||
1 | (library | ||
2 | (name grump) | ||
3 | (public_name grump)) | ||
diff --git a/src/grump.ml b/src/grump.ml new file mode 100644 index 0000000..b4b1288 --- /dev/null +++ b/src/grump.ml | |||
@@ -0,0 +1 @@ | |||
print_endline "hello world!" | |||