From a3363fff11068e7558d89f96f392e5aa39588e62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9a?= Date: Wed, 2 Sep 2026 18:10:10 +0200 Subject: [PATCH] [eCow] Correctif environnement --- R/common/ws_client.R | 7 +++---- R/project/ecow_calculations.R | 9 +++------ R/project/preprocessing.R | 9 ++++++--- 3 files changed, 12 insertions(+), 13 deletions(-) diff --git a/R/common/ws_client.R b/R/common/ws_client.R index 75d40e3..1d2705e 100755 --- a/R/common/ws_client.R +++ b/R/common/ws_client.R @@ -142,14 +142,13 @@ get_params_ponderation <- function(num_cheptel){ #' Récupère le nombre de veaux total par parents à partir d'une extraction excel complétée par les données SPIE #' Le nombre renvoyé est le nombre total tous cheptels confondus, sans détail sur les veaux -get_parents_ipg <- function(){ +get_parents_ipg <- function(cheptel){ # Extraction du fichier excel contenant les données de la table bovide du SIG jusqu'au 06/01/2026 meresIPG <- read_csv(paste(rep_imp, "nb_prod_IPG_byMERE_20260106.csv", sep=''), show_col_types = FALSE) colnames(meresIPG) <- c('ANIM','NBPRODSIG') - # Extraction SPIE pour compléter à partir du 03/01/2026 (choix date pour essayer de limiter les doublons et manquement) url_meres_spie <- paste0(server_path, "webresources/spie/nbprodbymeresince2026/") - meres_spie_brut <- http_get(url = paste0(url_meres_spie, num_cheptel)) + meres_spie_brut <- http_get(url = paste0(url_meres_spie, cheptel)) meres_spie <- as.data.frame(meres_spie_brut, stringsAsFactors = FALSE) colnames(meres_spie) <- c('ANIM','NBPRODSPIE') meres_spie$NBPRODSPIE <- as.numeric(meres_spie$NBPRODSPIE) @@ -164,7 +163,7 @@ get_parents_ipg <- function(){ # Extraction SPIE pères url_peres_spie <- paste0(server_path, "webresources/spie/nbprodbyperesince2026/") - peres_spie_brut <- http_get(url = paste0(url_peres_spie, num_cheptel)) + peres_spie_brut <- http_get(url = paste0(url_peres_spie, cheptel)) peres_spie <- as.data.frame(peres_spie_brut, stringsAsFactors = FALSE) colnames(peres_spie) <- c('ANIM','NBPRODSPIE') peres_spie$NBPRODSPIE <- as.numeric(peres_spie$NBPRODSPIE) diff --git a/R/project/ecow_calculations.R b/R/project/ecow_calculations.R index abe987a..8f949d3 100755 --- a/R/project/ecow_calculations.R +++ b/R/project/ecow_calculations.R @@ -49,7 +49,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) { by = c("pereGenetique" = "anim") ) # Récupère les produits ajout des données manquantes - produits_cheptel <- add_data_ecow(cheptel_ecow$produits, cheptel_ecow$nomsparents, czhbc) + produits_cheptel <- add_data_ecow(cheptel_ecow$produits, cheptel, cheptel_ecow$nomsparents, czhbc) ################################################################################################################### @@ -71,9 +71,6 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) { 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 - pps <- params_ponderation$pointage$sevrage - # Ajout à la table vache des informations synthétisées de leur veaux synth_brute_vaches <- get_synth_prod_parent(vaches, prod_vaches_corr, params_ponderation) @@ -133,7 +130,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) { filter(sexe == 2) # Petits produits issus des filles des taureaux nés dans le cheptel - pprod_filles_taureaux <- add_data_ecow(cheptel_ecow$petits_produits, cheptel_ecow$nomsparents, czhbc) + pprod_filles_taureaux <- add_data_ecow(cheptel_ecow$petits_produits, cheptel, cheptel_ecow$nomsparents, czhbc) # Calcul de la synthèse par fille de leur produits synth_filles_taureaux <- get_synth_prod_parent(filles_taureaux, pprod_filles_taureaux, params_ponderation) @@ -189,7 +186,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) { ################################################################################################################### message("Début partie Lignées") fondatrices <- cheptel_ecow$fondatrices - descendants <- add_data_ecow(cheptel_ecow$descendants, cheptel_ecow$nomsparents, czhbc) + descendants <- add_data_ecow(cheptel_ecow$descendants, cheptel, cheptel_ecow$nomsparents, czhbc) vaches_lignees <- descendants %>% filter(anim %in% descendants$mereGenetique) produits_lignees <- descendants %>% filter(mereGenetique %in% vaches_lignees$anim) diff --git a/R/project/preprocessing.R b/R/project/preprocessing.R index f3e7f5d..a370c28 100755 --- a/R/project/preprocessing.R +++ b/R/project/preprocessing.R @@ -9,11 +9,11 @@ source(here::here('R/common/utils.R')) #' Met en forme le tableau des produits des vaches #' Ajoutes les colonnes nécessaires au calcul du rang ecow des vaches #' @param produits_vaches dataframe. Tab des produits des vaches du cheptel -add_data_ecow <- function(liste_produits, noms_parents, czhbc){ +add_data_ecow <- function(liste_produits, cheptel, noms_parents, czhbc){ #Ajout d'une colonne avec le nombre de produits IPG (croisement base SIG et SPIE) - parents_ipg <- get_parents_ipg() - liste_produits <- base::merge(liste_produits, get_parents_ipg(), by.x='anim', by.y='ANIM', all.x=T, all.y=F) + parents_ipg <- get_parents_ipg(cheptel) + liste_produits <- base::merge(liste_produits, parents_ipg, by.x='anim', by.y='ANIM', all.x=T, all.y=F) noms_parents <- as.data.frame(noms_parents) liste_produits$nommere <- noms_parents$V2[match(liste_produits$numeroMipg, noms_parents$V1)] liste_produits$nompere <- noms_parents$V2[match(liste_produits$pereGenetique, noms_parents$V1)] @@ -318,6 +318,9 @@ get_note_carriere <- function(v_ref, params_ponderation){ } get_note_campagne <- function(prod_vaches_corr, params_ponderation){ + + # On récupère les coefficients de pondération pour les pointages au sevrage + pps <- params_ponderation$pointage$sevrage # Groupement et synthèse des données des produits par vache / date de naissance / rang de vélage de la mère # Ca permet de grouper les jumeaux