Source file closing.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                                          *)
(*                                                                               *)
(*********************************************************************************)

(** *)

module S = Statocaml
module T = Statocaml_profile.T

module GH = Statocaml_github


let closing_time_days creation closure =
  let d = Ptime.diff closure creation in
  let secs = truncate (Ptime.Span.to_float_s d) in
  (secs / 86400) + 1

let days_of_issue ?after ?before =
  let pred_after = match after with
    | None -> (fun (_:GH.Types.issue) -> true)
    | Some d -> (fun i -> Ptime.is_later ~than:d i.created_at)
  in
  let pred_before = match before with
    | None -> (fun (_:GH.Types.issue) -> true)
    | Some d -> (fun i -> Ptime.is_earlier ~than:d i.created_at)
  in
  fun i ->
    if pred_after i && pred_before i then
      Option.map (fun d -> float (closing_time_days i.created_at d))
        i.closed_at
    else
      None

module Make (P:T.S) =
  struct
    let issues_closing_days ?after ?before (data:P.t) =
      let stats = T.Period.Map.(find All data.P.stats) in
      let f _ i = days_of_issue ?after ?before i in
      S.Imap.filter_map f stats.g_issues

    let prs_closing_days ?after ?before (data:P.t) =
      let stats = T.Period.Map.(find All data.P.stats) in
      let f _ pr = days_of_issue ?after ?before (pr.P.issue) in
      S.Imap.filter_map f stats.g_prs

    module Elt = struct
        type t = int * float
        let compare (i1,_) (i2,_) = Int.compare i1 i2
        end
    module Set = Set.Make(Elt)
    module K = S.Kmean.Float(Set)

    let date_title_complement ?after ?before () =
      let to_str () (y,m,d) = Printf.sprintf "%04d/%02d/%02d" y m d in
      match after, before with
      | None, None -> None
      | Some d, None -> Some (Printf.sprintf " (open after %a)" to_str d)
      | None, Some d -> Some (Printf.sprintf " (open before %a)" to_str d)
      | Some a, Some b ->
          Some (Printf.sprintf " (open between %a and %a)" to_str a to_str b)

    let fill_classes ~total ~k ?means l  =
      let classes = K.go (fun (_,v) -> v)
        (Set.of_list l) ?means
          k
      in
      let classes = List.sort (fun c1 c2 -> Float.compare c1.K.min_value c2.min_value) classes in
      List.map (fun (cls:K.cls) ->
         let card = Set.cardinal cls.elts in
         (cls.elts,
          (float (Set.cardinal cls.elts),
           S.Dot.random_color (),
           Printf.sprintf "%.0f days <= %d (%.1f%%) <= %.0f days"
             cls.min_value card
             ((float card /. total) *. 100.) cls.max_value
          )
         )
      )
        classes

    let plot_closing_delays ~kind gp ?(classes=[]) ?quantiles map =
      Plot.p gp "set ylabel %S" "Closing delay (in days)";
      let kind = match kind with `PR -> "PRs" | `Issue -> "Issues" in
      match classes with
      | [] | [0] | [1] ->
          Plot.p gp "set title %S"
            (Printf.sprintf "%s: Average closing delay per quantile" kind);
          let values = List.map snd (S.Imap.bindings map) in
          let quantiles = Utils.to_quantiles ?quantiles values in
          let (bars,_) = List.fold_right (fun v (acc,i) ->
               let title = Printf.sprintf "q%d" i in
               let color = Colors.get (i-1) in
               ((v, color, title)::acc, i-1)
            ) quantiles ([], List.length quantiles)
          in
          Utils.bar_chart gp ~with_titles:true bars
      | ks ->
          let total = float (S.Imap.cardinal map) in
          let classes =
            match ks with
            | [k] -> fill_classes ~total ~k (S.Imap.bindings map)
            | ks ->
                match fill_classes ~total ~k:(List.length ks) (S.Imap.bindings map) with
                | [] -> assert false
                | l  ->
                    let l = List.map2 (fun k ((c,_) as x) ->
                         match k with
                         | 1 -> [x]
                         | _ -> fill_classes ~total ~k (Set.elements c))
                      ks l
                    in
                    List.flatten l
          in
          let bars = List.map snd classes in
          let () =
            let sum1 = S.Imap.cardinal map in
            let sum2 = List.fold_right (fun (n,_,_) acc -> acc + truncate n) bars 0 in
            assert (sum1 = sum2)
          in
          Utils.bar_chart gp ~with_titles:true bars

    type delay_param =
      { after: Ptime.t option [@ocf Ocf.Wrapper.option Statocaml.Types.ptime_date_wrapper, None];
        before: Ptime.t option [@ocf Ocf.Wrapper.option Statocaml.Types.ptime_date_wrapper, None];
        classes: int list option [@ocf Ocf.Wrapper.(option (list int)), None];
        quantiles: int option [@ocf Ocf.Wrapper.(option int), None];
      }[@@ocf]

    let plot_closing_delays_by_kind ~kind gp ?classes ?quantiles ?after ?before data =
      let map = match kind with
        | `PR -> prs_closing_days ?after ?before data
        | `Issue -> issues_closing_days ?after ?before data
      in
      plot_closing_delays ~kind gp ?classes ?quantiles map

    let wrap_param f =
      Json.to_plotter delay_param_wrapper
        (fun gp p -> f gp ?classes:p.classes ?quantiles:p.quantiles ?after:p.after ?before:p.before)
    let plot_closing_delays_json ~kind = wrap_param (plot_closing_delays_by_kind ~kind)

    let mk_cohorts ~after ~before cohort_duration (issues:GH.Types.issue S.Imap.t) =
      let module DM = Statocaml.Types.Date_map in
      let date_after = S.Types.date_of_ptime after in
      let period0 = S.Period.DInterval ((1970,1,1), date_after, None) in
      let cohort0 = Cohorts.create ~period:period0 "Already there" in
      let cohorts = S.Imap.singleton cohort0.id cohort0 in
      (* map from period of a cohort to its id *)
      let by_period = S.Period.Map.singleton period0 cohort0.id in
      let issues0, remain = S.Imap.fold
        (fun id (i:GH.Types.issue) (issues0, remain) ->
           if Ptime.compare before i.created_at > 0 then
             if Ptime.compare after i.created_at > 0 then
               match i.closed_at with
               | None -> S.Iset.add id issues0, remain
               | Some d ->
                   if Ptime.compare after d > 0 then
                     (* issue closed before period of interest *)
                     (issues0, remain)
                   else
                     (S.Iset.add id issues0, remain)
             else
               (issues0, S.Imap.add id i remain)
           else
             (issues0, remain)
        ) issues (S.Iset.empty, S.Imap.empty)
      in
      let c_issues = S.Imap.singleton cohort0.id issues0 in
      (*prerr_endline (Printf.sprintf "mk_cohorts: period0: cardinal=%d" (S.Iset.cardinal issues0));*)
      let periods =
        let start = S.Types.date_of_ptime after in
        let stop = S.Types.date_of_ptime before in
        match cohort_duration with
        | 30 -> S.Period.mk_dintervals_by_month ~start ~stop
        | 365 ->
            let (start,_,_) = start and (stop,_,_) = stop in
            S.Period.mk_years ~start ~stop
        | _ -> S.Period.mk_dintervals_by_days ~start ~stop cohort_duration
      in
      let rec mk_cohorts cohorts by_period c_issues remain = function
      | [] -> (cohorts, by_period, c_issues)
      | period :: qperiods ->
          let label = match period with
            | S.Period.DInterval ((y,m,_),_, _) when cohort_duration = 30 ->
                Printf.sprintf "%04d/%02d" y m
            | S.Period.DInterval ((y,m,d),_, _) ->
                Printf.sprintf "%04d/%02d/%02d" y m d
            | S.Period.Year y -> string_of_int y
            | _ -> assert false
          in
          let c = Cohorts.create ~period label in
          let cohorts = S.Imap.add c.id c cohorts in
          let by_period = S.Period.Map.add period c.id by_period in
          let issues, remain =
            let in_p = S.Period.ptime_in_period period in
            S.Imap.partition
              (fun _id (i:GH.Types.issue) -> in_p i.created_at)
              remain
          in
          let set = S.Imap.fold (fun id _ set -> S.Iset.add id set) issues S.Iset.empty in
          let c_issues = S.Imap.add c.Cohorts.id set c_issues in
          (*prerr_endline (Printf.sprintf "Cohort %d (%s): cardinal %d"
           c.id (S.Period.to_string period) (S.Iset.cardinal set));*)
          mk_cohorts cohorts by_period c_issues remain qperiods
      in
      let (cohorts, by_period, cohort_issues) =
        mk_cohorts cohorts by_period c_issues remain periods
      in
      let hist_add_period cohort_id cohort_issues period period_cohort_id hist =
        match S.Period.ptime_bounds period with
        | None -> assert false
        | Some (pt_startdate, pt_enddate) ->
            let in_period = S.Iset.filter
              (fun issue_id ->
                 let i = S.Imap.find issue_id issues in
                 Ptime.compare pt_enddate i.created_at > 0 &&
                   (match i.closed_at with
                    | None -> true
                    | Some d -> Ptime.compare pt_startdate d <= 0)
              )
                cohort_issues
            in
            let map = match S.Imap.find_opt period_cohort_id hist with
              | None -> S.Imap.empty
              | Some m -> m
            in
            let card = S.Iset.cardinal in_period in
            let map = S.Imap.add cohort_id card map in
            (*prerr_endline (
             Printf.sprintf "add cohort %d with card %d in period %d (%s)"
               cohort_id card period_cohort_id (S.Period.to_string period)) ;*)
            let hist = S.Imap.add period_cohort_id map hist in
            hist
      in
      let hist_add_cohort cid issues hist =
        S.Period.Map.fold (hist_add_period cid issues) by_period hist
      in
      let hist = S.Imap.fold hist_add_cohort cohort_issues S.Imap.empty in
      cohorts, hist

    let plot_cohorts gp ?(events=[]) ~ylabel ~after ~before cohort_duration issues =
      let cohorts, hist = mk_cohorts ~after ~before cohort_duration issues in
      (* remove events corresponding to period of first cohort ("already there") *)
      let events =
        match S.Imap.min_binding_opt cohorts with
        | None -> events
        | Some (_, c) ->
            match c.Cohorts.period with
            | None -> events
            | Some p ->
                let in_p = Statocaml.Period.date_in_period p in
                List.filter (fun ev -> not (in_p ev.Statocaml.Types.ev_date)) events
      in
      Cohorts.plot gp ~events ~event_font_size:8 ~ylabel cohorts hist

    type cohort_param =
      { after: Ptime.t [@ocf Statocaml.Types.ptime_date_wrapper, Ptime.epoch];
        before: Ptime.t [@ocf Statocaml.Types.ptime_date_wrapper, Ptime_clock.now ()];
        cohort_duration: int [@ocf Ocf.Wrapper.int, 7];
      }[@@ocf]

    let plot_issue_cohorts gp ~after ~before cohort_duration data =
      let stats = T.Period.Map.(find All data.P.stats) in
      plot_cohorts gp ~events:data.orig_events
        ~ylabel:"Open issues" ~after ~before cohort_duration stats.g_issues

    let plot_pr_cohorts gp ~after ~before cohort_duration data =
      let stats = T.Period.Map.(find All data.P.stats) in
      let issues = S.Imap.map (fun pr -> pr.P.issue) stats.g_prs in
      plot_cohorts gp ~events:data.orig_events
        ~ylabel:"Open PRs" ~after ~before cohort_duration issues

    let wrap_param f =
      Json.to_plotter cohort_param_wrapper
        (fun gp p -> f gp ~after:p.after ~before:p.before p.cohort_duration)
    let plot_issue_cohorts_json = wrap_param plot_issue_cohorts
    let plot_pr_cohorts_json = wrap_param plot_pr_cohorts
  end