[eCow] Correctif environnement
This commit is contained in:
@@ -142,14 +142,13 @@ get_params_ponderation <- function(num_cheptel){
|
|||||||
|
|
||||||
#' Récupère le nombre de veaux total par parents à partir d'une extraction excel complétée par les données SPIE
|
#' Récupère le nombre de veaux total par parents à partir d'une extraction excel complétée par les données SPIE
|
||||||
#' Le nombre renvoyé est le nombre total tous cheptels confondus, sans détail sur les veaux
|
#' Le nombre renvoyé est le nombre total tous cheptels confondus, sans détail sur les veaux
|
||||||
get_parents_ipg <- function(){
|
get_parents_ipg <- function(cheptel){
|
||||||
# Extraction du fichier excel contenant les données de la table bovide du SIG jusqu'au 06/01/2026
|
# Extraction du fichier excel contenant les données de la table bovide du SIG jusqu'au 06/01/2026
|
||||||
meresIPG <- read_csv(paste(rep_imp, "nb_prod_IPG_byMERE_20260106.csv", sep=''), show_col_types = FALSE)
|
meresIPG <- read_csv(paste(rep_imp, "nb_prod_IPG_byMERE_20260106.csv", sep=''), show_col_types = FALSE)
|
||||||
colnames(meresIPG) <- c('ANIM','NBPRODSIG')
|
colnames(meresIPG) <- c('ANIM','NBPRODSIG')
|
||||||
|
|
||||||
# Extraction SPIE pour compléter à partir du 03/01/2026 (choix date pour essayer de limiter les doublons et manquement)
|
# Extraction SPIE pour compléter à partir du 03/01/2026 (choix date pour essayer de limiter les doublons et manquement)
|
||||||
url_meres_spie <- paste0(server_path, "webresources/spie/nbprodbymeresince2026/")
|
url_meres_spie <- paste0(server_path, "webresources/spie/nbprodbymeresince2026/")
|
||||||
meres_spie_brut <- http_get(url = paste0(url_meres_spie, num_cheptel))
|
meres_spie_brut <- http_get(url = paste0(url_meres_spie, cheptel))
|
||||||
meres_spie <- as.data.frame(meres_spie_brut, stringsAsFactors = FALSE)
|
meres_spie <- as.data.frame(meres_spie_brut, stringsAsFactors = FALSE)
|
||||||
colnames(meres_spie) <- c('ANIM','NBPRODSPIE')
|
colnames(meres_spie) <- c('ANIM','NBPRODSPIE')
|
||||||
meres_spie$NBPRODSPIE <- as.numeric(meres_spie$NBPRODSPIE)
|
meres_spie$NBPRODSPIE <- as.numeric(meres_spie$NBPRODSPIE)
|
||||||
@@ -164,7 +163,7 @@ get_parents_ipg <- function(){
|
|||||||
|
|
||||||
# Extraction SPIE pères
|
# Extraction SPIE pères
|
||||||
url_peres_spie <- paste0(server_path, "webresources/spie/nbprodbyperesince2026/")
|
url_peres_spie <- paste0(server_path, "webresources/spie/nbprodbyperesince2026/")
|
||||||
peres_spie_brut <- http_get(url = paste0(url_peres_spie, num_cheptel))
|
peres_spie_brut <- http_get(url = paste0(url_peres_spie, cheptel))
|
||||||
peres_spie <- as.data.frame(peres_spie_brut, stringsAsFactors = FALSE)
|
peres_spie <- as.data.frame(peres_spie_brut, stringsAsFactors = FALSE)
|
||||||
colnames(peres_spie) <- c('ANIM','NBPRODSPIE')
|
colnames(peres_spie) <- c('ANIM','NBPRODSPIE')
|
||||||
peres_spie$NBPRODSPIE <- as.numeric(peres_spie$NBPRODSPIE)
|
peres_spie$NBPRODSPIE <- as.numeric(peres_spie$NBPRODSPIE)
|
||||||
|
|||||||
@@ -49,7 +49,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
|
|||||||
by = c("pereGenetique" = "anim")
|
by = c("pereGenetique" = "anim")
|
||||||
)
|
)
|
||||||
# Récupère les produits ajout des données manquantes
|
# Récupère les produits ajout des données manquantes
|
||||||
produits_cheptel <- add_data_ecow(cheptel_ecow$produits, cheptel_ecow$nomsparents, czhbc)
|
produits_cheptel <- add_data_ecow(cheptel_ecow$produits, cheptel, cheptel_ecow$nomsparents, czhbc)
|
||||||
|
|
||||||
|
|
||||||
###################################################################################################################
|
###################################################################################################################
|
||||||
@@ -71,9 +71,6 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
|
|||||||
|
|
||||||
prod_vaches_corr <- apply_effet_chep(produits_vaches, effets$effets_chep, effets$rapport_MF)
|
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 <- params_ponderation$pointage$sevrage
|
|
||||||
|
|
||||||
# Ajout à la table vache des informations synthétisées de leur veaux
|
# Ajout à la table vache des informations synthétisées de leur veaux
|
||||||
synth_brute_vaches <- get_synth_prod_parent(vaches, prod_vaches_corr, params_ponderation)
|
synth_brute_vaches <- get_synth_prod_parent(vaches, prod_vaches_corr, params_ponderation)
|
||||||
|
|
||||||
@@ -133,7 +130,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
|
|||||||
filter(sexe == 2)
|
filter(sexe == 2)
|
||||||
|
|
||||||
# Petits produits issus des filles des taureaux nés dans le cheptel
|
# Petits produits issus des filles des taureaux nés dans le cheptel
|
||||||
pprod_filles_taureaux <- add_data_ecow(cheptel_ecow$petits_produits, cheptel_ecow$nomsparents, czhbc)
|
pprod_filles_taureaux <- add_data_ecow(cheptel_ecow$petits_produits, cheptel, cheptel_ecow$nomsparents, czhbc)
|
||||||
|
|
||||||
# Calcul de la synthèse par fille de leur produits
|
# Calcul de la synthèse par fille de leur produits
|
||||||
synth_filles_taureaux <- get_synth_prod_parent(filles_taureaux, pprod_filles_taureaux, params_ponderation)
|
synth_filles_taureaux <- get_synth_prod_parent(filles_taureaux, pprod_filles_taureaux, params_ponderation)
|
||||||
@@ -189,7 +186,7 @@ calcul_ecow_by_chep <- function(cheptel, step = 3) {
|
|||||||
###################################################################################################################
|
###################################################################################################################
|
||||||
message("Début partie Lignées")
|
message("Début partie Lignées")
|
||||||
fondatrices <- cheptel_ecow$fondatrices
|
fondatrices <- cheptel_ecow$fondatrices
|
||||||
descendants <- add_data_ecow(cheptel_ecow$descendants, cheptel_ecow$nomsparents, czhbc)
|
descendants <- add_data_ecow(cheptel_ecow$descendants, cheptel, cheptel_ecow$nomsparents, czhbc)
|
||||||
|
|
||||||
vaches_lignees <- descendants %>% filter(anim %in% descendants$mereGenetique)
|
vaches_lignees <- descendants %>% filter(anim %in% descendants$mereGenetique)
|
||||||
produits_lignees <- descendants %>% filter(mereGenetique %in% vaches_lignees$anim)
|
produits_lignees <- descendants %>% filter(mereGenetique %in% vaches_lignees$anim)
|
||||||
|
|||||||
@@ -9,11 +9,11 @@ source(here::here('R/common/utils.R'))
|
|||||||
#' Met en forme le tableau des produits des vaches
|
#' Met en forme le tableau des produits des vaches
|
||||||
#' Ajoutes les colonnes nécessaires au calcul du rang ecow des vaches
|
#' Ajoutes les colonnes nécessaires au calcul du rang ecow des vaches
|
||||||
#' @param produits_vaches dataframe. Tab des produits des vaches du cheptel
|
#' @param produits_vaches dataframe. Tab des produits des vaches du cheptel
|
||||||
add_data_ecow <- function(liste_produits, noms_parents, czhbc){
|
add_data_ecow <- function(liste_produits, cheptel, noms_parents, czhbc){
|
||||||
|
|
||||||
#Ajout d'une colonne avec le nombre de produits IPG (croisement base SIG et SPIE)
|
#Ajout d'une colonne avec le nombre de produits IPG (croisement base SIG et SPIE)
|
||||||
parents_ipg <- get_parents_ipg()
|
parents_ipg <- get_parents_ipg(cheptel)
|
||||||
liste_produits <- base::merge(liste_produits, get_parents_ipg(), by.x='anim', by.y='ANIM', all.x=T, all.y=F)
|
liste_produits <- base::merge(liste_produits, parents_ipg, by.x='anim', by.y='ANIM', all.x=T, all.y=F)
|
||||||
noms_parents <- as.data.frame(noms_parents)
|
noms_parents <- as.data.frame(noms_parents)
|
||||||
liste_produits$nommere <- noms_parents$V2[match(liste_produits$numeroMipg, noms_parents$V1)]
|
liste_produits$nommere <- noms_parents$V2[match(liste_produits$numeroMipg, noms_parents$V1)]
|
||||||
liste_produits$nompere <- noms_parents$V2[match(liste_produits$pereGenetique, noms_parents$V1)]
|
liste_produits$nompere <- noms_parents$V2[match(liste_produits$pereGenetique, noms_parents$V1)]
|
||||||
@@ -319,6 +319,9 @@ get_note_carriere <- function(v_ref, params_ponderation){
|
|||||||
|
|
||||||
get_note_campagne <- function(prod_vaches_corr, params_ponderation){
|
get_note_campagne <- function(prod_vaches_corr, params_ponderation){
|
||||||
|
|
||||||
|
# On récupère les coefficients de pondération pour les pointages au sevrage
|
||||||
|
pps <- params_ponderation$pointage$sevrage
|
||||||
|
|
||||||
# Groupement et synthèse des données des produits par vache / date de naissance / rang de vélage de la mère
|
# Groupement et synthèse des données des produits par vache / date de naissance / rang de vélage de la mère
|
||||||
# Ca permet de grouper les jumeaux
|
# Ca permet de grouper les jumeaux
|
||||||
synth_prod_vache <- prod_vaches_corr %>%
|
synth_prod_vache <- prod_vaches_corr %>%
|
||||||
|
|||||||
Reference in New Issue
Block a user