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

[éCow] Ajout partie lignées

Browse Source
This commit is contained in:
Léa
2026-08-04 09:52:25 +02:00
parent 27ebac51f5
commit 46f7294fc0
3 changed files with 215 additions and 282 deletions
Download Patch File Download Diff File Expand all files Collapse all files
R/project/postprocessing.R
+65 -34
View File
@@ -40,19 +40,13 @@ maj_ecow_for_all <- function() {
maj_ecow_for_list_cheptels(list_chep)
}
mafonctiondetest <- function(cheptel){
source(here::here("R/common/ws_client.R"))
cheptel_ecow <- get_cheptel_ecow(cheptel)
vaches <- cheptel_ecow$vaches
return(length(vaches))
}
#' Mise à jour de l'indicateur Ecow pour une liste de cheptels et gestion des erreurs
#' @param list_cheptels list. Liste de numéros de cheptels avec le FR devant
maj_ecow_for_list_cheptels <- function(list_cheptels){
total <- length(list_cheptels)
start_time <- Sys.time()
message(sprintf("🚀 Début traitement - %s cheptels à traiter", total))
flush.console()
res <- lapply(seq_along(list_cheptels), function(i) {
num_chep <- list_cheptels[[i]]
@@ -60,17 +54,21 @@ maj_ecow_for_list_cheptels <- function(list_cheptels){
tryCatch(
{
message(sprintf("[%s/%s] Traitement cheptel %s ...", i, total, num_chep))
out <- calcul_ecow_by_chep(num_chep, 1) # Pour l'instant on s'arrête aux vaches
flush.console()
out <- calcul_ecow_by_chep(num_chep, 3) # Pour l'instant on s'arrête aux vaches
message(sprintf("✓ OK cheptel %s", num_chep))
flush.console()
out
},
error = function(e) {
message(sprintf("✗ ERREUR cheptel %s : %s", num_chep, conditionMessage(e)))
flush.console()
NULL
}
),
warning = function(w) {
message(sprintf("! AVERTISSEMENT cheptel %s : %s", num_chep, conditionMessage(w)))
flush.console()
invokeRestart("muffleWarning")
}
)
@@ -84,6 +82,25 @@ maj_ecow_for_list_cheptels <- function(list_cheptels){
return(res)
}
maj_ecow_from_csv <- function() {
cheptels <- read.csv('cheptels_liste.csv', stringsAsFactors = FALSE)
if (!"login" %in% names(cheptels)) {
stop("Colonne 'login' absente du CSV")
}
if (nrow(cheptels) == 0) {
message("Aucun cheptel à traiter")
return(NULL)
}
maj_ecow_for_list_cheptels(as.list(cheptels$login))
}
format_duration <- function(seconds) {
h <- as.integer(seconds %/% 3600)
m <- as.integer((seconds %% 3600) %/% 60)
@@ -95,22 +112,17 @@ format_duration <- function(seconds) {
save_data_vaches <- function(vaches){
tabfinal <- vaches %>%
select(
cheptelDetenteur, anim, nom, nom_pere, embryon, donneuse, porteuse,
tempsprod, age_years, ecowcarr, rg_carr,
ptgV, agevel1, ivv1, ivv2Brut,
prol, mort, txrepros, nbpp,
txvf, pn_m, pn_f,
p120_m, p120_f, p210_m, p210_f,
ptgP,
moyecowcamp, rg_camp
cheptelDetenteur, anim, nom, nom_pere, embryon, donneuse, porteuse, tempsprod, age_years, ecowcarr, rg_carr, ptgV,
agevel1, ivv1, ivv2Brut, prol, mort, txrepros, nbpp, txvf,
pn_m, pn_f, p120_m, p120_f, p210_m, p210_f, ptgP, moyecowcamp, rg_camp
) %>%
arrange(rg_carr)
# Renomme les colonnes pour correspondre aux noms des champs dans la table ecow_vaches
colnames(tabfinal) <- c(
"cheptel", "num_vache", "nom_vache", "pere", "isu", "donneuse", "porteuse", "pourc_vie_productive", "age_annees", "note_ecow_carr", "rang_carr", "pointage_vache", "age_1_velage_m", "ivv1_j",
"ivv2plus_j", "prolificite_pourc", "mortalite_av_sevr_pourc", "pourc_produits_repros", "nb_petits_produits", "pourc_velages_tranquilles", "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"
"cheptel", "num_vache", "nom_vache", "pere", "isu", "donneuse", "porteuse", "pourc_vie_productive", "age_annees", "note_ecow_carr", "rang_carr", "pointage_vache",
"age_1_velage_m", "ivv1_j", "ivv2plus_j", "prolificite_pourc", "mortalite_av_sevr_pourc", "pourc_produits_repros", "nb_petits_produits", "pourc_velages_tranquilles",
"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"
)
tab_format <- tabfinal %>%
@@ -162,28 +174,26 @@ save_data_campagne <- function(synth_camp){
dbDisconnect(con)
}
save_data_taureau <- function(data_taureaux, cheptel){
save_data_taureau <- function(data_taureaux){
# Stockage des données écow_taureaux
filtered_taureaux <- data_taureaux %>%
select(
cheptelDetenteur, pereGenetique, nom, dateNaiss, nomCheptelNaiss, nb_prod_in_chep, utilgen, prol, mort, txrepros, nbpp, txvf, pnm, pnf, p120m, p120f, p210m, p210f,
dmsev, dssev, afsev, nbfilles_avecprod, pctfilles_avecprod, 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_fillestot, nbfillesact_avecprod, pctfillesact_avecprod, 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_fillesact, nbfilles_renouv
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,
fillesact_vieprod, fillesact_dmad, fillesact_dsad, fillesact_afad, fillesact_nbprod, fillesact_txrepros, fillesact_nbpp, fillesact_prol, fillesact_mort,
fillesact_txvf, nbfilles_renouv
)
colnames(filtered_taureaux) <- c(
"cheptel", "anim", "nom", "date_naissance", "nom_chep_naiss", "nb_prod_in_chep", "utilgen", "prol", "mort", "txrepros", "nbpp", "txvf", "pnm", "pnf", "p120m", "p120f", "p210m", "p210f",
"dmsev", "dssev", "afsev", "nbfilles_avecprod", "pctfilles_avecprod", "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_fillestot", "nbfillesact_avecprod", "pctfillesact_avecprod", "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_fillesact", "nbfilles_renouv"
"vieprod_fillestot", "dmad_fillestot", "dsad_fillestot", "afad_fillestot", "nbprod_fillestot", "txrepros_fillestot", "nbpp_fillestot", "prol_fillestot", "mort_fillestot",
"txvf_fillestot", "nbfillesact_avecprod", "pctfillesact_avecprod", "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_fillesact", "nbfilles_renouv"
)
filtered_taureaux$cheptel <- cheptel
con <- get_db_connection()
@@ -198,14 +208,35 @@ save_data_taureau <- function(data_taureaux, cheptel){
}
save_data_lignees <- function(stats_lignees){
filtered_lignees <- stats_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,
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,
femact_ivv2p, femact_vieprod, femact_dmad, femact_dsad, femact_afad, femact_nbprod, femact_txrepros, femact_nbpp, femact_prol,
femact_mort, femact_txvf, nbfilles_renouv
)
colnames(filtered_lignees) <- c(
"cheptel", "anim", "nom", "date_naissance", "nom_chep_naiss", "nb_desc_in_chep", "utilgen", "prol", "mort", "txrepros", "nbpp", "txvf", "pnm", "pnf", "p120m",
"p120f", "p210m", "p210f", "dmsev", "dssev", "afsev", "nbfem_avecprod", "pctfem_avecprod", "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_femtot", "nbfemact_avecprod", "pctfemact_avecprod", "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_femact", "nbfem_renouv"
)
con <- get_db_connection()
dbWriteTable(
con,
Id(schema = "hbc", table = "ecow_lignees"),
stats_lignees,
filtered_lignees,
append = TRUE,
row.names = FALSE
)
dbDisconnect(con)
}
}