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) } #' 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)) flush.console() 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)) flush.console() out <- calcul_ecow_by_chep(num_chep, 3) # Pour l'instant on s'arrête aux vaches message(sprintf("✓ OK cheptel %s", num_chep)) flush.console() out }, error = function(e) { message(sprintf("✗ ERREUR cheptel %s : %s", num_chep, conditionMessage(e))) flush.console() NULL } ), warning = function(w) { message(sprintf("! AVERTISSEMENT cheptel %s : %s", num_chep, conditionMessage(w))) flush.console() 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) } maj_ecow_from_csv <- function() { cheptels <- read.csv('cheptels_liste.csv', stringsAsFactors = FALSE) if (!"login" %in% names(cheptels)) { stop("Colonne 'login' absente du CSV") } if (nrow(cheptels) == 0) { message("Aucun cheptel à traiter") return(NULL) } maj_ecow_for_list_cheptels(as.list(cheptels$login)) } format_duration <- function(seconds) { h <- as.integer(seconds %/% 3600) m <- as.integer((seconds %% 3600) %/% 60) s <- as.integer(seconds %% 60) sprintf("%02d:%02d:%02d", h, m, s) } save_data_vaches <- function(vaches){ tabfinal <- vaches %>% select( cheptelDetenteur, anim, nom, nom_pere, embryon, donneuse, porteuse, 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", "donneuse", "porteuse", "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){ # Stockage des données écow_taureaux filtered_taureaux <- data_taureaux %>% select( cheptel, pereGenetique, nom, dateNaiss, nomCheptelNaiss, nb_prod_in_chep, utilgen, prol, mort, txrepros, nbpp, txvf, pnm, pnf, p120m, p120f, p210m, p210f, dmsev, dssev, afsev, fillestot_nbavecprod, fillestot_pctavecprod, fillestot_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, fillesact_nbavecprod, fillesact_pctavecprod, fillesact_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, nbfilles_renouv ) colnames(filtered_taureaux) <- c( "cheptel", "anim", "nom", "date_naissance", "nom_chep_naiss", "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" ) 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){ filtered_lignees <- stats_lignees %>% select( cheptel, fondatrice, nom, dateNaiss, nomCheptelNaiss, nb_prod_in_chep, utilgen, prol, mort, txrepros, nbpp, txvf, pnm, pnf, p120m, p120f, p210m, p210f, dmsev, dssev, afsev, femtot_nbavecprod, femtot_pctavecprod, femtot_isu, femtot_age_sort, femtot_agevel1, femtot_ivv1, femtot_ivv2p, femtot_vieprod, femtot_dmad, femtot_dsad, femtot_afad, femtot_nbprod, femtot_txrepros, femtot_nbpp, femtot_prol, femtot_mort, femtot_txvf, femact_nbavecprod, femact_pctavecprod, femact_isu, femact_age_sort, femact_agevel1, femact_ivv1, femact_ivv2p, femact_vieprod, femact_dmad, femact_dsad, femact_afad, femact_nbprod, femact_txrepros, femact_nbpp, femact_prol, femact_mort, femact_txvf, nbfilles_renouv ) colnames(filtered_lignees) <- c( "cheptel", "anim", "nom", "date_naissance", "nom_chep_naiss", "nb_desc_in_chep", "utilgen", "prol", "mort", "txrepros", "nbpp", "txvf", "pnm", "pnf", "p120m", "p120f", "p210m", "p210f", "dmsev", "dssev", "afsev", "nbfem_avecprod", "pctfem_avecprod", "isu_femtot", "age_sort_femtot", "agevel1_femtot", "ivv1_femtot", "ivv2p_femtot", "vieprod_femtot", "dmad_femtot", "dsad_femtot", "afad_femtot", "nbprod_femtot", "txrepros_femtot", "nbpp_femtot", "prol_femtot", "mort_femtot", "txvf_femtot", "nbfemact_avecprod", "pctfemact_avecprod", "isu_femact", "age_sort_femact", "agevel1_femact", "ivv1_femact", "ivv2p_femact", "vieprod_femact", "dmad_femact", "dsad_femact", "afad_femact", "nbprod_femact", "txrepros_femact", "nbpp_femact", "prol_femact", "mort_femact", "txvf_femact", "nbfem_renouv" ) con <- get_db_connection() dbWriteTable( con, Id(schema = "hbc", table = "ecow_lignees"), filtered_lignees, append = TRUE, row.names = FALSE ) dbDisconnect(con) }