524 lines
22 KiB
R
Executable File
524 lines
22 KiB
R
Executable File
suppressPackageStartupMessages({
|
|
library(roxygen2)
|
|
library(dplyr)
|
|
library(lubridate)
|
|
library(purrr)
|
|
library(stringr)
|
|
library(DBI)
|
|
library(RPostgres)
|
|
library(here)
|
|
library(httr)
|
|
library(jsonlite)
|
|
})
|
|
source(here::here("R/common/ws_client.R"))
|
|
source(here::here("R/project/preprocessing.R"))
|
|
|
|
#' Fonction globale de mise à jour des indicateurs eCow pour vaches, taureaux et lignées
|
|
#' Stockage des données directement en base
|
|
#' 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")
|
|
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)
|
|
# Récupère la liste des certificats zoo issue de Doli
|
|
czhbc <- data.frame(ANIM = get_cztotaux())
|
|
|
|
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
|
|
|
|
# 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
|
|
vaches <- vaches %>%
|
|
left_join(
|
|
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)
|
|
|
|
# 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)
|
|
|
|
# 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
|
|
|
|
prod_vaches_corr <- apply_effet_chep(produits_vaches)
|
|
|
|
# On récupère les coefficients de pondération pour les pointages au sevrage
|
|
pps <- env_ecow$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)
|
|
|
|
# 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")
|
|
)
|
|
|
|
#################################### Calcul des notes campagnes ########################################
|
|
####### En réalité on travaille sur les rangs de velages, ce qui correspond dans 99% des cas aux campagnes #######
|
|
|
|
# ==============================
|
|
# 1. Aggrégation campagnes
|
|
# ==============================
|
|
synth_prod_vache <- prod_vaches_corr %>%
|
|
group_by(numeroMipg, dateNaiss, rangVelageMipg) %>%
|
|
summarise(
|
|
ivv = first(ivv1), # ------------------------------------------------------------------------- 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
|
|
mort = round(mean(mortsev == "O" | mortnat == "O") * 100, 1),
|
|
pere = first(pereGenetique),
|
|
cheptel = first(cheptelNaiss),
|
|
|
|
# noms des veaux pour simplifier affichage
|
|
produits = list(
|
|
pmap(
|
|
list(nom = nom, anim = anim, sexe = sexe, mortnat = mortnat, mortsev = mortsev, NBPRODIPG = NBPRODIPG, embryon = embryon),
|
|
\(nom, anim, sexe, mortnat, mortsev, NBPRODIPG, embryon) list(nom = nom, anim = anim, sexe = sexe, mortnat = mortnat, mortsev = mortsev, NBPRODIPG = NBPRODIPG, embryon = embryon)
|
|
)
|
|
),
|
|
.groups = "drop"
|
|
)
|
|
|
|
# Récupère le nom du père
|
|
synth_prod_vache <- synth_prod_vache %>%
|
|
left_join(
|
|
taureaux %>% select(anim, nom_pere = nom),
|
|
by = c("pere" = "anim")
|
|
)
|
|
|
|
stats_camp <- get_stats_tbl(
|
|
tab = synth_prod_vache,
|
|
nom_tab = "synth_prod_vache",
|
|
cols = c( 'ivv', 'prol', 'mort', 'txvf', 'txm', 'ptgp', 'pn_c', 'p120_c', 'p210_c')
|
|
)
|
|
|
|
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)
|
|
|
|
# ==============================
|
|
# 2. Normalisation complète
|
|
# ==============================
|
|
synth_prod_vache_n <- synth_prod_vache %>%
|
|
mutate(
|
|
# pn normalisé
|
|
pn_n = case_when(
|
|
is.na(pn_c) ~ NA_real_,
|
|
pn_c >= 40 & pn_c <= 50 ~ 1,
|
|
pn_c <= 22 | pn_c >= 68 ~ 0,
|
|
pn_c > 22 & pn_c < 40 ~ round(0.056 * (pn_c - 22), 3),
|
|
TRUE ~ round(1 - 0.056 * (pn_c - 50), 3)
|
|
),
|
|
|
|
# 5 normalisations linéaires
|
|
txvf_n = round(1 - abs(stats_chep$max[stats_chep$var=="synth_prod_vache$txvf"] - txvf) /
|
|
abs(diff(range(stats_chep[stats_chep$var=="synth_prod_vache$txvf",c("min","max")]))), 3),
|
|
|
|
txm_n = round(1 - abs(stats_chep$max[stats_chep$var=="synth_prod_vache$txm"] - txm) /
|
|
abs(diff(range(stats_chep[stats_chep$var=="synth_prod_vache$txm",c("min","max")]))), 3),
|
|
|
|
ptgp_n = round(1 - abs(stats_chep$max[stats_chep$var=="synth_prod_vache$ptgp"] - ptgp) /
|
|
abs(diff(range(stats_chep[stats_chep$var=="synth_prod_vache$ptgp",c("min","max")]))), 3),
|
|
|
|
p120_n = round(1 - abs(stats_chep$max[stats_chep$var=="synth_prod_vache$p120_c"] - p120_c) /
|
|
abs(diff(range(stats_chep[stats_chep$var=="synth_prod_vache$p120_c",c("min","max")]))), 3),
|
|
|
|
p210_n = round(1 - abs(stats_chep$max[stats_chep$var=="synth_prod_vache$p210_c"] - p210_c) /
|
|
abs(diff(range(stats_chep[stats_chep$var=="synth_prod_vache$p210_c",c("min","max")]))), 3),
|
|
|
|
# prol normalisé
|
|
prol_n = case_when(
|
|
is.na(prol) ~ NA_real_,
|
|
prol == 100 ~ 0.8,
|
|
TRUE ~ 1
|
|
),
|
|
|
|
# mortalité
|
|
mort_n = round(exp(-0.031 * mort), 3), # TODO sciender en mortsev et mortnat
|
|
|
|
# IVV normalisé
|
|
ivv_n = case_when(
|
|
is.na(rangVelageMipg) | rangVelageMipg == 1 | is.na(ivv) ~ NA_real_,
|
|
|
|
# ravelamere == 2
|
|
rangVelageMipg == 2 & ivv > 460 ~ 0,
|
|
rangVelageMipg == 2 & ivv < 390 ~ 1,
|
|
rangVelageMipg == 2 ~ round(1 - abs(390 - ivv)/abs(390 - 460), 3),
|
|
|
|
# autres ravelamere
|
|
ivv > 435 ~ 0,
|
|
ivv < 365 ~ 1,
|
|
TRUE ~ round(1 - abs(365 - ivv)/abs(365 - 435), 3)
|
|
)
|
|
) %>%
|
|
|
|
# ==============================
|
|
# 3. Score final ecowcamp
|
|
# ==============================
|
|
rowwise() %>%
|
|
mutate(
|
|
perf = list(c_across(c(
|
|
ivv_n, mort_n, p120_n, p210_n, pn_n,
|
|
prol_n, ptgp_n, txm_n, txvf_n
|
|
))),
|
|
pond = sum(
|
|
pond_camp_fin[!(is.na(perf) | is.nan(perf))]
|
|
),
|
|
somme = sum(
|
|
perf[!(is.na(perf) | is.nan(perf))] *
|
|
pond_camp_ahp[!(is.na(perf) | is.nan(perf))]
|
|
),
|
|
SOMME_tot = somme / pond * 10,
|
|
|
|
ecowcamp = ifelse(
|
|
is.na(ptgp_n) & is.na(p120_n) & is.na(p210_n), # Si pas de pointage, on réduit la note
|
|
NA,
|
|
round(SOMME_tot * 10, 0)
|
|
),
|
|
produits = toJSON(produits, auto_unbox = TRUE)
|
|
) %>%
|
|
ungroup()
|
|
|
|
# remplissage de la table vaches avec les notes campagnes
|
|
|
|
# 1) Moyenne ecowcamp par mère
|
|
moy_camp <- synth_prod_vache_n %>%
|
|
filter(ecowcamp > 10) %>%
|
|
group_by(numeroMipg) %>%
|
|
summarise(moyecowcamp = round(mean(ecowcamp, na.rm = TRUE), 1), .groups = "drop")
|
|
|
|
# 3) Fusion + transformations
|
|
v_camp <-synth_vaches %>%
|
|
left_join(moy_camp, by = c("anim" = "numeroMipg")) %>%
|
|
mutate(
|
|
rg_camp = as.integer(rank(1 / moyecowcamp, na.last='keep'))
|
|
)
|
|
|
|
message("Enregistrement données vaches")
|
|
|
|
# Enregistrement des données des vaches en base
|
|
save_data_vaches(v_camp)
|
|
|
|
# Enregistrement des données de campagne en base
|
|
save_data_campagne(synth_prod_vache_n)
|
|
|
|
if (step == 1) {
|
|
t1 <- Sys.time()
|
|
message("Fin du traitement. Temps d'exécution : ", round(difftime(t1, t0, units = "secs"), 2), " sec")
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
###################################################################################################################
|
|
#################################### Calcul ecow pour les taureaux ########################################
|
|
###################################################################################################################
|
|
message("Début partie taureaux")
|
|
# Recupère les produits des taureaux
|
|
produits_taureaux <- produits_cheptel %>%
|
|
filter(pereGenetique %in% taureaux$anim & embryon != 'O')
|
|
|
|
# Récupères les filles des taureaux
|
|
filles_taureaux <- produits_taureaux %>%
|
|
filter(sexe == 2)
|
|
|
|
# Petits produits issus des filles des taureaux
|
|
pprod_filles_taureaux <- add_data_ecow(cheptel_ecow$petits_produits, czhbc)
|
|
|
|
# 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)
|
|
|
|
# Calcul des stats par pere
|
|
|
|
stats_peres <- produits_taureaux %>%
|
|
group_by(pereGenetique) %>%
|
|
summarise(
|
|
nb_prod_in_chep = n(),
|
|
.groups = "drop"
|
|
) %>%
|
|
filter(nb_prod_in_chep >= 5)
|
|
|
|
stats_prod_directe <- produits_taureaux %>%
|
|
group_by(pereGenetique) %>%
|
|
summarise(
|
|
utilgen = round(mean(rangVelageMipg == 1, na.rm = TRUE) * 100, 1),
|
|
prol = round(n() / n_distinct(dateNaiss, numeroMipg) * 100, 1),
|
|
mort = round(mean(mortsev == "O" | mortnat == "O") * 100, 1),
|
|
|
|
txrepros = round(
|
|
sum(repro == "O", na.rm = TRUE) /
|
|
sum(is.na(mortsev) | is.na(mortnat)) * 100, 1
|
|
),
|
|
|
|
nbpp = sum(NBPRODIPG, na.rm = TRUE),
|
|
txvf = round(mean(conditionNaiss %in% c("1", "2"), na.rm = TRUE) * 100, 1),
|
|
|
|
pnm = round(mean(poidsNaiss[sexe == "1"], na.rm = TRUE), 1),
|
|
pnf = round(mean(poidsNaiss[sexe == "2"], na.rm = TRUE), 1),
|
|
|
|
p120m = round(mean(pat120[sexe == "1"], na.rm = TRUE), 1),
|
|
p120f = round(mean(pat120[sexe == "2"], na.rm = TRUE), 1),
|
|
|
|
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 ?
|
|
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(
|
|
nbfilles_avecprod = sum(NBPRODIPG > 0, na.rm = TRUE),
|
|
pctfilles_avecprod = round(nbfilles_avecprod / n() * 100, 1),
|
|
isu_fillestot = ifelse(n() >= 3, sum(embryon == "O", na.rm = TRUE), NA),
|
|
age_sort_fillestot = ifelse(n() >= 3, round(mean(age_years, na.rm = TRUE), 1), NA),
|
|
agevel1_fillestot = ifelse(n() >= 3, round(mean(agevel1, na.rm = TRUE), 1), NA),
|
|
ivv1_fillestot = ifelse(n() >= 3, round(mean(ivv1, na.rm = TRUE), 1), NA),
|
|
ivv2p_fillestot = ifelse(n() >= 3, round(mean(ivv2Brut, na.rm = TRUE), 1), NA),
|
|
vieprod_fillestot = ifelse(n() >= 3, round(mean(tempsprod, na.rm = TRUE), 1), NA),
|
|
|
|
dmad_fillestot = ifelse(n() >= 3, round(mean(dmcAdulte, na.rm = TRUE), 1), NA),
|
|
dsad_fillestot = ifelse(n() >= 3, round(mean(dsAdulte, na.rm = TRUE), 1), NA),
|
|
afad_fillestot = ifelse(n() >= 3, round(mean(afAdulte, na.rm = TRUE), 1), NA),
|
|
|
|
prol_fillestot = ifelse(n() >= 3, round(mean(prol, na.rm = TRUE), 1), NA),
|
|
mort_fillestot = ifelse(n() >= 3, round(mean(mort, na.rm = TRUE), 1), NA),
|
|
txvf_fillestot = ifelse(n() >= 3, round(mean(txvf, na.rm = TRUE), 1), NA),
|
|
|
|
nbprod_fillestot = ifelse(n() >= 3, sum(NBPRODIPG, na.rm = TRUE), NA),
|
|
txrepros_fillestot = ifelse(n() >= 3, round(mean(txrepros, na.rm = TRUE), 1), NA),
|
|
nbpp_fillestot = ifelse(n() >= 3, sum(nbpp, na.rm = TRUE), NA),
|
|
|
|
.groups = "drop"
|
|
)
|
|
|
|
stats_filles_act <- synth_filles_taureaux %>%
|
|
filter(is.na(dateSortDetenteur)) %>%
|
|
group_by(pereGenetique) %>%
|
|
summarise(
|
|
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),
|
|
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),
|
|
ivv2p_fillesact = ifelse(n() >= 3, round(mean(ivv2Brut, na.rm = TRUE), 1), NA),
|
|
vieprod_fillesact = ifelse(n() >= 3, round(mean(tempsprod, na.rm = TRUE), 1), NA),
|
|
|
|
dmad_fillesact = ifelse(n() >= 3, round(mean(dmcAdulte, na.rm = TRUE), 1), NA),
|
|
dsad_fillesact = ifelse(n() >= 3, round(mean(dsAdulte, na.rm = TRUE), 1), NA),
|
|
afad_fillesact = ifelse(n() >= 3, round(mean(afAdulte, na.rm = TRUE), 1), NA),
|
|
|
|
prol_fillesact = ifelse(n() >= 3, round(mean(prol, na.rm = TRUE), 1), NA),
|
|
mort_fillesact = ifelse(n() >= 3, round(mean(mort, na.rm = TRUE), 1), NA),
|
|
txvf_fillesact = ifelse(n() >= 3, round(mean(txvf, na.rm = TRUE), 1), NA),
|
|
|
|
nbprod_fillesact = ifelse(n() >= 3, sum(NBPRODIPG, na.rm = TRUE), NA),
|
|
txrepros_fillesact = ifelse(n() >= 3, round(mean(txrepros, na.rm = TRUE), 1), NA),
|
|
nbpp_fillesact = ifelse(n() >= 3, sum(nbpp, na.rm = TRUE), NA),
|
|
|
|
.groups = "drop"
|
|
)
|
|
|
|
inventaire <- bind_rows(cheptel_ecow$vaches, cheptel_ecow$produits)
|
|
inventaire <- add_data_ecow(inventaire, czhbc)
|
|
stats_filles_renouv <- inventaire %>%
|
|
filter(
|
|
sexe == "2",
|
|
NBPRODIPG == 0
|
|
) %>%
|
|
group_by(pereGenetique) %>%
|
|
summarise(
|
|
nbfilles_renouv = n(),
|
|
.groups = "drop"
|
|
)
|
|
|
|
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")
|
|
|
|
save_data_taureau(stats_taureaux, cheptel)
|
|
|
|
if (step == 2) {
|
|
t1 <- Sys.time()
|
|
message("Fin du traitement. Temps d'exécution : ", round(difftime(t1, t0, units = "secs"), 2), " sec")
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
###################################################################################################################
|
|
#################################### Remontee des lignees femelles ########################################
|
|
###################################################################################################################
|
|
|
|
fondatrices <- cheptel_ecow$fondatrices
|
|
descendants <- cheptel_ecow$descendants
|
|
|
|
vaches_lignees <- descendants %>%
|
|
filter(anim %in% descendants$mereIpg)
|
|
produits_lignees <- add_data_ecow(
|
|
descendants %>%
|
|
filter(mereIpg %in% descendants$anim)
|
|
)
|
|
#
|
|
# # TODO quel effet chep ? Comment on l'applique ?
|
|
#
|
|
# synth_vaches_lignees <- get_synth_prod_vaches(vaches_lignees, produits_lignees)
|
|
#
|
|
# # calcul des stats par fondatrice ______________________________________________
|
|
#
|
|
# stats_prod <- produits_lignees %>%stats_prod <- produits_ligne%
|
|
# summarise(
|
|
# nb_desc_in_chep = n(),
|
|
#
|
|
# utilgen = round(mean(ravelamere == 1, na.rm = TRUE) * 100, 1),
|
|
#
|
|
# prol = round(
|
|
# n() / n_distinct(danais, mere) * 100, 1
|
|
# ),
|
|
#
|
|
# mort = round(mean(mortsev == "O", na.rm = TRUE) * 100, 1),
|
|
#
|
|
# txrepros = round(
|
|
# sum(repro == "O", na.rm = TRUE) /
|
|
# sum(is.na(mortsev)) * 100, 1
|
|
# ),
|
|
#
|
|
# nbpp = sum(nbdescendants, na.rm = TRUE),
|
|
#
|
|
# txvf = round(mean(conais %in% c("1", "2"), na.rm = TRUE) * 100, 1),
|
|
#
|
|
# pnm = round(mean(ponais[sexbov == "1"], na.rm = TRUE), 1),
|
|
# pnf = round(mean(ponais[sexbov == "2"], na.rm = TRUE), 1),
|
|
#
|
|
# p120m = round(mean(pat04m[sexbov == "1"], na.rm = TRUE), 1),
|
|
# p120f = round(mean(pat04m[sexbov == "2"], na.rm = TRUE), 1),
|
|
#
|
|
# p210m = round(mean(pat07m[sexbov == "1"], na.rm = TRUE), 1),
|
|
# p210f = round(mean(pat07m[sexbov == "2"], na.rm = TRUE), 1),
|
|
#
|
|
# dmsev = round(mean(devmus[sexbov == "1"], na.rm = TRUE), 1), # A CORRIGER CF TAUREAUX
|
|
# dssev = round(mean(devsqe[sexbov == "2"], na.rm = TRUE), 1),
|
|
#
|
|
# nb_fem_prod = sum(sexbov == "2", na.rm = TRUE)
|
|
# ) %>%
|
|
# filter(nb_desc_in_chep >= 5)
|
|
#
|
|
# stats_fem_tot <- synth_vaches_lignees %>%
|
|
# group_by(fondatrice) %>%
|
|
# summarise(
|
|
# nbfem_avecprod = n(),
|
|
#
|
|
# isu_femtot = ifelse(n() >= 3, round(mean(indisu, na.rm = TRUE), 1), NA),
|
|
# age_sort_femtot = ifelse(n() >= 3, round(mean(age_years, na.rm = TRUE), 1), NA),
|
|
# agevel1_femtot = ifelse(n() >= 3, round(mean(agevel1, na.rm = TRUE), 1), NA),
|
|
# vieprod_femtot = ifelse(n() >= 3, round(mean(tempsprod, na.rm = TRUE), 1), NA),
|
|
# ivv1_femtot = ifelse(n() >= 3, round(mean(ivv1, na.rm = TRUE), 1), NA),
|
|
# ivv2p_femtot = ifelse(n() >= 3, round(mean(as.numeric(ivv2p), na.rm = TRUE), 1), NA),
|
|
#
|
|
# dmad_femtot = ifelse(n() >= 3, round(mean(dmC, na.rm = TRUE), 1), NA),
|
|
# dsad_femtot = ifelse(n() >= 3, round(mean(ds, na.rm = TRUE), 1), NA),
|
|
# afad_femtot = ifelse(n() >= 3, round(mean(af, na.rm = TRUE), 1), NA),
|
|
#
|
|
# prol_femtot = ifelse(n() >= 3, round(mean(prol, na.rm = TRUE), 1), NA),
|
|
# mort_femtot = ifelse(n() >= 3, round(mean(mort, na.rm = TRUE), 1), NA),
|
|
# txvf_femtot = ifelse(n() >= 3, round(mean(txvf, na.rm = TRUE), 1), NA),
|
|
#
|
|
# nbprod_femtot = ifelse(n() >= 3, sum(nbdescendants, na.rm = TRUE), NA),
|
|
# txrepros_femtot = ifelse(n() >= 3, round(mean(txrepros, na.rm = TRUE), 1), NA),
|
|
# nbpp_femtot = ifelse(n() >= 3, sum(nbpp, na.rm = TRUE), NA)
|
|
# )
|
|
#
|
|
# stats_fem_act <- synth_vaches_lignees %>%
|
|
# filter(is.na(dasort)) %>%
|
|
# group_by(fondatrice) %>%
|
|
# summarise(
|
|
# nbfemact_avecprod = n(),
|
|
#
|
|
# isu_femact = ifelse(n() >= 3, round(mean(indisu, na.rm = TRUE), 1), NA),
|
|
# age_sort_femact = ifelse(n() >= 3, round(mean(age_years, na.rm = TRUE), 1), NA),
|
|
# agevel1_femact = ifelse(n() >= 3, round(mean(agevel1, na.rm = TRUE), 1), NA),
|
|
# vieprod_femact = ifelse(n() >= 3, round(mean(tempsprod, na.rm = TRUE), 1), NA),
|
|
# ivv1_femact = ifelse(n() >= 3, round(mean(ivv1, na.rm = TRUE), 1), NA),
|
|
# ivv2p_femact = ifelse(n() >= 3, round(mean(as.numeric(ivv2p), na.rm = TRUE), 1), NA),
|
|
#
|
|
# dmad_femact = ifelse(n() >= 3, round(mean(dmC, na.rm = TRUE), 1), NA),
|
|
# dsad_femact = ifelse(n() >= 3, round(mean(ds, na.rm = TRUE), 1), NA),
|
|
# afad_femact = ifelse(n() >= 3, round(mean(af, na.rm = TRUE), 1), NA),
|
|
#
|
|
# prol_femact = ifelse(n() >= 3, round(mean(prol, na.rm = TRUE), 1), NA),
|
|
# mort_femact = ifelse(n() >= 3, round(mean(mort, na.rm = TRUE), 1), NA),
|
|
# txvf_femact = ifelse(n() >= 3, round(mean(txvf, na.rm = TRUE), 1), NA),
|
|
#
|
|
# nbprod_femact = ifelse(n() >= 3, sum(nbdescendants, na.rm = TRUE), NA),
|
|
# txrepros_femact = ifelse(n() >= 3, round(mean(txrepros, na.rm = TRUE), 1), NA),
|
|
# nbpp_femact = ifelse(n() >= 3, sum(nbpp, na.rm = TRUE), NA)
|
|
# )
|
|
#
|
|
# stats_renouv <- inv_desc %>%
|
|
# filter(
|
|
# nbdescendants == 0,
|
|
# sexbov == "2",
|
|
# actif == "1"
|
|
# ) %>%
|
|
# group_by(fondatrice) %>%
|
|
# 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") %>%
|
|
# mutate(
|
|
# pctfem_avecprod =
|
|
# round(nbfem_avecprod / nb_fem_prod * 100, 1),
|
|
# pctfemact_avecprod =
|
|
# round(nbfemact_avecprod / nb_fem_prod * 100, 1)
|
|
# )
|
|
#
|
|
# stats_lignees_final <- fondatrices %>%
|
|
# mutate(anim = trim_str(anim)) %>%
|
|
# left_join(
|
|
# stats_lignees %>% mutate(fondatrice = trim_str(fondatrice)),
|
|
# by = c("anim" = "fondatrice")
|
|
# )
|
|
#
|
|
# save_data_lignees(stats_lignees_final)
|
|
t1 <- Sys.time()
|
|
message("Fin du traitement. Temps d'exécution : ", round(difftime(t1, t0, units = "secs"), 2), " sec")
|
|
}
|