Mise en place projet R
This commit is contained in:
Executable
+195
@@ -0,0 +1,195 @@
|
||||
source(here::here("R/common/db_client.R"))
|
||||
|
||||
save_or_return <- function(results, write_to_db = FALSE) {
|
||||
if (isTRUE(write_to_db)) {
|
||||
df <- as.data.frame(results, optional = TRUE)
|
||||
status <- insert_results(df)
|
||||
return(status)
|
||||
}
|
||||
results
|
||||
}
|
||||
|
||||
#' TODO voir ce qu'on retourne -> surement tableau de résultats, stockage en base géré dans une autre fonction
|
||||
#' Met à jour les données éCow pour un cheptel
|
||||
#' @param cheptel character. Code du cheptel avec le FR
|
||||
#' @return A définir
|
||||
maj_ecow_by_cheptel <- function(cheptel) {
|
||||
list_chep <-list(cheptel)
|
||||
|
||||
maj_ecow_for_list_cheptels(list_chep)
|
||||
}
|
||||
|
||||
#' Met à jour les données éCow pour tous les cheptels suivis par un technicien
|
||||
#' @param tech character. Identifiant à 5 lettres du technicien
|
||||
maj_ecow_by_tech <- function(tech) {
|
||||
# On récupère tous les cheptels d'un technicien
|
||||
cheps_tech <- get_cheptels_by_tech(tech)
|
||||
# On en extrait la liste des numéros de cheptels suivi par le tech
|
||||
list_chep <- as.list(cheps_tech$numeroCheptel)
|
||||
|
||||
maj_ecow_for_list_cheptels(list_chep)
|
||||
}
|
||||
|
||||
#' Met à jour les données éCow pour tous les cheptels des adhérents actifs
|
||||
maj_ecow_for_all <- function() {
|
||||
# On récupère tous les adhérents dans Dolibarr
|
||||
adh_hbc <- get_all_adherents_active()
|
||||
# On en extrait la liste des numéros de cheptels
|
||||
list_chep <- as.list(adh_hbc$Numchep)
|
||||
|
||||
maj_ecow_for_list_cheptels(list_chep)
|
||||
}
|
||||
|
||||
mafonctiondetest <- function(cheptel){
|
||||
source("R/common/ws_client.R", local = TRUE)
|
||||
server_path <- "http://localhost:8080/HbcSchedulerAndServices/"
|
||||
url_active_by_chep <- paste0(server_path, "webresources/animals/findAnimalEcowByActiveCheptel/")
|
||||
maliste <- http_get(url = paste0(url_active_by_chep, cheptel))
|
||||
return(lengths(maliste))
|
||||
}
|
||||
|
||||
cheptels <- list("FR71499477", "FR71499477635", "FR71499477")
|
||||
|
||||
#' 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){
|
||||
res <- lapply(cheptels, function(num_chep) {
|
||||
tryCatch(
|
||||
{
|
||||
message(sprintf("→ Traitement cheptel %s ...", num_chep))
|
||||
out <- mafonctiondetest(num_chep) #' TODO MAJ avec la fonction de calcul globale
|
||||
# out <- calcul_ecow_by_chep(num_chep) #' Appel de la fonction de calcul globale
|
||||
message(sprintf("✓ OK cheptel %s : %s lignes", num_chep, ifelse(is.data.frame(out), nrow(out), NA_integer_)))
|
||||
out
|
||||
},
|
||||
error = function(e) {
|
||||
# Log + continue
|
||||
message(sprintf("✗ ERREUR cheptel %s : %s", num_chep, conditionMessage(e)))
|
||||
NULL
|
||||
},
|
||||
warning = function(w) {
|
||||
# Tu peux décider de logger les warnings sans interrompre
|
||||
message(sprintf("! AVERTISSEMENT cheptel %s : %s", num_chep, conditionMessage(w)))
|
||||
invokeRestart("muffleWarning") # évite d’imprimer plusieurs fois le warning
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
save_data_vaches <- function(vaches){
|
||||
tabfinal <- vaches %>%
|
||||
select(
|
||||
cheptelDetenteur, anim, nom, nom_pere, embryon,
|
||||
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", "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 %>%
|
||||
mutate(
|
||||
across(
|
||||
where(is.character),
|
||||
~ str_replace_all(.x, ",", ".")
|
||||
),
|
||||
isu = case_when(
|
||||
isu == "O" ~ TRUE,
|
||||
isu == "N" ~ FALSE,
|
||||
TRUE ~ NA
|
||||
),
|
||||
rang_carr = as.numeric(rang_carr)
|
||||
)
|
||||
|
||||
con <- get_db_connection()
|
||||
|
||||
dbWriteTable(
|
||||
con,
|
||||
Id(schema = "hbc", table = "ecow_vaches"),
|
||||
tab_format,
|
||||
append = TRUE,
|
||||
row.names = FALSE
|
||||
)
|
||||
dbDisconnect(con)
|
||||
}
|
||||
|
||||
save_data_campagne <- function(synth_camp){
|
||||
# Stockage des données écow_camp
|
||||
filtered_prod_camp <- synth_camp %>%
|
||||
select(
|
||||
cheptel, numeroMipg, dateNaiss, rangVelageMipg, ecowcamp, nom_pere, produits
|
||||
)
|
||||
|
||||
colnames(filtered_prod_camp) <- c(
|
||||
"cheptel", "mere_ipg", "danais", "ravelamer_corr", "note_ecow", "pere", "produits"
|
||||
)
|
||||
|
||||
con <- get_db_connection()
|
||||
|
||||
dbWriteTable(
|
||||
con,
|
||||
Id(schema = "hbc", table = "ecow_campagne"),
|
||||
filtered_prod_camp,
|
||||
append = TRUE,
|
||||
row.names = FALSE
|
||||
)
|
||||
dbDisconnect(con)
|
||||
}
|
||||
|
||||
save_data_taureau <- function(data_taureaux, cheptel){
|
||||
# Stockage des données écow_taureaux
|
||||
filtered_taureaux <- data_taureaux %>%
|
||||
select(
|
||||
cheptelDetenteur, pereGenetique, 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
|
||||
)
|
||||
|
||||
colnames(filtered_taureaux) <- c(
|
||||
"cheptel", "anim", "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"
|
||||
)
|
||||
|
||||
filtered_taureaux$cheptel <- cheptel
|
||||
|
||||
con <- get_db_connection()
|
||||
|
||||
dbWriteTable(
|
||||
con,
|
||||
Id(schema = "hbc", table = "ecow_taureaux"),
|
||||
filtered_taureaux,
|
||||
append = TRUE,
|
||||
row.names = FALSE
|
||||
)
|
||||
dbDisconnect(con)
|
||||
}
|
||||
|
||||
save_data_lignees(stats_lignees){
|
||||
con <- get_db_connection()
|
||||
|
||||
dbWriteTable(
|
||||
con,
|
||||
Id(schema = "hbc", table = "ecow_lignees"),
|
||||
stats_lignees,
|
||||
append = TRUE,
|
||||
row.names = FALSE
|
||||
)
|
||||
dbDisconnect(con)
|
||||
}
|
||||
Reference in New Issue
Block a user