diff --git a/R/common/ws_client.R b/R/common/ws_client.R index ca4f46d..29785f8 100755 --- a/R/common/ws_client.R +++ b/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) } - + ######################################################################################################## ######################################################################################################## diff --git a/R/project/ecow_calculations.R b/R/project/ecow_calculations.R index 359b6b5..26f5a69 100755 --- a/R/project/ecow_calculations.R +++ b/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") } diff --git a/R/project/postprocessing.R b/R/project/postprocessing.R index a61ed9d..90aa765 100755 --- a/R/project/postprocessing.R +++ b/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){ - filtered_lignees <- stats_lignees %>% +save_data_lignees <- function(lignees, cheptel){ + 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() diff --git a/R/project/preprocessing.R b/R/project/preprocessing.R index a3ef05d..cc618b5 100755 --- a/R/project/preprocessing.R +++ b/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}}) %>%