1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
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 saturating_sub b a =
if a < b then 0
else a - b
module type Marker = sig
type t
val of_string : string -> t
val to_string : t -> string
end
module Marker = struct
type t = Point
| Pixel
| Circle
| TriangleDown
| TriangleUp
| TriangleLeft
| TriangleRight
| Custom of string
exception Invalid_marker_length
let of_string s =
if String.length s <> 1
then raise Invalid_marker_length
else Custom(s)
let to_string = function
| Point -> "."
| Pixel -> ","
| Circle -> "o"
| TriangleDown -> "v"
| TriangleUp -> "^"
| TriangleLeft -> ">"
| 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 rec make_graph = function
| [] -> []
| (s, e) :: [] ->
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
end
|
