From c9e8dff919c49a13bff601e78cc1e78a7cc8f506 Mon Sep 17 00:00:00 2001 From: Akshay Date: Sun, 8 Aug 2021 17:38:33 +0530 Subject: dump --- src/chart.ml | 188 ++++++++++++++++++----------------------------------------- 1 file changed, 57 insertions(+), 131 deletions(-) (limited to 'src/chart.ml') 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 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] +let axis = "┬" +let axis_spc = "─" + +type t = { vals: int list; opts: Options.t } +let default = { vals = []; opts = Options.default } +let plot v c = { c with vals = v; } +let with_options v c = { v with opts = c; } +let pp channel {vals: int list; opts: Options.t } = + let open Utils in + let height = opts.height in + let min_val = list_min vals in + let max_val = list_max vals in + let range = max_val - min_val in + let scale v = ((v - min_val) * height) / range 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_marker prefix left right s = + prefix :: + (if left = 0 + then s :: repeat right space + else space :: pad (left - 1) right s) + in + let make_connector s e = + match Stdlib.compare s e with + | 0 -> make_marker axis_spc s (height - s) "-" + | x -> + let (ltr_chr, rtl_chr) = + match x with + | 1 -> ("└", "┐") + | _ -> ("┘", "┌") 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 + 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) space) in + List.flatten [[axis_spc]; left; [ltr_chr]; repeat l "│"; [rtl_chr]; right] in - make_graph new_vals' |> rot_left -end + let m = Printf.sprintf opts.marker in + 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" -- cgit v1.2.3