[éCow] Correctifs vaches et avancement taureaux

R/common/prepare_data.R

@@ -8,6 +8,7 @@ suppressPackageStartupMessages({
 #' @param tab_anims dataframe. Liste d'animaux brute
 #' @return Liste d'animaux nettoyée
 clean_data_anims<- function(tab_anims){
+  if (nrow(tab_anims) == 0) return()
   result_data <- tab_anims %>%
     mutate(
       dateNaiss = as.Date(as.POSIXct(dateNaiss / 1000, origin = "1970-01-01", tz = "UTC")),

R/common/ws_client.R

@@ -35,6 +35,7 @@ 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))
+  if(nrow(active_by_chep$vaches) == 0 ) return(active_by_chep)
   donneuses <- active_by_chep$donneuses
   active_by_chep$donneuses <- NULL
   # Nettoyage des données pour les listes reçues

R/project/ecow_calculations.R

@@ -19,6 +19,8 @@ source(here::here("R/project/preprocessing.R"))
 #' @param cheptel character. Numéro du cheptel avec le FR devant
 calcul_ecow_by_chep <- function(cheptel, step = 3) {
   t0 <- Sys.time()
+  
+  ######################################     Préparation des données       ##########################################
 
   # Récupère les paramètres de pondération
   params_ponderation <- get_params_ponderation(cheptel)
@@ -28,13 +30,15 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   message("Début import des données")
   cheptel_ecow <- get_cheptel_ecow(cheptel)
   
-  ###################################################################################################################
-  ####################################     Calcul ecow pour les vaches       ########################################
-  ###################################################################################################################
-  message("Début partie vaches")
   # Vaches actives ayant déjà eu une fin de gestation
   vaches <- cheptel_ecow$vaches
   
+  if (length(vaches) == 0) {
+    t1 <- Sys.time()
+    message("Arrêt du traitement, aucunes vaches à traiter. Temps d'exécution : ", round(difftime(t1, t0, units = "secs"), 2), " sec")
+    return(invisible(NULL))  
+  }
+  
   # Récupère les taureaux : tous les pères des vaches actives ou de tous les veaux des vaches actives
   taureaux <- cheptel_ecow$taureaux
   # Ajout du nom du père
@@ -43,14 +47,19 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
       taureaux %>% select(anim, nom_pere = nom),
       by = c("pereGenetique" = "anim")
     )
-
+  # Récupère les produits ajout des données manquantes
+  produits_cheptel <- add_data_ecow(cheptel_ecow$produits, czhbc)
+  
+  
+  ###################################################################################################################
+  ####################################     Calcul ecow pour les vaches       ########################################
+  ###################################################################################################################
+  message("Début partie vaches : ", length(vaches), " vaches à traiter.")
+  
   # 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)
-  
   # Récupère les produits des vaches actives du cheptel et les embryons portés dans le cheptel
   produits_vaches <- produits_cheptel %>%
     filter(numeroMipg %in% vaches$anim)
@@ -80,14 +89,14 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   synth_prod_vache <- prod_vaches_corr %>%
     group_by(numeroMipg, dateNaiss, rangVelageMipg) %>%
     summarise(
-      ivv    = first(ivv1),  # ------------------------------------------------------------------------- vraiment pas sure, à valider
+      ivv    = first(ivv1),  # ------------------------------------------------------------------------- TODO vraiment pas sure, à valider
       pn_c   = round(mean(pn_corr, na.rm = TRUE), 1),
       txvf   = round(mean(conditionNaiss %in% c('1','2')) * 100, 1),
       txm    = round(mean(sexe == '1') * 100, 1),
       ptgp   = round(mean(pps$devmus * dmSevrage + pps$devsqe * dsSevrage + pps$af * afSevrage, na.rm = TRUE), 1),
       p120_c = round(mean(pat120Corrige, na.rm = TRUE), 1),
       p210_c = round(mean(pat210Corrige, na.rm = TRUE), 1),
-      prol   = n() * 100,  # TODO ---------------------a tester parce que je pense qu'il faudrait tous les produits d'une vache
+      prol   = n() * 100,  # --------------------- TODO a tester parce que je pense qu'il faudrait tous les produits d'une vache
       mort   = round(mean(mortsev == "O" | mortnat == "O") * 100, 1),
       pere   = first(pereGenetique),
       cheptel = first(cheptelNaiss),
@@ -221,9 +230,14 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   message("Enregistrement données vaches")
   
   # Enregistrement des données des vaches en base
+  v_camp <- v_camp %>%
+    mutate(across(where(is.numeric), ~ trunc(.x * 100) / 100))
+  
   save_data_vaches(v_camp)
   
   # Enregistrement des données de campagne en base
+  synth_prod_vache_n <- synth_prod_vache_n %>%
+    mutate(across(where(is.numeric), ~ trunc(.x * 100) / 100))
   save_data_campagne(synth_prod_vache_n)
 
   if (step == 1) {
@@ -250,10 +264,10 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   # TODO quel effet chep ? Comment on l'applique ? 
   # PLUS besoin de calculer effet chep car pas de calcul de rang -> fonction de synth à modifier
   
-  synth_filles_taureaux <- get_synth_prod_vaches(filles_taureaux, pprod_filles_taureaux, params_ponderation, stats_chep)
+  synth_ft <- get_synth_prod_vaches(filles_taureaux, pprod_filles_taureaux, params_ponderation)
+  synth_filles_taureaux <- synth_ft$synthese
   
   # Calcul des stats par pere
-  
   stats_peres <- produits_taureaux %>%
     group_by(pereGenetique) %>%
     summarise(
@@ -261,7 +275,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
       .groups = "drop"
     ) %>%
     filter(nb_prod_in_chep >= 5)
-  
+
   stats_prod_directe <- produits_taureaux %>%
     group_by(pereGenetique) %>%
     summarise(
@@ -286,14 +300,14 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
       p210m = round(mean(pat210[sexe == "1"], na.rm = TRUE), 1),
       p210f = round(mean(pat210[sexe == "2"], na.rm = TRUE), 1),
       
-      dmsev = round(mean(dmSevrage, na.rm = TRUE), 1), # TODO -------- a voir avec Lauréna, pq dm pour mal et ds pour femelle ? Faut-il ajouter af ?
+      dmsev = round(mean(dmSevrage, na.rm = TRUE), 1),
       dssev = round(mean(dsSevrage, na.rm = TRUE), 1),
       afsev = round(mean(afSevrage, na.rm = TRUE), 1),
 
       nb_femelles = sum(sexe == "2", na.rm = TRUE),
       .groups = "drop"
     )
-  
+
   stats_filles <- synth_filles_taureaux %>%
     group_by(pereGenetique) %>%
     summarise(
@@ -320,7 +334,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
       
       .groups = "drop"
     )
-  
+
   stats_filles_act <- synth_filles_taureaux %>%
     filter(is.na(dateSortDetenteur)) %>%
     group_by(pereGenetique) %>%
@@ -328,7 +342,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
       nbfillesact_avecprod = sum(NBPRODIPG > 0, na.rm = TRUE),
       pctfillesact_avecprod = round(nbfillesact_avecprod / n() * 100, 1),
       
-      isu_fillesact      = ifelse(n() >= 3, round(mean(embryon, na.rm = TRUE), 1), NA),
+      isu_fillesact      = 0,
       age_sort_fillesact = ifelse(n() >= 3, round(mean(age_years, na.rm = TRUE), 1), NA),
       agevel1_fillesact  = ifelse(n() >= 3, round(mean(agevel1, na.rm = TRUE), 1), NA),
       ivv1_fillesact     = ifelse(n() >= 3, round(mean(ivv1, na.rm = TRUE), 1), NA),
@@ -370,6 +384,14 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
     dplyr::left_join(stats_filles_renouv,  by = "pereGenetique") %>%
     dplyr::left_join(taureaux,             by = "pereGenetique")
   
+  # Récupère le nom 
+  stats_taureaux <- stats_taureaux %>%
+    select(-nom, -dateNaiss, -nomCheptelNaiss) %>%
+    dplyr::left_join(taureaux %>% select(anim, nom, dateNaiss, nomCheptelNaiss),
+      by = c("pereGenetique" = "anim")) %>%
+    mutate(nom = replace(nom, is.na(nom), ""))  %>%
+    mutate(across(where(is.numeric), ~ trunc(.x * 100) / 100))
+
   save_data_taureau(stats_taureaux, cheptel)
   
   if (step == 2) {

R/project/postprocessing.R

@@ -166,7 +166,7 @@ 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, 
+      cheptelDetenteur, pereGenetique, nom, dateNaiss, nomCheptelNaiss, 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, 
@@ -175,7 +175,7 @@ save_data_taureau <- function(data_taureaux, cheptel){
     )
   
   colnames(filtered_taureaux) <- c(
-    "cheptel", "anim", "nb_prod_in_chep", "utilgen", "prol", "mort", "txrepros", "nbpp", "txvf", "pnm", "pnf", "p120m", "p120f", "p210m", "p210f", 
+    "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", 

R/project/preprocessing.R

@@ -12,6 +12,7 @@ source(here::here('R/common/utils.R'))
 add_data_ecow <- function(liste_produits, czhbc){
 
   #Ajout d'une colonne avec le nombre de produits IPG ------------------ TODO PEUT ETRE PLUS UTILE, à comparer avec nb_fin_gestation
+  # Croisement avec les données 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)