Source file plot.ml

(*********************************************************************************)
(*                Statocaml                                                      *)
(*                                                                               *)
(*    Copyright (C) 2025 INRIA All rights reserved.                              *)
(*    Author: Maxence Guesdon (INRIA Saclay)                                     *)
(*      with Gabriel Scherer (INRIA Paris) and Florian Angeletti (INRIA Paris)   *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the               *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Plot utils *)

module Log = Statocaml.Log

let runs = ref []
let run_durations () = !runs

type gp = Buffer.t

let code = Buffer.contents

let p gp = Printf.kbprintf (fun b -> Buffer.add_string b "\n") gp

let terminal_of_ext str =
  match String.lowercase_ascii str with
  | "svg" -> "svg"
  | _ -> "pngcairo"

let create ?terminal ?background ?(w=600) ?(h=1000) ?title
  ?title_font_size output =
  let terminal =
    match terminal with
    | Some str -> str
    | None ->
        let str = Filename.extension output in
        let len = String.length str in
        if len > 1 then
          terminal_of_ext (String.sub str 1 (len - 1))
        else
          "pngcairo"
  in
  let gp = Buffer.create 256 in
  p gp "set term %s %ssize %d,%d" terminal
    (match background with None -> "" | Some c -> Printf.sprintf "background %s " c)
    w h;
  p gp "set output %S" output;
  Option.iter (fun str -> p gp "set title %S%s" str
       (match title_font_size with None -> "" | Some n -> Printf.sprintf " font \",%d\"" n)
  ) title;
  gp

let add_run duration = runs := duration :: !runs

let () =
  let com = "gnuplot < /dev/null" in
  match Sys.command com with
  | 0 -> ()
  | _ ->
      prerr_endline(Printf.sprintf "Command %S failed; is gnuplot installed ?" com);
      exit 1

let pool =
  Lwt_pool.create 5
    (fun () -> Lwt.return (Lwt_process.(open_process_full (shell "gnuplot"))))

let run =
  let rec read_until_done acc ic =
    match%lwt Lwt_io.read_line ic with
    | "DONE" -> Lwt.return (List.rev acc)
    | str -> read_until_done (str::acc) ic
  in
  fun gp ->
    Lwt_pool.use pool (fun p ->
       let code = Buffer.contents gp in
       Log.debug (fun m -> m "running gnuplot code:\n%s" code);
       let dstart = Unix.gettimeofday () in
       let%lwt () = Lwt_io.write p#stdin code in
       let%lwt () = Lwt_io.write p#stdin "print \"DONE\"\n" in
       let%lwt _ = read_until_done [] p#stderr in
       let%lwt () = Lwt_io.write p#stdin "print GPVAL_ERRNO\n" in
       let%lwt errmsg =
         match%lwt Lwt_io.read_line p#stderr with
         | "0" -> Lwt.return_none
         | _ ->
             let%lwt () = Lwt_io.write p#stdin "print GPVAL_ERRMSG\n" in
             let%lwt () = Lwt_io.write p#stdin "print \"DONE\"" in
             match%lwt read_until_done [] p#stderr with
             | [] -> Lwt.return_some "No error message"
             | lines -> Lwt.return_some (String.concat "\n" lines)
       in
       let%lwt () = Lwt_io.write p#stdin "reset session\n" in
       match errmsg with
       | None ->
           let dstop = Unix.gettimeofday () in
           let duration = dstop -. dstart in
           add_run duration ;
           Lwt.return_unit
       | Some msg ->
           failwith (Printf.sprintf "gnuplot code failed:\n===%s\n===\n%s" code msg)
    )
(*
let time_real_re = Re.(compile (seq [str "real:";
      group ~name:"minutes" (rep1 digit); char ':';
      group ~name:"seconds" (seq [ rep1 digit ; opt (seq [char '.'; rep1 digit])]) ;
    ]))
let time_real_re_minutes, time_real_re_seconds =
  let l = Re.group_names time_real_re in
  (List.assoc "minutes" l, List.assoc "seconds" l)

let re_comma = Re.(compile (char ','))
let run gp =
  let p = Lwt_process.(open_process_full (shell "time --format='real:%E' gnuplot")) in
  let code = Buffer.contents gp in
  Log.debug (fun m -> m "running gnuplot code:\n%s" code);
  let%lwt () = Lwt_io.write p#stdin code in
  let%lwt () = Lwt_io.close p#stdin in
  match%lwt p#status with
  | Unix.WEXITED 0 ->
      let%lwt outerr = Lwt_io.read p#stderr in
      let%lwt _ = p#close in
      let duration =
        match Re.exec_opt time_real_re outerr with
        | None ->
            failwith (Printf.sprintf "no real time output: %s" outerr)
(*            0.*)
        | Some g ->
            let minutes = int_of_string (Re.Group.get g time_real_re_minutes) in
            let seconds = float_of_string (Re.Group.get g time_real_re_seconds) in
            (float minutes) *. 60. +. seconds
      in
      add_run duration ;
      Lwt.return_unit
  | _ ->
      let%lwt _ = p#close in
      failwith (Printf.sprintf "gnuplot code failed:\n%s" code)
*)

let define_float_data gp varname l =
  p gp "$%s <<EOF" varname ;
  List.iter (fun f -> p gp "%f" f) l ;
  p gp "EOF"

let define_float_float_data gp varname l =
  p gp "$%s <<EOF" varname ;
  List.iter (fun (f, g) -> p gp "%f %f" f g) l ;
  p gp "EOF"

let define_float_float_string_data gp ?(sep='\t') varname l =
  p gp "$%s <<EOF" varname ;
  List.iter (fun (f, g, s) -> p gp "%f%c%f%c\"%s\"" f sep g sep s) l ;
  p gp "EOF"

let define_float_float_int_string_data gp ?(sep='\t') varname l =
  p gp "$%s <<EOF" varname ;
  List.iter (fun (f, g, d, s) -> p gp "%f%c%f%c%d%c\"%s\"" f sep g sep d sep s) l ;
  p gp "EOF"


type month = int * int (* year * month (1..12) *)

module Mmap = Map.Make(struct type t = month let compare = Stdlib.compare end)

let month_name = function
| 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr" | 5 -> "May" | 6 -> "Jun"
| 7 -> "Jul" | 8 -> "Aug" | 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec"
| x -> failwith (Printf.sprintf "Invalid month %d" x)

let month_label (y,m) =
  let year = if y = 0 then "" else Printf.sprintf "%d-" y in
  Printf.sprintf "%s%s" year (month_name m)

let month_labels =
  let rec iter acc cur_y = function
  | [] -> List.rev acc
  | (y,m) :: q ->
      let v = if cur_y = y then (0,m) else (y,m) in
      iter (v::acc) y q
  in
  fun months -> List.map month_label (iter [] 0 months)

let month_in_interval ?after ?before () =
 match after, before with
  | None, None -> (fun _ -> true)
  | Some bound, None ->
      let (yb,mb,_) = Ptime.to_date bound in
      (fun (y,m) -> y > yb || (y = yb && m >= mb))
  | None, Some bound ->
      let (yb,mb,_) = Ptime.to_date bound in
      (fun (y,m) -> y < yb || (y = yb && m < mb))
  | Some b1, Some b2 ->
      let (yb1,mb1,_) = Ptime.to_date b1 in
      let (yb2,mb2,_) = Ptime.to_date b2 in
      (fun (y,m) ->
         (y > yb1 || (y = yb1 && m >= mb1))
           && (y < yb2 || (y = yb2 && m < mb2))
      )

let min_max_of_month_maps = function
| [] -> failwith"min_max_of_month_maps: No months"
| m :: maps ->
    let (min0,_) = Mmap.min_binding m in
    let (max0,_) = Mmap.max_binding m in
    List.fold_left
      (fun (acc_min, acc_max) m ->
         let (min1,_) = Mmap.min_binding m in
         let (max1,_) = Mmap.max_binding m in
         (min acc_min min1, max acc_max max1)
      ) (min0, max0) maps

let add_missing_months ~default min_month max_month =
  let (min_y, min_m) = min_month in
  let (max_y, max_m) = max_month in
  let rec iter_m y stop acc m =
    if m > stop then
      acc
    else
      let acc = match Mmap.find_opt (y, m) acc with
        | Some _ -> acc
        | None -> Mmap.add (y,m) default acc
      in
      iter_m y stop acc (m+1)
  in
  let rec iter_y acc y =
    if y > max_y then
      acc
    else
      let start = if y = min_y then min_m else 1 in
      let stop = if y = max_y then max_m else 12 in
      let acc = iter_m y stop acc start in
      iter_y acc (y+1)
  in
  fun map -> iter_y map min_y

let gnuplot_init_for_months gp ?fontsize map =
  let labels = month_labels (List.map fst (Mmap.bindings map)) in
  let set_xrange = Printf.sprintf "set xrange [%d:%d]" (-1) (Mmap.cardinal map) in
  let set_xtics =
    let labels =
      let rec iter acc n = function
      | [] -> List.rev acc
      | h :: q ->
          let label = Printf.sprintf "%S %d" h n in
          let acc = label :: acc in
          iter acc (n+1) q
      in
      iter [] 0 labels
    in
    Printf.sprintf "set xtics %srotate (%s)"
      (match fontsize with None -> "" | Some n -> Printf.sprintf "font \",%d\" " n)
      (String.concat ", " labels)
  in
  let coms =
    [
      "set style histogram clustered gap 2";
      "set key bottom center outside" ;
      set_xrange ;
      set_xtics ;
    ]
  in
  List.iter (fun s -> p gp "%s" s) coms

let spider_plot gp axes values =
  p gp "set spiderplot";
  p gp "set nokey";
  p gp "set style spiderplot fs transparent solid 0.2 border";
  List.iteri (fun i (label,(low,hi),total) ->
     let v = List.nth values i in
     let pct = (v /. total) *. 100. in
     let i = i + 1 in
     p gp "set paxis %d range [%f:%f]" i low hi ;
     p gp "set paxis %d tics font \",9\" format ''" i ;
     p gp "set paxis %d label \"%s: %d (%d%%)\\n(max=%d/%d, %d%%)\" font \",9\"" i label
       (truncate (List.nth values (i-1)))
       (truncate pct)
       (truncate hi)
       (truncate total)
       (truncate ((hi /. total) *. 100.));
     p gp "set paxis %d lw 0.2" i;
     p gp "set grid spiderplot"
  ) axes;
  p gp "$data <<EOF" ;
  p gp "%s" (String.concat " " (List.map string_of_float values));
  p gp "EOF";
  p gp "plot for [i=1:%d] $data using i:key(1)" (List.length values)
(*  Log.info (fun m -> m "%s" (Buffer.contents gp))*)

(*toto
coucou
set spiderplot
     set style spiderplot fs transparent solid 0.2 border
     set for [p=1:5] paxis p range [0:100]
     set for [p=2:5] paxis p tics format ""
     set             paxis 1 tics font ",9"
     set for [p=1:5] paxis p label sprintf("Score %d",p)
     set grid spiderplot
     plot for [i=1:5] $DATA using i:key(1)
*)