Ajout donneuses/porteuses

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

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 

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"
   )

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(