[éCow] Correctifs vaches et avancement taureaux

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