Générer des diagrammes CONSORT et autres flowcharts sous R

#' filter_df_flowchart_expr
#'
#' @param z data.frame contenant les données (colonnes) à filtrer
#' @param filters liste de filtre (éléments à écarter par mise à NA)
#' exemple : list("valeurs de A trop faibles"="A < 3", "B en dehors de (10;20)"="B<10 | B>20")
#' @param preserve_cols colonne 
#' @param count_col colonne(s) à préserver de la mise à NA
#' @param flowchart_file nom du fichier d'image du graphique à sauvegarder
#' @param prct_round nb de chiffres après la virgule pour le prcent (2 par défaut)
#' @param couleurs vecteurs des couleurs à utiliser (par défaut 
#' \code{palette.colors(n = 30, palette = "Polychrome 36")})
#' @param width largeur de l'image
#' @param height hauteur de l'image
#' @param res résolution de l'image
#' @param title titre
#' @param draw_flowchart TRUE (par défaut) si on veut tracer le flowchart à l'écran
#' @param silent TRUE si on veut inhiber la sortie print() (FALSE par défaut)
#' @param kable_format format utilisé pour knitr::kable  ("rst" par défaut)
#'
#' @returns
#' une longue liste avec les résultats
#' @export
#'
#' @examples
#'  filter_df_flowchart_expr(iris, 
#'      list("SL>6"=" Sepal.Length  >6", "setosa seules"="Species=='setosa'"),  
#'      couleurs=c("blue", "beige"))
filter_df_flowchart_expr <- function(
    z,
    filters = list(),
    preserve_cols = "Cycle",
    count_col = NULL,
    flowchart_file = NULL,
    prct_round = 2,
    couleurs = palette.colors(n = 30, palette = "Polychrome 36"),
    width = 3000, height = 4000, res = 600,
    title = "Filtrage successif des données",
    draw_flowchart = TRUE,
    silent = FALSE,
    kable_format = "rst"
) {
  if (!is.data.frame(z)) stop("z doit être un objet xts")
  if(is.null(count_col)){
    count_col <- tail(make.names(c(names(z), "ZZZ"), unique=T),1)
    eval(parse(text=sprintf("z$%s <- 1:(dim(z)[1])", count_col)))
  }
  if (!count_col %in% colnames(z)) stop(paste(count_col, "absente dans z"))
  if (is.null(names(filters))) names(filters) <- filters
  
  z_original <- z
  z_filtered <- z
  df <- as.data.frame(z)
  
  # === Ligne "initial" demandée ===
  initial_total_lignes   <- nrow(z)                                      # nb total de lignes
  initial_na_count_col   <- sum(is.na(z[, count_col]))                   # déjà NA dans count_col
  initial_exclus         <- initial_na_count_col              # partie imaginaire = NA initiau
  initial_restants       <- initial_total_lignes - initial_na_count_col
  initial_pourcent       <- round(100 * initial_restants / initial_total_lignes, 2) 
  
  # On garde la valeur "classique" utilisée ensuite pour les pourcentages relatifs
  initial_n <- sum(!is.na(z_filtered[, count_col]))                      # individus valides au départ pour les calculs suivants
  
  # Flowchart de départ
  fc <- df |> as_fc()
  
  stats <- list()
  
  # Ajout de la ligne initiale
  stats[["initial"]] <- list(
    expression_NA_faiseuse = "État initial",
    exclus = initial_exclus,          # complexe : partie réelle = 0, imaginaire = nb NA initiaux
    restants = initial_restants,
    pourcent_restant = initial_pourcent
  )
  
  
  
  for (i in seq_along(filters)) {
    expr_str <- filters[[i]]
    col_ref  <- names(filters)[[i]]
    
    na_before <- sum(is.na(z_filtered[, count_col]))
    
    keep <- tryCatch({
      !eval(parse(text = expr_str), envir = df, enclos = parent.frame())
    }, error = function(e) {
      warning(sprintf("Expression invalide ignorée : %s\nErreur : %s", expr_str, e$message))
      rep(TRUE, nrow(df))
    })
    
    if (!is.logical(keep) || length(keep) != nrow(df)) {
      warning(sprintf("Expression '%s' n'a pas renvoyé un vecteur logique de bonne taille → ignorée", expr_str))
      keep <- rep(TRUE, nrow(df))
    }
    keep[is.na(keep)] <- FALSE
    
    if (!all(keep)) {
      cols_to_na <- setdiff(colnames(z_filtered), preserve_cols)
      z_filtered[!keep, cols_to_na] <- NA
      df[!keep, cols_to_na] <- NA
    }
    
    exclus   <- sum(is.na(z_filtered[, count_col])) - na_before
    restants <- initial_n - sum(is.na(z_filtered[, count_col]))
    
    stats[[col_ref]] <- list(
      expression_NA_faiseuse = expr_str,
      exclus = exclus ,
      restants = restants,
      pourcent_restant = round(100 * restants / initial_n, prct_round)
    )
    
    if ( draw_flowchart | !is.null(flowchart_file)) {
      cond_display <- if (grepl("^is\\.na\\(", expr_str)) {
        "Absence de valeur pour certaines variables"
      } else if (grepl("&|\\|", expr_str)) {
        expr_str
      } else {
        gsub("([A-Za-z][A-Za-z0-9_]*)", "`\\1`", expr_str)
      }
      
      lab <- paste0("Filtre : ", col_ref)
      
      call_text <- sprintf(
        'fc <- fc |> fc_filter(!(%s),
         show_exc = TRUE,
         label_exc = "%s",
         text_pattern=paste0("{label}\\n{n} soit ", stats[[col_ref]]$pourcent_restant, "%%initial"),
         text_pattern_exc = "{label}\\n{n} exclus ({perc}%%)",
         bg_fill_exc = "%s")',
        expr_str, lab, couleurs[(i-1) %% length(couleurs) + 1]
      )
      eval(parse(text = call_text))
    }
  }
  
  
  if (!is.null(flowchart_file)) {
    xx <- fc |> fc_draw(title = title) |>
      fc_export(flowchart_file, width = width, height = height, res = res)
    cat("*** Flowchart généré avec succès --> ", flowchart_file, "\n")
  }
  
  # Conversion en data.frame pour affichage propre
  uu <- data.frame(t(data.frame(lapply(stats, FUN=unlist), check.names = F)))
  stats_as_df <- data.frame(critere=row.names(uu),
                            expression_NA_faiseuse=uu[,1], 
                            uu[,-1] |> lapply(as.numeric) )
  # Affichage spécial pour la ligne "initial" : on montre les NA initiaux séparément
  if (!silent) {
    # On crée une version lisible
    nice_df <- stats_as_df
    nice_df[1, "exclus"] <- paste0("0 (", initial_na_count_col, " NA déjà présents)")
    print(knitr::kable(nice_df, format = kable_format))
  }
  if (draw_flowchart) {
    fc |> fc_draw(title = title)
  }
  return( invisible( list(
    z_original = z_original,
    z_filtered = z_filtered,
    stats = stats,
    stats_as_df = stats_as_df,
    initial_total = initial_total_lignes,
    initial_na_in_count_col = initial_na_count_col,
    initial_valid = initial_n,
    final_remaining = max(0, restants),
    flowchart = if (!is.null(flowchart_file)) flowchart_file else NULL, 
    fc=fc
  ) )
  )
}