RProjects/R/project/postprocessing.R

source(here::here("R/common/db_client.R"))

save_or_return <- function(results, write_to_db = FALSE) {
  if (isTRUE(write_to_db)) {
    df <- as.data.frame(results, optional = TRUE)
    status <- insert_results(df)
    return(status)
  }
  results
}

#' TODO voir ce qu'on retourne -> surement tableau de résultats, stockage en base géré dans une autre fonction
#' Met à jour les données éCow pour un cheptel
#' @param cheptel character. Code du cheptel avec le FR
#' @return A définir 
maj_ecow_by_cheptel <- function(cheptel) {
  list_chep <-list(cheptel)
  
  maj_ecow_for_list_cheptels(list_chep)
}

#' Met à jour les données éCow pour tous les cheptels suivis par un technicien
#' @param tech character. Identifiant à 5 lettres du technicien
maj_ecow_by_tech <- function(tech) {
  # On récupère tous les cheptels d'un technicien
  cheps_tech <- get_cheptels_by_tech(tech)
  # On en extrait la liste des numéros de cheptels suivi par le tech
  list_chep <- as.list(cheps_tech$numeroCheptel)
  
  maj_ecow_for_list_cheptels(list_chep)
}

#' Met à jour les données éCow pour tous les cheptels des adhérents actifs
maj_ecow_for_all <- function() {
  # On récupère tous les adhérents dans Dolibarr
  adh_hbc <- get_all_adherents_active()
  # On en extrait la liste des numéros de cheptels
  list_chep <- as.list(adh_hbc$Numchep)
  
  maj_ecow_for_list_cheptels(list_chep)
}

mafonctiondetest <- function(cheptel){ 
  source(here::here("R/common/ws_client.R"))
  cheptel_ecow <-  get_cheptel_ecow(cheptel)
  vaches <- cheptel_ecow$vaches
  return(length(vaches))
}

#' Mise à jour de l'indicateur Ecow pour une liste de cheptels et gestion des erreurs
#' @param list_cheptels  list. Liste de numéros de cheptels avec le FR devant
maj_ecow_for_list_cheptels <- function(list_cheptels){
  total <- length(list_cheptels)
  start_time <- Sys.time()
  message(sprintf("🚀 Début traitement - %s cheptels à traiter", total))
  
  res <- lapply(seq_along(list_cheptels), function(i) {
    num_chep <- list_cheptels[[i]]
    withCallingHandlers(
      tryCatch(
        {
          message(sprintf("[%s/%s] Traitement cheptel %s ...", i, total, num_chep))
          out <- calcul_ecow_by_chep(num_chep, 1) # Pour l'instant on s'arrête aux vaches
          message(sprintf("✓ OK cheptel %s", num_chep))
          out
        },
        error = function(e) {
          message(sprintf("✗ ERREUR cheptel %s : %s", num_chep, conditionMessage(e)))
          NULL
        }
      ),
      warning = function(w) {
        message(sprintf("! AVERTISSEMENT cheptel %s : %s", num_chep, conditionMessage(w)))
        invokeRestart("muffleWarning")
      }
    )
  })
  
  end_time <- Sys.time()
  duration_sec <- round(as.numeric(difftime(end_time, start_time, units = "secs")), 2)
  duration_fmt <- format_duration(duration_sec)
  message(sprintf("🏁 Fin traitement - %s cheptels traités en %s",  total, duration_fmt))
  
  return(res)
}


format_duration <- function(seconds) {
  h <- seconds %/% 3600
  m <- (seconds %% 3600) %/% 60
  s <- seconds %% 60
  sprintf("%02d:%02d:%02d", h, m, s)
}

save_data_vaches <- function(vaches){
  tabfinal <- vaches %>%
    select(
      cheptelDetenteur, anim, nom, nom_pere, embryon,
      tempsprod, age_years, ecowcarr, rg_carr,
      ptgV, agevel1, ivv1, ivv2Brut,
      prol, mort, txrepros, nbpp,
      txvf, pn_m, pn_f,
      p120_m, p120_f, p210_m, p210_f,
      ptgP,
      moyecowcamp, rg_camp
    ) %>%
    arrange(rg_carr)
  
  # Renomme les colonnes pour correspondre aux noms des champs dans la table ecow_vaches
  colnames(tabfinal) <- c(
    "cheptel", "num_vache", "nom_vache", "pere", "isu", "pourc_vie_productive", "age_annees", "note_ecow_carr", "rang_carr", "pointage_vache", "age_1_velage_m", "ivv1_j",
    "ivv2plus_j", "prolificite_pourc", "mortalite_av_sevr_pourc", "pourc_produits_repros", "nb_petits_produits", "pourc_velages_tranquilles", "pn_males_kg",
    "pn_femelles_kg", "p120_males_kg", "p120_femelles_kg", "p210_males_kg", "p210_femelles_kg", "pointage_produits", "moy_notes_ecow_campagne", "rang_campagne"
  )
  
  tab_format <- tabfinal %>%
    mutate(
      across(
        where(is.character),
        ~ str_replace_all(.x, ",", ".")
      ),
      isu = case_when(
        isu == "O" ~ TRUE,
        isu == "N" ~ FALSE,
        TRUE       ~ NA
      ),
      rang_carr = as.numeric(rang_carr)
    )
  
  con <- get_db_connection()
  
  dbWriteTable(
    con,
    Id(schema = "hbc", table = "ecow_vaches"),
    tab_format,
    append = TRUE,
    row.names = FALSE
  )
  dbDisconnect(con)
}

save_data_campagne <- function(synth_camp){
  # Stockage des données écow_camp
  filtered_prod_camp <- synth_camp %>%
    select(
      cheptel, numeroMipg, dateNaiss, rangVelageMipg, ecowcamp, nom_pere, produits
    )
  
  colnames(filtered_prod_camp) <- c(
    "cheptel", "mere_ipg", "danais", "ravelamer_corr", "note_ecow", "pere", "produits"
  )
  
  con <- get_db_connection()
  
  dbWriteTable(
    con,
    Id(schema = "hbc", table = "ecow_campagne"),
    filtered_prod_camp,
    append = TRUE,
    row.names = FALSE
  )
  dbDisconnect(con) 
}

save_data_taureau <- function(data_taureaux, cheptel){
  # Stockage des données écow_taureaux
  filtered_taureaux <- data_taureaux %>%
    select(
      cheptelDetenteur, pereGenetique, nb_prod_in_chep, utilgen, prol, mort, txrepros, nbpp, txvf, pnm, pnf, p120m, p120f, p210m, p210f, 
      dmsev, dssev, afsev, nbfilles_avecprod, pctfilles_avecprod, isu_fillestot, age_sort_fillestot, agevel1_fillestot, ivv1_fillestot, ivv2p_fillestot, 
      vieprod_fillestot, dmad_fillestot, dsad_fillestot, afad_fillestot, nbprod_fillestot, txrepros_fillestot, nbpp_fillestot, prol_fillestot,
      mort_fillestot, txvf_fillestot, nbfillesact_avecprod, pctfillesact_avecprod, isu_fillesact, age_sort_fillesact, agevel1_fillesact, ivv1_fillesact, 
      ivv2p_fillesact, vieprod_fillesact, dmad_fillesact, dsad_fillesact, afad_fillesact, nbprod_fillesact, txrepros_fillesact, nbpp_fillesact,
      prol_fillesact, mort_fillesact, txvf_fillesact, nbfilles_renouv
    )
  
  colnames(filtered_taureaux) <- c(
    "cheptel", "anim", "nb_prod_in_chep", "utilgen", "prol", "mort", "txrepros", "nbpp", "txvf", "pnm", "pnf", "p120m", "p120f", "p210m", "p210f", 
    "dmsev", "dssev", "afsev", "nbfilles_avecprod", "pctfilles_avecprod", "isu_fillestot", "age_sort_fillestot", "agevel1_fillestot", "ivv1_fillestot", "ivv2p_fillestot", 
    "vieprod_fillestot", "dmad_fillestot", "dsad_fillestot", "afad_fillestot", "nbprod_fillestot", "txrepros_fillestot", "nbpp_fillestot", "prol_fillestot", 
    "mort_fillestot", "txvf_fillestot", "nbfillesact_avecprod", "pctfillesact_avecprod", "isu_fillesact", "age_sort_fillesact", "agevel1_fillesact", "ivv1_fillesact", 
    "ivv2p_fillesact", "vieprod_fillesact", "dmad_fillesact", "dsad_fillesact", "afad_fillesact", "nbprod_fillesact", "txrepros_fillesact", "nbpp_fillesact", 
    "prol_fillesact", "mort_fillesact", "txvf_fillesact", "nbfilles_renouv"
  )
  
  filtered_taureaux$cheptel <- cheptel

  con <- get_db_connection()
  
  dbWriteTable(
    con,
    Id(schema = "hbc", table = "ecow_taureaux"),
    filtered_taureaux,
    append = TRUE,
    row.names = FALSE
  )
  dbDisconnect(con) 
}

save_data_lignees <- function(stats_lignees){
  con <- get_db_connection()
  
  dbWriteTable(
    con,
    Id(schema = "hbc", table = "ecow_lignees"),
    stats_lignees,
    append = TRUE,
    row.names = FALSE
  )
  dbDisconnect(con) 
}