package statocaml_plots

  1. Overview
  2. Docs

Source file cohorts.ml

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
(*********************************************************************************)
(*                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                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Cohorts *)

module Log = Statocaml.Log

type id = int
type t = {
    id : id ;
    name : string ;
    color : string option ;
    period : Statocaml.Period.t option ;
  }

let compare = Int.compare

module Imap = Statocaml.Imap

let create =
  let cpt = ref (-1) in
  fun ?color ?period name ->
    incr cpt;
    { id = !cpt ; color ; name ; period }

type cohorts = t Imap.t
type 'a cohort_hist = 'a Imap.t Imap.t
  (* for each cohort period, data from each cohort;
     a map is used to ensure we will iterate on cohorts always
     in the same order. *)

let fill_hist cohorts hist =
  Imap.map
    (fun map ->
       Imap.fold (fun id _ map ->
          match Imap.find_opt id map with
          | Some _ -> map
          | None -> Imap.add id 0 map
       ) cohorts map
    ) hist

let sum_hist hist =
  let f _ map acc =
    let sum = Imap.fold (fun _ n sum -> n + sum) map 0 in
    sum :: acc
  in
  List.rev (Imap.fold f hist [])


let plot gp ?(events=[]) ?event_font_size ?ylabel ?except cohorts (hist : int cohort_hist) =
  let hist = fill_hist cohorts hist in
  let steps = sum_hist hist in
  Plot.p gp "set style histogram rowstacked gap 2";
  Plot.p gp "set key bottom center outside vertical maxrows 8" ;
  Plot.p gp "set tics font \",11\"";
  let cohorts1 = match except with
    | None -> cohorts
    | Some id -> Imap.filter (fun k _ -> k <> id) cohorts
  in
  Plot.p gp "set xrange [%d:%d]" (-1) (Imap.cardinal cohorts1) ;
  let (xlabels, _) =
    Imap.fold (fun _ c (acc,n) -> Printf.sprintf "%S %d" c.name n :: acc, n+1) cohorts1
     ([],0)
  in
  let xlabels = List.rev xlabels in
  Plot.p gp "set xtics rotate (%s)" (String.concat ", " xlabels);
  Option.iter (fun s -> Plot.p gp "set ylabel %S" s) ylabel;
  Imap.iter (fun k c ->
     Log.debug (fun m -> m "cohort%d = %S" k c.name);
     Plot.p gp "$cohort%d <<EOD" k;
     let f _ map =
       let size = Imap.find k map in
       Plot.p gp "%d" size;
     in
     Imap.iter f hist ;
     Plot.p gp "EOD"
  ) cohorts;
  let (l,_) = Imap.fold (fun k c (acc,n) ->
     let color = Option.value ~default:(Colors.get n) c.color in
     Printf.sprintf "$cohort%d using 1 with histogram lc %S fs solid 0.8 noborder title '%s'" k color c.name :: acc, n+1
    ) cohorts ([],0)
  in
  Plot.define_float_data gp "steps" (List.map float steps);
  let periods = Imap.fold
    (fun _id c acc ->
       match c.period with
       | None -> acc
       | Some p -> Statocaml.Period.Map.add p c acc
    )
      cohorts Statocaml.Period.Map.empty
  in
  Utils.add_events_for_periods gp ?font_size:event_font_size events periods ;
  Plot.p gp "plot %s, $steps using 1 with histeps lc \"black\" notitle" (String.concat ", " (List.rev l)) ;
  Plot.run gp

let plot_to_file ~outfile ~title ?ylabel ?except cohorts hist =
  let w = 45 * (Imap.cardinal hist) in
  let h = 100 + 20 * (Imap.cardinal hist) in
  let gp = Plot.create ~w ~h ~title outfile in
  Log.info (fun m -> m "Creating %s" outfile);
  plot gp ?ylabel ?except cohorts hist