[éCow] Correctifs taureaux lignées

R/common/ws_client.R

@@ -61,6 +61,15 @@ get_cheptels_by_tech <- function(tech){
   )
 }
 
+#' Suppression des données du jour
+#' @param cheptel Numéro du cheptel
+#' @param table Nom de la table dont on veut supprimer les données : VACHES, CAMPAGNES, TAUREAUX, LIGNEES
+#' @return Nombre de lignes supprimées
+delete_data_today <- function(cheptel, table){
+  url_delete_data <- paste0(server_path,"webresources/ecow/delete/",cheptel,"/",table)
+  delete_data <- http_get( url = url_delete_data)
+}
+
 #' Renvoie la liste des certificats zoo totaux (Vivants + semences + embryons)
 #' @return Liste de cz
 get_cztotaux <- function(){
@@ -132,49 +141,8 @@ get_params_ponderation <- function(num_cheptel){
   dbDisconnect(con)
   
   return(format_ponderation(data))
-}  
-
-#######################################################################################################
-###################### Rien a voir avec ecow - WS pedigree de Pauline #################################
-fake <- function(){
-  library(httr)
-  library(jsonlite)
-  
-  animalIds <- c("FR7122418163","FR7122406165", "FR7122363258", "FR7122234414", "FR0311285868", "FR7122363239", "FR7122363251", "FR7122380260", "FR7122380284", "FR7122363268")
-  
-  body <- list(
-    animalsIds = animalIds,
-    #nbGenerations = 5,
-    voieFemelle = TRUE,
-    cheptel = "FR71499477"
-  )
-  
-  response <- POST(
-    #url = "https://tomcat.herdbookcharolais.com/HbcSchedulerAndServices-2.0-SNAPSHOT/webresources/animals/getpedigreebyanimlist/",
-    url = "http://localhost:8080/HbcSchedulerAndServices/webresources/animals/getpedigreebyanimlist",
-    body = toJSON(body, auto_unbox = TRUE, null = "null"),
-    encode = "json"
-  )
-  
-  animalIds <- c("FR0800761491","FR0800761869")
-  
-  body <- list(
-    animalsIds = animalIds,
-    voieFemelle = TRUE,
-    cheptel = "FR08021009"
-  )
-  
-  response <- POST(
-    #url = "https://tomcat.herdbookcharolais.com/HbcSchedulerAndServices-2.0-SNAPSHOT/webresources/animals/getfondatrices/",
-    url = "http://localhost:8080/HbcSchedulerAndServices/webresources/animals/getfondatrices",
-    body = toJSON(body, auto_unbox = TRUE, null = "null"),
-    encode = "json"
-  )
-  
-  result <- content(response, "parsed", encoding = "UTF-8")
-  print(result)
 }
-  
+
 ########################################################################################################
 ########################################################################################################
 

R/project/ecow_calculations.R

@@ -237,12 +237,12 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   v_camp <- v_camp %>%
     mutate(across(where(is.numeric), ~ trunc(.x * 100) / 100))
   
-  save_data_vaches(v_camp)
+  save_data_vaches(v_camp, cheptel)
   
   # 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)
+  save_data_campagne(synth_prod_vache_n, cheptel)
 
   if (step == 1) {
     t1 <- Sys.time()
@@ -271,9 +271,9 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   # Calcul des stats par pere
   stats_prod_directe <- get_stats_parent(produits_taureaux, pereGenetique)
 
-  stats_filles <- get_stats_filles(synth_filles_taureaux, "fillestot_", pereGenetique, actif = FALSE)
+  stats_filles <- get_stats_filles(synth_filles_taureaux, "fillestot_", pereGenetique, actif = FALSE, cheptel)
 
-  stats_filles_act <- get_stats_filles(synth_filles_taureaux, "fillesact_", pereGenetique, actif = TRUE)
+  stats_filles_act <- get_stats_filles(synth_filles_taureaux, "fillesact_", pereGenetique, actif = TRUE, cheptel)
   
   grp_filles_et_act <- stats_filles %>%
     dplyr::left_join(stats_filles_act, by = "pereGenetique") %>%
@@ -283,8 +283,9 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   
   stats_filles_renouv <- produits_cheptel %>%
     filter(
+      is.na(NBPRODIPG),# TODO valider avec Lauréna que c'est bien ce champ là qu'on veut 
       sexe == "2",
-      nbFinGestation == 0 # TODO valider avec Lauréna que c'est bien ce champ là qu'on veut 
+      is.na(dateSortDetenteur)
     ) %>%
     group_by(pereGenetique) %>%
     summarise(
@@ -303,7 +304,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
       )
 
   message("Enregistrement données taureaux")
-  save_data_taureau(stats_taureaux)
+  save_data_taureau(stats_taureaux, cheptel)
   
   if (step == 2) {
     t1 <- Sys.time()
@@ -314,7 +315,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
   ###################################################################################################################
   ####################################     Remontee des lignees femelles     ########################################
   ###################################################################################################################
-  
+  message("Début partie Lignées")
   fondatrices <- cheptel_ecow$fondatrices
   descendants <- add_data_ecow(cheptel_ecow$descendants, czhbc)
 
@@ -325,17 +326,19 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
 
   # calcul des stats par fondatrice, ne gardant que celles ayant plus de 5 descendants dans le cheptel_________________
 
+  # Si je ne mets pas descendants, je perds les stats directe des vaches achetées car elles n'ont pas encore de petits_produits
   stats_prod <- get_stats_parent(descendants, fondatrice) # produits lignées ou descendants ????
   
-  stats_fem_tot <- get_stats_filles(synth_vaches_lignees, "femtot_", fondatrice, actif = FALSE)
+  stats_fem_tot <- get_stats_filles(synth_vaches_lignees, "femtot_", fondatrice, actif = FALSE, cheptel)
   
-  stats_fem_act <- get_stats_filles(synth_vaches_lignees, "femact_", fondatrice, actif = TRUE)
+  stats_fem_act <- get_stats_filles(synth_vaches_lignees, "femact_", fondatrice, actif = TRUE, cheptel)
 
   stats_renouv <- descendants %>%
     filter(
       is.na(NBPRODIPG),# TODO valider avec Lauréna que c'est bien ce champ là qu'on veut 
       sexe == "2",
-      is.na(dateSortDetenteur)
+      is.na(dateSortDetenteur), 
+      cheptelDetenteur == cheptel
     ) %>%
     group_by(fondatrice) %>%
     summarise(
@@ -352,12 +355,12 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
       pctfem_avecprod =
         round(femtot_nbavecprod / nb_femelles* 100, 1),
       pctfemact_avecprod =
-        round(femact_nbavecprod / nb_femelles * 100, 1),
+        round(femact_nbavecprod / femtot_nbavecprod * 100, 1),
       cheptel = cheptel
     )
 
   message("Enregistrement données lignées")
-  save_data_lignees(stats_lignees)
+  save_data_lignees(stats_lignees, cheptel)
   t1 <- Sys.time()
   message("Fin du traitement. Temps d'exécution : ", round(difftime(t1, t0, units = "secs"), 2), " sec")
 }

R/project/postprocessing.R

@@ -109,7 +109,7 @@ format_duration <- function(seconds) {
   sprintf("%02d:%02d:%02d", h, m, s)
 }
 
-save_data_vaches <- function(vaches){
+save_data_vaches <- function(vaches, cheptel){
   tabfinal <- vaches %>%
     select(
       cheptelDetenteur, anim, nom, nom_pere, embryon, donneuse, porteuse, tempsprod, age_years, ecowcarr, rg_carr, ptgV,
@@ -125,6 +125,9 @@ save_data_vaches <- function(vaches){
     "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"
   )
   
+  nb_lignes_supp <- delete_data_today(cheptel, "VACHES")
+  if (nb_lignes_supp > 0) message("Lignes du jour supprimées dans la table ecowVaches : ", nb_lignes_supp)
+  
   tab_format <- tabfinal %>%
     mutate(
       across(
@@ -151,9 +154,9 @@ save_data_vaches <- function(vaches){
   dbDisconnect(con)
 }
 
-save_data_campagne <- function(synth_camp){
+save_data_campagne <- function(campagnes, cheptel){
   # Stockage des données écow_camp
-  filtered_prod_camp <- synth_camp %>%
+  filtered_prod_camp <- campagnes %>%
     select(
       cheptel, numeroMipg, dateNaiss, rangVelageMipg, ecowcamp, nom_pere, produits
     )
@@ -162,6 +165,9 @@ save_data_campagne <- function(synth_camp){
     "cheptel", "mere_ipg", "danais", "ravelamer_corr", "note_ecow", "pere", "produits"
   )
   
+  nb_lignes_supp <- delete_data_today(cheptel, "CAMPAGNES")
+  if (nb_lignes_supp > 0) message("Lignes du jour supprimées dans la table ecowCampagne : ", nb_lignes_supp)
+  
   con <- get_db_connection()
   
   dbWriteTable(
@@ -174,14 +180,14 @@ save_data_campagne <- function(synth_camp){
   dbDisconnect(con) 
 }
 
-save_data_taureau <- function(data_taureaux){
+save_data_taureau <- function(taureaux, cheptel){
   # Stockage des données écow_taureaux
-  filtered_taureaux <- data_taureaux %>%
+  filtered_taureaux <- taureaux %>%
     select(
       cheptel, pereGenetique, nom, dateNaiss, nomCheptelNaiss, nb_prod_in_chep, utilgen, prol, mort, txrepros, nbpp, txvf, pnm, pnf, p120m, p120f, p210m, p210f, 
       dmsev, dssev, afsev,  fillestot_nbavecprod, fillestot_pctavecprod, fillestot_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, fillesact_nbavecprod, fillesact_pctavecprod, fillesact_isu, fillesact_age_sort, fillesact_agevel1, fillesact_ivv1, fillesact_ivv2p, 
+      fillestot_txvf, fillesact_nbavecprod, pctfillesact_avecprod, fillesact_isu, fillesact_age_sort, fillesact_agevel1, fillesact_ivv1, fillesact_ivv2p, 
       fillesact_vieprod, fillesact_dmad, fillesact_dsad, fillesact_afad, fillesact_nbprod, fillesact_txrepros, fillesact_nbpp, fillesact_prol, fillesact_mort, 
       fillesact_txvf, nbfilles_renouv
     )
@@ -194,6 +200,9 @@ save_data_taureau <- function(data_taureaux){
     "vieprod_fillesact", "dmad_fillesact", "dsad_fillesact", "afad_fillesact", "nbprod_fillesact", "txrepros_fillesact", "nbpp_fillesact", "prol_fillesact", "mort_fillesact", 
     "txvf_fillesact", "nbfilles_renouv"
   )
+  
+  nb_lignes_supp <- delete_data_today(cheptel, "TAUREAUX")
+  if (nb_lignes_supp > 0) message("Lignes du jour supprimées dans la table ecowTaureaux : ", nb_lignes_supp)
 
   con <- get_db_connection()
   
@@ -207,13 +216,13 @@ save_data_taureau <- function(data_taureaux){
   dbDisconnect(con) 
 }
 
-save_data_lignees <- function(stats_lignees){
+save_data_lignees <- function(lignees, cheptel){
-  filtered_lignees <- stats_lignees %>%
+  filtered_lignees <- lignees %>%
     select(
       cheptel, fondatrice, nom, dateNaiss, nomCheptelNaiss, nb_prod_in_chep, utilgen, prol, mort, txrepros, nbpp, txvf, pnm, pnf, p120m, 
-      p120f, p210m, p210f, dmsev, dssev, afsev, femtot_nbavecprod, femtot_pctavecprod, femtot_isu, femtot_age_sort, femtot_agevel1, femtot_ivv1, 
+      p120f, p210m, p210f, dmsev, dssev, afsev, femtot_nbavecprod, pctfem_avecprod, femtot_isu, femtot_age_sort, femtot_agevel1, femtot_ivv1, 
       femtot_ivv2p, femtot_vieprod, femtot_dmad, femtot_dsad, femtot_afad, femtot_nbprod, femtot_txrepros, femtot_nbpp, femtot_prol, 
-      femtot_mort, femtot_txvf, femact_nbavecprod, femact_pctavecprod, femact_isu, femact_age_sort, femact_agevel1, femact_ivv1, 
+      femtot_mort, femtot_txvf, femact_nbavecprod, pctfemact_avecprod, femact_isu, femact_age_sort, femact_agevel1, femact_ivv1, 
       femact_ivv2p, femact_vieprod, femact_dmad, femact_dsad, femact_afad, femact_nbprod, femact_txrepros, femact_nbpp, femact_prol, 
       femact_mort, femact_txvf, nbfilles_renouv
     )
@@ -227,6 +236,8 @@ save_data_lignees <- function(stats_lignees){
     "mort_femact", "txvf_femact", "nbfem_renouv" 
   )
   
+  nb_lignes_supp <- delete_data_today(cheptel, "LIGNEES")
+  if (nb_lignes_supp > 0) message("Lignes du jour supprimées dans la table ecowLignees : ", nb_lignes_supp)
   
   con <- get_db_connection()
   

R/project/preprocessing.R

@@ -183,7 +183,7 @@ get_synth_prod_parent <- function(vaches, produits, params_ponderation){
         ivv2Brut < 365  ~ 0,
         TRUE         ~ ivv2Brut - 365
       ),
-      days_since_last = as.numeric(difftime(Sys.Date(), last_danais, units = "days")),
+      days_since_last = as.numeric(difftime(if_else(is.na(dateSortDetenteur), Sys.Date(), dateSortDetenteur), last_danais, units = "days")),
       e4 = dplyr::case_when(
         is.na(days_since_last) ~ 0,
         days_since_last < 365  ~ 0,
@@ -191,7 +191,7 @@ get_synth_prod_parent <- function(vaches, produits, params_ponderation){
       ),
       
       # temps productif (%)
-      age_days = time_length( interval( dateNaiss, Sys.Date() ),  "days" ),
+      age_days = time_length( interval( dateNaiss, if_else(is.na(dateSortDetenteur), Sys.Date(), dateSortDetenteur) ),  "days" ),
       age_years = round(age_days / 365, 1),
       tempsprod = round( (age_days - (agevel1 * 30.4 + e2 + e3 * (nbcampvel - 2) + e4)) / age_days * 100, 1 ),
       
@@ -358,7 +358,7 @@ get_stats_parent <- function(produits, regroupement){
 #' @param actif booléen. Filtre sur les produits 
 #' selon le champs {}
 #' @return Liste d'adhérents 
-get_stats_filles <- function(df, prefix, regroupement, actif = FALSE) {
+get_stats_filles <- function(df, prefix, regroupement, actif = FALSE, cheptel) {
   nb <- df %>% 
     group_by({{regroupement}}) %>%
     summarise(
@@ -367,7 +367,11 @@ get_stats_filles <- function(df, prefix, regroupement, actif = FALSE) {
     )
   
   if (actif) {
-    df <- df %>% filter(is.na(dateSortDetenteur))
+    df <- df %>% 
+      filter(
+        is.na(dateSortDetenteur),
+        cheptelDetenteur == cheptel # Vérifie pour les descendantes car elles ont pu être vendues
+      )
   }
   
   res <- df %>% group_by({{regroupement}}) %>%