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

[éCow] Correctifs taureaux lignées

Browse Source
This commit is contained in:
Léa
2026-08-07 11:24:30 +02:00
parent 46f7294fc0
commit 108562c69b
4 changed files with 54 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files
R/project/ecow_calculations.R
+15 -12
View File
@@ -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")
}