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 +++++++++++++++++--------------------------------------- src/chart.mli | 5 ++ src/dune | 3 +- src/grump.ml | 1 - src/marker.ml | 57 ++++++++--------- src/marker.mli | 4 ++ src/options.ml | 8 +++ src/options.mli | 4 ++ src/utils.ml | 53 ++++++++-------- 9 files changed, 129 insertions(+), 194 deletions(-) create mode 100644 src/chart.mli delete mode 100644 src/grump.ml create mode 100644 src/marker.mli create mode 100644 src/options.ml create mode 100644 src/options.mli (limited to 'src') 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" diff --git a/src/chart.mli b/src/chart.mli new file mode 100644 index 0000000..3c758c4 --- /dev/null +++ b/src/chart.mli @@ -0,0 +1,5 @@ +type t +val default : t +val plot : int list -> t -> t +val with_options : Options.t -> t -> t +val pp : out_channel -> t -> unit diff --git a/src/dune b/src/dune index 6b1e6d9..328399e 100644 --- a/src/dune +++ b/src/dune @@ -1,3 +1,4 @@ (library (name grump) - (public_name grump)) + (public_name grump) + (wrapped false)) diff --git a/src/grump.ml b/src/grump.ml deleted file mode 100644 index b4b1288..0000000 --- a/src/grump.ml +++ /dev/null @@ -1 +0,0 @@ -print_endline "hello world!" diff --git a/src/marker.ml b/src/marker.ml index 19b1be0..0c59804 100644 --- a/src/marker.ml +++ b/src/marker.ml @@ -1,36 +1,27 @@ -module type Marker = sig - type t - val of_string : string -> t - val pp : out_channel -> t -> unit -end +type t = Point + | Pixel + | Circle + | TriangleDown + | TriangleUp + | TriangleLeft + | TriangleRight + | Custom of string -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) - exception Invalid_marker_length - let of_string s = - if String.length s <> 1 - then raise Invalid_marker_length - else Custom(s) - - let pp channel n = - (match n with - | Point -> "." - | Pixel -> "," - | Circle -> "o" - | TriangleDown -> "v" - | TriangleUp -> "^" - | TriangleLeft -> ">" - | TriangleRight -> "<" - | Custom(s) -> s) - |> Printf.fprintf channel "%s" - -end +let pp channel n = + (match n with + | Point -> "." + | Pixel -> "," + | Circle -> "o" + | TriangleDown -> "v" + | TriangleUp -> "^" + | TriangleLeft -> ">" + | TriangleRight -> "<" + | Custom(s) -> s) + |> Printf.fprintf channel "%s" diff --git a/src/marker.mli b/src/marker.mli new file mode 100644 index 0000000..391916b --- /dev/null +++ b/src/marker.mli @@ -0,0 +1,4 @@ +type t +val of_string : string -> t +val pp : out_channel -> t -> unit + diff --git a/src/options.ml b/src/options.ml new file mode 100644 index 0000000..a57c28b --- /dev/null +++ b/src/options.ml @@ -0,0 +1,8 @@ +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; } diff --git a/src/options.mli b/src/options.mli new file mode 100644 index 0000000..64bee51 --- /dev/null +++ b/src/options.mli @@ -0,0 +1,4 @@ +type t +val default : t +val with_height : int -> t -> t +val with_marker : Marker.t -> t -> t diff --git a/src/utils.ml b/src/utils.ml index 8d1094e..62ae3a5 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -1,36 +1,33 @@ -module Utils = struct - exception Empty_list - let fold fn = function - | [] -> raise Empty_list - | head :: tail -> List.fold_left fn head tail +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 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 rec repeat n a = + if n <= 0 + then [] + else a :: repeat (n - 1) a - let empty ls = (ls = []) +let empty ls = (ls = []) - let rec zip l1 l2 = - match (l1, l2) with - | ([], _) -> [] - | (_, []) -> [] - | (h1 :: t1, h2 :: t2) -> (h1, h2) :: zip t1 t2 +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 rec transpose = function + | [] :: _ -> [] + | ls -> List.(map hd ls) :: transpose List.(map tl ls) - let flip f a b = f b a +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 saturating_sub b a = - if a < b then 0 - else a - b -end +let rot_right ls = List.(rev ls |> transpose) +let rot_left ls = List.(transpose ls |> rev) +let saturating_sub b a = + if a < b then 0 + else a - b -- cgit v1.2.3