lea/RProjects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Mise en place API

Browse Source
This commit is contained in:
Léa
2026-06-11 10:23:33 +02:00
parent da46965f95
commit 699d976c80
5 changed files with 95 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files
R/project/ecow_calculations.R
+23 -31
View File
@@ -18,13 +18,10 @@ source(here::here("R/project/preprocessing.R"))
#' step : 1 si calcul des vaches uniquement, 2 si vaches et taureaux, 3 global
#' @param cheptel character. Numéro du cheptel avec le FR devant
calcul_ecow_by_chep <- function(cheptel, step = 3) {
message("Début fonction calcul_ecow_by_chep pour cheptel : ", cheptel)
t0 <- Sys.time()
# Définit un environnement avec tous les paramètres qu'on veut rendre accessibles
env_ecow <- new.env()
# Récupère les paramètres de pondération
env_ecow$params_ponderation <- get_params_ponderation(cheptel)
params_ponderation <- get_params_ponderation(cheptel)
# Récupère la liste des certificats zoo issue de Doli
czhbc <- data.frame(ANIM = get_cztotaux())
@@ -42,7 +39,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
taureaux <- cheptel_ecow$taureaux
# Ajout du nom du père
vaches <- vaches %>%
left_join(
dplyr::left_join(
taureaux %>% select(anim, nom_pere = nom),
by = c("pereGenetique" = "anim")
)
@@ -56,24 +53,19 @@ 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)
env_ecow$rapport_MF <- effets$rapport_MF
env_ecow$effets_chep <- effets$effets_chep
rapport_MF <- effets$rapport_MF
prod_vaches_corr <- apply_effet_chep(produits_vaches)
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
pps <- env_ecow$params_ponderation$pointage$sevrage
pps <- params_ponderation$pointage$sevrage
# Ajout à la table vache des informations synthétisées de leur veaux
synth_vaches <- get_synth_prod_vaches(vaches, prod_vaches_corr)
synth <- get_synth_prod_vaches(vaches, prod_vaches_corr, params_ponderation)
synth_vaches <- synth$synthese
# calcul des stats, valeurs extremes et references pour la normalisation
stats_chep <- get_stats_tbl(
tab = synth_vaches,
nom_tab = "vaches",
cols = c("agevel1", "ivv1", "ivv2Brut", "prol", "mort", "txrepros", "nbpp_corr", "txvf", "txmales", "ptgP", "pn_corr", "p120_corr", # TODO attention aux champs texte
"p210_corr", "pad", "ptgV", "age_years", "tempsprod", "pn_m", "pn_f", "p120_m", "p120_f", "p210_m", "p210_f", "nbpp")
)
stats_chep <- synth$stats_chep
#################################### Calcul des notes campagnes ########################################
####### En réalité on travaille sur les rangs de velages, ce qui correspond dans 99% des cas aux campagnes #######
@@ -108,7 +100,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
# Récupère le nom du père
synth_prod_vache <- synth_prod_vache %>%
left_join(
dplyr::left_join(
taureaux %>% select(anim, nom_pere = nom),
by = c("pere" = "anim")
)
@@ -121,8 +113,8 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
stats_chep <- rbind(stats_chep, stats_camp)
pond_camp_fin <- unlist(env_ecow$params_ponderation$campagne$final)
pond_camp_ahp <- unlist(env_ecow$params_ponderation$campagne$AHPtech)
pond_camp_fin <- unlist(params_ponderation$campagne$final)
pond_camp_ahp <- unlist(params_ponderation$campagne$AHPtech)
# ==============================
# 2. Normalisation complète
@@ -217,7 +209,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
# 3) Fusion + transformations
v_camp <-synth_vaches %>%
left_join(moy_camp, by = c("anim" = "numeroMipg")) %>%
dplyr::left_join(moy_camp, by = c("anim" = "numeroMipg")) %>%
mutate(
rg_camp = as.integer(rank(1 / moyecowcamp, na.last='keep'))
)
@@ -254,7 +246,7 @@ 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)
synth_filles_taureaux <- get_synth_prod_vaches(filles_taureaux, pprod_filles_taureaux, params_ponderation, stats_chep)
# Calcul des stats par pere
@@ -368,11 +360,11 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
)
stats_taureaux <- stats_peres %>%
left_join(stats_prod_directe, by = "pereGenetique") %>%
left_join(stats_filles, by = "pereGenetique") %>%
left_join(stats_filles_act, by = "pereGenetique") %>%
left_join(stats_filles_renouv, by = "pereGenetique") %>%
left_join(taureaux, by = "pereGenetique")
dplyr::left_join(stats_prod_directe, by = "pereGenetique") %>%
dplyr::left_join(stats_filles, by = "pereGenetique") %>%
dplyr::left_join(stats_filles_act, by = "pereGenetique") %>%
dplyr::left_join(stats_filles_renouv, by = "pereGenetique") %>%
dplyr::left_join(taureaux, by = "pereGenetique")
save_data_taureau(stats_taureaux, cheptel)
@@ -398,7 +390,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
#
# # TODO quel effet chep ? Comment on l'applique ?
#
# synth_vaches_lignees <- get_synth_prod_vaches(vaches_lignees, produits_lignees)
# synth_vaches_lignees <- get_synth_prod_vaches(vaches_lignees, produits_lignees, params_ponderation, stats_chep)
#
# # calcul des stats par fondatrice ______________________________________________
#
@@ -500,9 +492,9 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
# summarise(nbfem_renouv = n())
#
# stats_lignees <- stats_prod %>%
# left_join(stats_fem_tot, by = "fondatrice") %>%
# left_join(stats_fem_act, by = "fondatrice") %>%
# left_join(stats_renouv, by = "fondatrice") %>%
# dplyr::left_join(stats_fem_tot, by = "fondatrice") %>%
# dplyr::left_join(stats_fem_act, by = "fondatrice") %>%
# dplyr::left_join(stats_renouv, by = "fondatrice") %>%
# mutate(
# pctfem_avecprod =
# round(nbfem_avecprod / nb_fem_prod * 100, 1),
@@ -512,7 +504,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
#
# stats_lignees_final <- fondatrices %>%
# mutate(anim = trim_str(anim)) %>%
# left_join(
# dplyr::left_join(
# stats_lignees %>% mutate(fondatrice = trim_str(fondatrice)),
# by = c("anim" = "fondatrice")
# )