From ea76a07d6108b9a1bea1cbeab32cd90167d72e91 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9a?= Date: Fri, 12 Jun 2026 15:51:04 +0200 Subject: [PATCH] Ajout donneuses/porteuses --- R/common/ws_client.R | 4 ++++ R/project/ecow_calculations.R | 8 ++++++-- R/project/postprocessing.R | 4 ++-- R/project/preprocessing.R | 4 ++-- 4 files changed, 14 insertions(+), 6 deletions(-) diff --git a/R/common/ws_client.R b/R/common/ws_client.R index 98f4220..b2504b2 100755 --- a/R/common/ws_client.R +++ b/R/common/ws_client.R @@ -35,8 +35,12 @@ http_get <- function(url, method = "GET", params = NULL, headers = NULL, auth = get_cheptel_ecow <- function(num_cheptel){ url_active_by_chep <- paste0(server_path, "webresources/animals/findInventaireEcowByChep/") active_by_chep <- http_get(url = paste0(url_active_by_chep, num_cheptel)) + donneuses <- active_by_chep$donneuses + active_by_chep$donneuses <- NULL # Nettoyage des données pour les listes reçues active_by_chep <- lapply(active_by_chep, clean_data_anims) + active_by_chep$donneuses <- donneuses + return(active_by_chep) } #' Renvoie la liste des adhérents HBC actifs dans Dolibarr diff --git a/R/project/ecow_calculations.R b/R/project/ecow_calculations.R index 16c485c..5ed64b9 100755 --- a/R/project/ecow_calculations.R +++ b/R/project/ecow_calculations.R @@ -43,7 +43,11 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) { taureaux %>% select(anim, nom_pere = nom), by = c("pereGenetique" = "anim") ) - + + # Ajout info donneuses + donneuses <- cheptel_ecow$donneuses + vaches$donneuse <- vaches$anim %in% donneuses + # Récupère les produits ajout des données manquantes produits_cheptel <- add_data_ecow(cheptel_ecow$produits, czhbc) @@ -54,7 +58,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) { # Récupère les effets cheptel # TODO A REVOIR AVEC LAURENA effets <- get_effets_cheptel(produits_vaches) rapport_MF <- effets$rapport_MF - + prod_vaches_corr <- apply_effet_chep(produits_vaches, effets$effets_chep, effets$rapport_MF) # On récupère les coefficients de pondération pour les pointages au sevrage diff --git a/R/project/postprocessing.R b/R/project/postprocessing.R index 3ba9973..e5afd60 100755 --- a/R/project/postprocessing.R +++ b/R/project/postprocessing.R @@ -95,7 +95,7 @@ format_duration <- function(seconds) { save_data_vaches <- function(vaches){ tabfinal <- vaches %>% select( - cheptelDetenteur, anim, nom, nom_pere, embryon, + cheptelDetenteur, anim, nom, nom_pere, embryon, donneuse, porteuse, tempsprod, age_years, ecowcarr, rg_carr, ptgV, agevel1, ivv1, ivv2Brut, prol, mort, txrepros, nbpp, @@ -108,7 +108,7 @@ save_data_vaches <- function(vaches){ # 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", + "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" ) diff --git a/R/project/preprocessing.R b/R/project/preprocessing.R index 646baff..6a337d7 100755 --- a/R/project/preprocessing.R +++ b/R/project/preprocessing.R @@ -115,7 +115,7 @@ get_synth_prod_vaches <- function(vaches, produits, params_ponderation){ campn_max = {cn <- campagneNaiss[!is.na(campagneNaiss)]; if (length(cn)) max(cn) else NA_integer_}, nbcampvel = ifelse(!is.na(campn_min) & !is.na(campn_max), campn_max - campn_min + 1, NA_integer_), - #porteuse = summary$embryon, + porteuse = any(embryon == 'O'), # date du dernier anais (dernier événement) last_danais = {d <- dateNaiss[!is.na(dateNaiss)]; if (length(d)) max(d) else as.Date(NA)}, @@ -198,7 +198,7 @@ get_synth_prod_vaches <- function(vaches, produits, params_ponderation){ prol = round(n_veaux / nbcampvel * 100, 1), # pointage produits - ptgP = round(pps$devmus * mean_devmus + pps$devsqe * mean_devsqe + pps$af * mean_af, 1) + ptgP = ifelse( is.na(mean_devmus), NA_real_, round(pps$devmus * mean_devmus + pps$devsqe * mean_devsqe + pps$af * mean_af, 1)) ) %>% # Conversion des NaN en NA sur certaines moyennes mutate(across(