# version finale eCow - 5eme calcul # LJ - 01/07/2021 ################################################################################ ### chgt des libraries ######################################################### ################################################################################ library(tidyverse) library(lubridate) library(jsonlite) library(optiSel) library(staplr) library(png) library(grid) options(scipen = 999) #permet d'?crire les nombres en entier quand ils sont au format scientifique # necessaire pour la convertion des dates au format unix ################################################################################ ### chgt des fichiers et donn?es utiles ######################################## ################################################################################ rep_exp <- "C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/eCow5/EXPORTS_2/" rep_imp <- "C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/eCow5/IMPORTS_R/" date_imp <- as.Date("2025-06-18") adhhbc <- read_delim(paste(rep_imp, "adhhbc_20250618.csv", sep=''), # ok 20230327 ";", escape_double = FALSE, trim_ws = TRUE) czhbc <- read_csv(paste(rep_imp, "cz_20250618.csv", sep='')) # ok 20230327 LETTRES <- read_delim(paste(rep_imp, "LETTRES.csv", sep=''), ";", escape_double = FALSE, trim_ws = TRUE) indite <- read_csv(paste(rep_imp, "indite_20250618.csv", sep=''), # ok 20230327 col_types = cols(DANAIS = col_date(format = "%Y-%m-%d"))) indite <- indite[-which(duplicated(indite$ANIM)),] #$indite <- subset(indite, !is.na(indite$MEREIPG)) meresIPG <- read_csv(paste(rep_imp, "nbprodIPG_byMERE_20250618.csv", sep='')) # ok 20230327 colnames(meresIPG) <- c('ANIM','NBPRODIPG') peresIPG <- read_csv(paste(rep_imp, "nbprodIPG_byPERE_20250618.csv", sep='')) # ok 20230327 colnames(peresIPG) <- c('ANIM','NBPRODIPG') parentsIPG <- rbind(meresIPG, peresIPG) ### liste des webservices ###################################################### # appel du listing d'un cheptel webappli <- "https://tomcat.herdbookcharolais.com/HbcSchedulerAndServices-2.0-SNAPSHOT/webresources/animals/findbyactivecheptel/" # appel de l'IC pour un animal hbcanim <- "https://dga.jouy.inra.fr/HbcWebServices/webresources/hbcanim/" # appel de hbcgene pour un animal hbcgene <- "https://dga.jouy.inra.fr/HbcWebServices/webresources/hbcgene/" # liste des produits d'une vache reqMere <- "https://dga.jouy.inra.fr/HbcWebServices/webresources/hbcanim/findstringfieldbynamedquery/Hbcanim.findByMere/" # liste des produits d'un taureau reqPere <- "https://dga.jouy.inra.fr/HbcWebServices/webresources/hbcanim/findstringfieldbynamedquery/Hbcanim.findByPere/" # liste des produits d'un animal n?s dans un cheptel cible reqProdNaiss <- "https://tomcat.herdbookcharolais.com/HbcSchedulerAndServices-2.0-SNAPSHOT/webresources/animals/findProductByAnimAndChna/" # ? completer par anim/chna, ex : FR7121831530/FR71499477 #_______________________________________________________________PONDERATIONS AHP ## Ponderations Carriere #### Pcar=data.frame(type='final', agevel1_n=3, ivv1_n=6, ivv2p_n=12, ptgv_n=4, pad_n=2, prol_n=2, mort_n=12, txrepros_n=8, nbpp_n=10, txm_n=1, txvf_n=10, ptgp_n=6, pn_n=4, p120_n=10, p210_n=10) ### Ponderations Campagne #### Pcamp=rbind(data.frame(type='AHPtech', pn_n=5.3, txvf_n=14.9, txm_n=4.5, ptgp_n=8.2, p120_n=15.1, p210_n=12.6, prol_n=3.2, mort_n=19.9, ivv_n=16.2), data.frame(type='final', pn_n=6, txvf_n=15, txm_n=1, ptgp_n=9, p120_n=15, p210_n=15, prol_n=3, mort_n=18, ivv_n=18)) # pond?rations finales ajustees ? partir de l'enquete # peut etre pas judicieux ################################################################################ ### fonctions utiles ########################################################### ################################################################################ # suppression des espaces superflus trim_str = function (string) { gsub("\\s+", " ", gsub("^\\s+|\\s+$", "", string)) } # recuperation de l'inventaire des animaux actifs du cheptel get_inventaire <- function(cheptel) { old <- Sys.time() # liste des animaux du cheptel lichep <- fromJSON(paste(webappli, cheptel, sep='')) inventaire <- lichep$hbcanim # calcul du temps de chargement new <- Sys.time()-old cat("Chargement de l'inventaire :", round(new, 1) , "sec \n") # resultat return(inventaire) } # mise en forme d'un retour de WS sous forme de dataframe # necessaire quand l'appel ne concerne qu'un animal car le retour est une liste nomm?e appel_infos <- function(animal, url_ws, cheptel = NA) { animal <- trim_str(animal) if (!is.na(cheptel)) { li_anim <- try(fromJSON(paste(url_ws, animal, '/', cheptel, sep = '')), silent = TRUE) } else { li_anim <- try(fromJSON(paste(url_ws, animal, sep = '')), silent = TRUE) } if (inherits(li_anim, "try-error")) { return(NA) } else { if (class(li_anim) == "list" & length(li_anim) > 0) { li_anim[sapply(li_anim, function(x) length(x) == 0L)] <- NA df_anim <- as.data.frame(t(unlist(li_anim))) return(df_anim) } else if (class(li_anim) == "data.frame") { return(li_anim) } } } # appel des donnees anim en fonction de leur existance # si animal absent de hbcanim, on va voir dans hbcgene chgt_infos <- function(animal) { # on va chercher la ligne animal dans hbcanim line_anim <- try(appel_infos(animal, hbcanim), silent = TRUE) # Si erreur, on va chercher dans hbcgene if (!is.data.frame(line_anim) | inherits(line_anim, "try-error")) { line_anim <- appel_infos(animal, hbcgene) } return(line_anim) } # fonction de cr?ation d'un dataframe vide create_df <- function(nbl, liste_nomcol){ new <- data.frame(matrix(NA, ncol=length(liste_nomcol), nrow=nbl)) colnames(new) <- liste_nomcol return(new) } get_stats <- function(tab, nom_tab, col,conditions, nom_cond) { if (missing(conditions) & missing(nom_cond)) { x <- tab nom_cond <- NA } else { x <- subset(tab, conditions) } min <- round(min(x[,col], na.rm=TRUE), 1) q1 <- round(quantile(x[[col]], probs=0.25, na.rm=TRUE), 1) med <- round(median(x[[col]], na.rm=TRUE), 1) moy <- round(mean(x[[col]], na.rm=TRUE), 1) q3 <- round(quantile(x[[col]], probs=0.75, na.rm=TRUE), 1) max <- round(max(x[,col], na.rm=TRUE), 1) nbval <- nrow(subset(x, is.na(x[,col]) == FALSE)) nas <- nrow(subset(x, is.na(x[,col]) == TRUE)) tab_col <- as.character(paste(nom_tab, col, sep='$')) sc <- data.frame('var'=tab_col, 'cond'=nom_cond, 'min'=min, 'q1'=q1, 'med'=med, 'moy'=moy, 'q3'=q3, 'max'=max, 'nbval'=nbval, 'nas'=nas) rownames(sc) <- '' return(sc) } # fonction de recuperation des produits d'un taureau # recup annul?e si taureau d'IA avec bcp de produits ie >275 get_produits_taureau <- function(animal) { old <- Sys.time() anim <- try(appel_infos(trim_str(animal), hbcanim), silent = TRUE) ### if (!is.na(anim) & (class(anim) == "try-error") == FALSE) { # _______________________________ if (anim$sexbov[1] == '1') { if (as.numeric(anim$nbdescendants[1]) >= 275 & anim$taureauia[1] == '1') { produits <- NA cat("\n", "Produits non charg?s car taureau d'IA avec production superieure ? 275") } else if ( (as.numeric(anim$nbdescendants[1]) > 0 & anim$taureauia[1] == '0') | (as.numeric(anim$nbdescendants[1]) < 275 & anim$taureauia[1] == '1') ) { produits <- try(appel_infos(animal, reqPere), silent=TRUE) ### if ((class(produits) == "try-error") == TRUE){ cat("\n", "Produits non charg?s car non disponibles") produits <- NA } else { new <- Sys.time() - old cat("\n", "Chargement des produits :", round(new, 1) , "sec") } } else { produits <- NA cat("\n", "???") } } else { produits <- NA cat("\n", "L'animal n'est pas un m?le") } } else if ((class(anim) == "try-error") == TRUE) { # _________________________ cat("\n", "P?re sans ligne individuelle dans HBCANIM") produits <- try(appel_infos(animal, reqPere), silent = TRUE) ### if ((class(produits) == "try-error") == TRUE){ produits <- NA cat("\n", "Produits non charg?s car non disponibles") } else { new <- Sys.time() - old cat("\n", "Chargement des produits :", round(new, 1) , "sec") } } return(produits) } # fonction de recuperation des produits d'une vache get_produits_vache <- function(animal) { old <- Sys.time() anim <- try(appel_infos(trim_str(animal), hbcanim), silent = TRUE) ### if ((class(anim) == "try-error") == FALSE) { # _______________________________ if (anim$sexbov[1] == '2') { produits <- try(appel_infos(animal, reqMere), silent=TRUE) ### if ((class(produits) == "try-error") == TRUE){ cat("\n", "Produits non charg?s car non disponibles") produits <- NA } else { new <- Sys.time() - old cat("\n", "Chargement des produits :", round(new, 1) , "sec") } } else { produits <- NA cat("\n", "L'animal n'est pas une femelle") } } else if ((class(anim) == "try-error") == TRUE) { # _________________________ produits <- try(appel_infos(animal, reqMere), silent = TRUE) ### if ((class(produits) == "try-error") == TRUE){ produits <- NA cat("\n", "Produits non charg?s car non disponibles") } else { new <- Sys.time() - old cat("\n", "Chargement des produits :", round(new, 1) , "sec") } } return(produits) } # fonction de recuperation des produits d'un animal dans un cheptel naisseur get_produits_in_chep <- function(animal, cheptel) { old <- Sys.time() anim <- try(appel_infos(trim_str(animal), hbcanim), silent = TRUE) ### if ((class(anim) == "try-error") == FALSE) { # _______________________________ produits <- try(appel_infos(animal, reqProdNaiss, cheptel), silent=TRUE) ### if ((class(produits) == "try-error") == TRUE){ cat("\n", "Produits non charg?s car non disponibles") produits <- NA } else { new <- Sys.time() - old cat("\n", "Chargement des produits :", round(new, 1) , "sec") } } else if ((class(anim) == "try-error") == TRUE) { # _________________________ produits <- try(appel_infos(animal, reqMere), silent = TRUE) ### if ((class(produits) == "try-error") == TRUE){ produits <- NA cat("\n", "Produits non charg?s car non disponibles") } else { new <- Sys.time() - old cat("\n", "Chargement des produits :", round(new, 1) , "sec") } } return(produits) } # fonction de modif des formats dates à partir du retour d'un WS change_format_date_unix <- function(dataframe) { if (is.data.frame(dataframe)){ # recup des indices de colonnes de dates : commencent par 'da' ou 'DA' li_ix_dates <- c(grep("^da", colnames(dataframe))) if (length(li_ix_dates) == 0){ li_ix_dates <- c(grep("^DA", colnames(dataframe))) } # si existance de colonnes de dates : if (length(li_ix_dates) > 0) { for(j in li_ix_dates) { # on recupere les valeurs non nulles not_na <- c(which(!is.na(dataframe[,j]))) if(length(not_na) > 0) { # on verifie que c'est bien un format UNIX if ( dataframe[not_na[1],j] > 1*(10**8) ) { # puis on modifie le format tryCatch({ dataframe[,j] <- as.Date(as.POSIXct(dataframe[,j] / 1000, origin = "1970-01-01")) }, error = function(e){ next }) } else { #print("Dates pas au format UNIX") } } else { #print("Aucune date non nulle dans cette colonne") } } return(dataframe) } else { print("Pas de colonne commençant par 'da'/'DA'") } } else { print("l'objet n'est pas un dataframe") } } ### génération du rapport HTML ################################################ render_report = function(CHEP, TECH, date_imp) { print(paste(paste(rep_exp, TECH, '/' ,CHEP, sep=''), '/', CHEP, '_rapport_eCow5.html', sep = "")) rmarkdown::render( paste(substr(rep_exp, 1, nchar(rep_exp)-10), "eCow5_rapport_v3.Rmd", sep=''), params = list( CHEP = CHEP, TECH = TECH, date_imp = date_imp ), output_file = paste(paste(rep_exp, TECH, '/' ,CHEP, sep=''), '/', CHEP, '_rapport_eCow5.html', sep = "") ) } render_synthese = function(CHEP, TECH, date_imp) { print(paste(paste(rep_exp, TECH, '/' ,CHEP, sep=''), '/', CHEP, '_synthese_eCow5.html', sep = "")) rmarkdown::render( paste(substr(rep_exp, 1, nchar(rep_exp)-10), "eCow5_synthese.Rmd", sep=''), params = list( CHEP = CHEP, TECH = TECH, date_imp = date_imp ), output_file = paste(paste(rep_exp, TECH, '/' ,CHEP, sep=''), '/', CHEP, '_synthese_eCow5.html', sep = "") ) } # fonction de création du rapport pour la VN 2021 #### # render_vn = function(CHEP, TECH) { # rmarkdown::render( # paste("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/", "test_VN.Rmd", sep=''), # params = list( # CHEP = CHEP, # TECH = TECH # ), # output_file = paste("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/", # CHEP, '_VN.html', sep = "") # ) # } ################################################################################ ### fonction du calcul total ################################################### ################################################################################ render_all_fic <- function(cheptel, tech, VN = FALSE) { # cheptel avec le FR, tech = abrev 5 lettres CHEP <- cheptel # avec le FR TECH <- tech # creation du repertoire d'export dir.create(path=paste(rep_exp, TECH, '/', CHEP, sep='')) rep <- paste(rep_exp, TECH, '/' ,CHEP, sep='') ################################################################################ ### calcul du classement vaches ################################################ ################################################################################ OLD=Sys.time() ## r?cup des animaux de l'inventaire old <- Sys.time() inventaire <- get_inventaire(CHEP) if (is.data.frame(inventaire) && nrow(inventaire) > 0 ) { # modif du 28/03/2023 : ajout de la verif chepdet = CHEP inventaire <- inventaire %>% filter(trim_str(chepdet) == CHEP) # if ( inventaire$danais[1] > 1*(10**8) ) { # inventaire$danais <- as.Date(as.POSIXct(inventaire$danais / 1000, origin="1970-01-01")) # } #inventaire <- change_format_date_unix(inventaire) inventaire$danais <- as.Date(inventaire$danais, format = "%Y-%m-%d") inventaire$mere <- trim_str(inventaire$mere) inventaire$pere <- trim_str(inventaire$pere) inventaire$anim <- trim_str(inventaire$anim) inventaire$ds <- as.numeric(inventaire$ds) inventaire$af <- as.numeric(inventaire$af) inventaire$dmC <- as.numeric(inventaire$dmC) # vaches actives vaches <- subset(inventaire, inventaire$sexbov == 2 & inventaire$nbdescendants > 0) # recherche des meres dans les porteuses pour aller chercher # les produits s'ils existent dans HBCANIM porteuses <- subset(indite, !is.na(indite$MEREIPG) & indite$MEREIPG %in% trim_str(vaches$anim)) donneuses <- subset(indite, !is.na(indite$MERECPB) & indite$MERECPB %in% trim_str(vaches$anim)) # l'indicateur de donneuse d'embryon est renseign? apres dans --> vaches$ACINAC vaches$age_days <- time_length(interval(vaches$danais, Sys.Date()), unit="days") vaches$age_years <- round(vaches$age_days / 365, 1) vaches$acinac <- NA # liste de tous leurs produits produits <- vaches[0,] if (nrow(vaches) > 0 ) { for (i in 1:nrow(vaches)){ # r?cup des produits dans HBCANIM temp <- try(fromJSON(paste(reqMere, trim_str(vaches$anim[i]), sep='')), silent = TRUE) if (inherits(temp, "try-error")) { temp <- vaches[0,] } else { #temp <- fromJSON(paste(reqMere, trim_str(vaches$anim[i]), sep='')) # a voir : gerer les retours vides !!!! produits <- rbind(produits, temp) # on annote les donneuses if( is.data.frame(subset(temp, temp$indite == 'O')) ) { if (nrow(subset(temp, temp$indite == 'O')) > 0){ vaches$acinac[i] <- 'DONNEUSE' } } # ajout d'un nom ? la vache si null if (is.na(vaches$nobovi[i])) { lettre <- subset(LETTRES, LETTRES$ANNEE == vaches$campn[i]) vaches$nobovi[i] <- paste(lettre$LETTRE[1], vaches$nutrav[i], sep='_') } } } } else { print("AUCUNE VACHE ACTIVE DANS LE CHEPTEL") } # les veaux port?s sont rajout?s aux produits si non r?cup?r?s avant if (nrow(porteuses) > 0) { for (i in 1:nrow(porteuses)) { if (!(porteuses$ANIM[i] %in% trim_str(produits$anim))) { temp <- appel_infos(porteuses$ANIM[i], hbcanim) li_mere <- subset(vaches, vaches$anim == porteuses$MEREIPG[i]) if ( is.data.frame(temp) && nrow(temp) > 0 ) { temp$mere[1] <- porteuses$MEREIPG[i] temp[1, c(60:67, 86:103)] <- NA if ( nrow(li_mere) > 0){ temp$danaismere[1] <- as.character(li_mere$danais[1]) } temp$indite[1] <- 'O_corr' produits <- rbind(produits, temp) } } } } # modifs des types de donn?es, pour calcul par la suite produits$danais <- as.Date(produits$danais, format = "%Y-%m-%d") produits$dasort <- as.Date(produits$dasort, format = "%Y-%m-%d") produits$mere <- trim_str(produits$mere) produits$pere <- trim_str(produits$pere) produits$anim <- trim_str(produits$anim) produits$ravelamere <- as.numeric(produits$ravelamere) produits$ivv <- as.numeric(produits$ivv) produits$campn <- as.numeric(produits$campn) produits$ponais <- as.numeric(produits$ponais) produits$pat04m <- as.numeric(produits$pat04m) produits$pat07m <- as.numeric(produits$pat07m) produits$devsqe <- as.numeric(produits$devsqe) produits$devmus <- as.numeric(produits$devmus) produits$aptfon <- as.numeric(produits$aptfon) # on ne garde que les TE port?s par une vache active du cheptel PROD <- subset(produits, produits$indite != 'O') # ajout des produits IPG PROD <- merge(PROD, parentsIPG, by.x='anim', by.y='ANIM', all.x=T, all.y=F) PROD <- PROD[order(PROD$danais, decreasing = F),] PROD <- PROD[order(PROD$mere, decreasing = T),] # correction des ravelamere des TE si possible if (nrow(PROD) >0){ for (i in 1:nrow(PROD)) { if (is.na(PROD$ravelamere[i])) { if (!is.na(PROD$ravelamere[i+1]) & PROD$ravelamere[i+1] %in% c(1, 2)) { PROD$ravelamere[i] <- 1 PROD$typemere[i] <- 'G' } else if (!is.na(PROD$ravelamere[i+1]) & PROD$ravelamere[i+1] > 1) { PROD$ravelamere[i] <- PROD$ravelamere[i+1] - 1 PROD$typemere[i] <- 'V' } } } } # age au velage de la mere PROD$agevel <- round(time_length(interval(PROD$danaismere, PROD$danais), unit="months"), 1) # IVV : utilisation de la colonne deja presente de HBCANIM for (i in 1:nrow(PROD)) { if (PROD$indite[i] == 'O_corr') { PROD$nobovi[i] <- paste('#', PROD$nobovi[i], sep='') } # repro if (PROD$anim[i] %in% czhbc$ANIM | (!is.na(PROD$NBPRODIPG[i]) & PROD$NBPRODIPG[i] > 0) | (!is.na(PROD$nbdescendants[i]) & as.numeric(PROD$nbdescendants[i]) > 0)) { PROD$repro[i] <- 'O' } else { PROD$repro[i] <- NA PROD$nobovi[i] <- PROD$nobovi[i] %>% str_to_lower() } # mortalite if (!is.na(PROD$dasort[i]) & !is.na(PROD$casort[i]) & PROD$casort[i] == 'M' & time_length(interval(PROD$danais[i], PROD$dasort[i]), unit="days") < 211){ PROD$mortsev[i] <- 'O' PROD$nobovi[i]=paste(PROD$nobovi[i], ' (MavS)', sep='') } else { PROD$mortsev[i] <- NA } # IVV if (i > 1) { # cas normaux if (!is.na(PROD$ravelamere[i]) & !is.na(PROD$ravelamere[i-1]) & PROD$ravelamere[i] != 1 & PROD$ravelamere[i] == PROD$ravelamere[i-1] + 1 #& !is.na(PROD$cofgmumere[i]) & PROD$cofgmumere[i] != '2' & !is.na(PROD$mere[i]) & PROD$mere[i] == PROD$mere[i-1]) { PROD$ivv[i] <- time_length(interval(PROD$danais[i-1], PROD$danais[i]), unit="days") # jumeaux } else if (!is.na(PROD$ravelamere[i]) & !is.na(PROD$ravelamere[i-1]) & PROD$ravelamere[i] != 1 & PROD$ravelamere[i] == PROD$ravelamere[i-1] & !is.na(PROD$cofgmumere[i]) & PROD$cofgmumere[i] == '2' & !is.na(PROD$mere[i]) & PROD$mere[i] == PROD$mere[i-1]) { PROD$ivv[i] <- PROD$ivv[i-1] # rang de v?lage manquant } else if (!is.na(PROD$ravelamere[i]) & !is.na(PROD$ravelamere[i-1]) & PROD$ravelamere[i] != 1 & !is.na(PROD$cofgmumere[i]) & PROD$cofgmumere[i] != '2' & !is.na(PROD$mere[i]) & PROD$mere[i] == PROD$mere[i-1]) { PROD$ivv[i] <- round(time_length(interval(PROD$danais[i-1], PROD$danais[i]), unit="days") / (PROD$ravelamere[i] - PROD$ravelamere[i-1]), 0) } else { PROD$ivv[i] <- NA } } } # calcul des effets du cheptel : rang de velage et sexe du veau effet <- PROD %>% group_by(typemere, sexbov) %>% summarise(m_PN = round(mean(ponais, na.rm=T), 1), m_p120 = round(mean(pat04m, na.rm=T), 1), m_p210 = round(mean(pat07m, na.rm=T), 1)) effet$diff_pn <- effet$m_PN - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_PN[1] effet$diff_p120 <- effet$m_p120 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p120[1] effet$diff_p210 <- effet$m_p210 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p210[1] # calcul des effets du cheptel : sexe sur la repro effetsexe <- PROD %>% filter(NBPRODIPG > 0) %>% group_by(sexbov) %>% summarise(nbpp = round(mean(NBPRODIPG, na.rm=T), 1), nbpp_med = round(median(NBPRODIPG, na.rm=T), 1) ) rapport_MF <- round(subset(effetsexe, effetsexe$sexbov == '1')$nbpp_med[1] / subset(effetsexe, effetsexe$sexbov == '2')$nbpp_med[1], 0) # report des effets sur les produits for (i in 1:nrow(PROD)) { if (PROD$sexbov[i] == '2') { #_______________________________________ FEMELLES PROD$nbpp_corr[i] <- PROD$NBPRODIPG[i] * rapport_MF if (!is.na(PROD$typemere[i]) & PROD$typemere[i] == 'G') { #_________genisses if (!is.na(PROD$ponais[i])) { PROD$pn_corr[i] <- (PROD$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_pn[1]) } else { PROD$pn_corr[i] <- NA } if (!is.na(PROD$pat04m[i])) { PROD$p120_corr[i] <- (PROD$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p120[1]) } else { PROD$p120_corr[i] <- NA } if (!is.na(PROD$pat07m[i])) { PROD$p210_corr[i] <- (PROD$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p210[1]) } else { PROD$p210_corr[i] <- NA } } else { #________________________________________________ vaches ou inconnu if (!is.na(PROD$ponais[i])) { PROD$pn_corr[i] <- (PROD$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_pn[1]) } else { PROD$pn_corr[i] <- NA } if (!is.na(PROD$pat04m[i])) { PROD$p120_corr[i] <- (PROD$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p120[1]) } else { PROD$p120_corr[i] <- NA } if (!is.na(PROD$pat07m[i])) { PROD$p210_corr[i] <- (PROD$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p210[1]) } else { PROD$p210_corr[i] <- NA } } } else { #______________________________________________________________ MALES PROD$nbpp_corr[i] <- PROD$NBPRODIPG[i] if (!is.na(PROD$typemere[i]) & PROD$typemere[i] == 'G') { #____________________________________genisses if (!is.na(PROD$ponais[i])) { PROD$pn_corr[i] <- (PROD$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_pn[1]) } else { PROD$pn_corr[i] <- NA } if (!is.na(PROD$pat04m[i])) { PROD$p120_corr[i] <- (PROD$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p120[1]) } else { PROD$p120_corr[i] <- NA } if (!is.na(PROD$pat07m[i])) { PROD$p210_corr[i] <- (PROD$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p210[1]) } else { PROD$p210_corr[i] <- NA } } else { #________________________________________________ vaches ou inconnu if (!is.na(PROD$ponais[i])) { PROD$pn_corr[i] <- (PROD$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_pn[1]) } else { PROD$pn_corr[i] <- NA } if (!is.na(PROD$pat04m[i])) { PROD$p120_corr[i] <- (PROD$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p120[1]) } else { PROD$p120_corr[i] <- NA } if (!is.na(PROD$pat07m[i])) { PROD$p210_corr[i] <- (PROD$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p210[1]) } else { PROD$p210_corr[i] <- NA } } } } # calcul des donn?es ?labor?es par vache active for (i in 1:nrow(vaches)) { # _______________________________________________rappel des produits par vache veaux <- PROD %>% filter(mere == vaches$anim[i]) # ___________________________________________calcul des infos utiles par vache # calcul du poids adulte estim? et synthese pointage vache ___________________ if (!is.na(vaches$dmC[i])) { vaches$ptgV[i] <- round(0.6 * vaches$dmC[i] + 0.15 * vaches$ds[i] + 0.25 * vaches$af[i], 1) } else { vaches$ptgV[i] <- NA } if (nrow(veaux) > 3){ vaches$precocite[i] <- round(mean((veaux$devsqe - veaux$devmus), na.rm=TRUE), 2) alpha <- 1.62 - 0.01 * vaches$precocite[i] } else { vaches$precocite[i] <- NA alpha <- 1.62 } if (!is.na(vaches$pat24m[i])) { vaches$pad[i] <- round((vaches$pat24m[i] - 50 * exp(-720 * alpha * 10**(-3))) / (1 - exp(-720 * alpha * 10**(-3))), 1) } else if (!is.na(vaches$pat18m[i])) { vaches$pad[i] <- round((vaches$pat18m[i] - 50 * exp(-540 * alpha * 10**(-3))) / (1 - exp(-540 * alpha * 10**(-3))), 1) } else if (!is.na(vaches$pat12m[i])) { vaches$pad[i] <- round((vaches$pat12m[i] - 50 * exp(-360 * alpha * 10**(-3))) / (1-exp(-360 * alpha * 10**(-3))), 1) } else { vaches$pad[i] <- NA } # calcul des perfs de repro et du temps productif ____________________________ vaches$nbcampvel[i] <- (max(veaux$campn) - min(veaux$campn) + 1) if (1 %in% veaux$ravelamere) { vaches$agevel1[i] <- subset(veaux, veaux$ravelamere == 1)$agevel[1] } else { vaches$agevel1[i] <- NA } if (2 %in% veaux$ravelamere) { vaches$ivv1[i] <- subset(veaux, veaux$ravelamere == 2)$ivv[1] } else { vaches$ivv1[i] <- NA } if (3 %in% veaux$ravelamere) { vaches$ivv2p[i] <- round(mean(subset(veaux, veaux$ravelamere > 2)$ivv, na.rm=T), 1) } if (is.na(vaches$ivv1[i]) | (!is.na(vaches$ivv1[i]) & vaches$ivv1[i] < 390) ){ e2 <- 0 } else if (!is.na(vaches$ivv1[i]) & vaches$ivv1[i] >= 390) { e2 <- vaches$ivv1[i] - 390 } if (is.na(vaches$ivv2p[i]) | (!is.na(vaches$ivv2p[i]) & vaches$ivv2p[i] < 365) ){ e3 <- 0 } else if (!is.na(vaches$ivv2p[i]) & vaches$ivv2p[i] >= 365) { e3 <- vaches$ivv1[i] - 365 } if (time_length(interval(max(veaux$danais, na.rm=T), Sys.Date()), unit="days") < 365) { e4 <- 0 } else { e4 <- time_length(interval(max(veaux$danais, na.rm=T), Sys.Date()), unit="days") - 365 } vaches$tempsprod[i] <- round( (vaches$age_days[i] - ( vaches$agevel1[i] * 30.4 + e2 + e3 * (vaches$nbcampvel[i] - 2) + e4 )) / vaches$age_days[i] * 100, 1) # calcul des donn?es synth?tiques sur les produits ___________________________ vaches$prol[i] <- round(nrow(veaux) / (vaches$nbcampvel[i]) * 100, 1) vaches$mort[i] <- round(nrow(subset(veaux, veaux$mortsev == 'O')) / nrow(veaux)* 100, 1) vaches$txrepros[i] <- round(nrow(subset(veaux, veaux$repro == 'O')) / nrow(veaux)* 100, 1) vaches$nbpp[i] <- sum(veaux$NBPRODIPG, na.rm=T) vaches$nbpp_corr[i] <- sum(veaux$nbpp_corr, na.rm=T) vaches$txmales[i] <- round(nrow(subset(veaux, veaux$sexbov == '1')) / nrow(veaux)* 100, 1) vaches$txvf[i] <- round(nrow(subset(veaux, veaux$conais %in% c('1','2') )) / nrow(veaux)* 100, 1) vaches$ptgP[i] <- round(0.75 * mean(veaux$devmus, na.rm=TRUE) + 0.25 * mean(veaux$devsqe, na.rm=TRUE), 1) vaches$pn_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$ponais, na.rm=T), 1) vaches$p120_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$pat04m, na.rm=T), 1) vaches$p210_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$pat07m, na.rm=T), 1) vaches$pn_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$ponais, na.rm=T), 1) vaches$p120_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$pat04m, na.rm=T), 1) vaches$p210_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$pat07m, na.rm=T), 1) vaches$pn_corr[i] <- round(mean(veaux$pn_corr, na.rm=T), 1) vaches$p120_corr[i] <- round(mean(veaux$p120_corr, na.rm=T), 1) vaches$p210_corr[i] <- round(mean(veaux$p210_corr, na.rm=T), 1) ### convertion des NaN en NA L <- c('ptgP','pn_m','pn_f','pn_corr','p120_m','p120_f','p120_corr', 'p210_m','p210_f','p210_corr') for (j in L){ if (is.nan(vaches[i,j]) == TRUE){ vaches[i,j] <- NA } } } # calcul des stats, valeurs extremes et references pour la normalisation stats_chep <- create_df(0,c('var', 'cond', 'min', 'q1', 'med', 'moy', 'q3', 'max', 'nbval', 'nas')) stats_chep <- rbind(stats_chep, get_stats(vaches, "vaches", "indisu"), get_stats(vaches, "vaches", "agevel1"), get_stats(vaches, "vaches", "ivv1"), get_stats(vaches, "vaches", "ivv2p"), get_stats(vaches, "vaches", "prol"), get_stats(vaches, "vaches", "mort"), get_stats(vaches, "vaches", "txrepros"), get_stats(vaches, "vaches", "nbpp_corr"), get_stats(vaches, "vaches", "txvf"), get_stats(vaches, "vaches", "txmales"), get_stats(vaches, "vaches", "ptgP"), get_stats(vaches, "vaches", "pn_corr"), get_stats(vaches, "vaches", "p120_corr"), get_stats(vaches, "vaches", "p210_corr"), get_stats(vaches, "vaches", "pad"), get_stats(vaches, "vaches", "ptgV"), get_stats(vaches, "vaches", "age_years"), get_stats(vaches, "vaches", "tempsprod"), get_stats(vaches, "vaches", "pn_m"), get_stats(vaches, "vaches", "pn_f"), get_stats(vaches, "vaches", "p120_m"), get_stats(vaches, "vaches", "p120_f"), get_stats(vaches, "vaches", "p210_m"), get_stats(vaches, "vaches", "p210_f"), get_stats(vaches, "vaches", "nbpp")) #_______________________________calcul des valeurs normalis?es par vache for (i in 1:nrow(vaches)) { # ____________________________________________ perfs individuelles normalis?es if (!is.na(vaches$agevel1[i])){ if (vaches$agevel1[i] > 48) { vaches$agevel1_n[i] <- 0 } else if (vaches$agevel1[i] <= 48) { vaches$agevel1_n[i] <- round(-2 * (10**-6) * (vaches$agevel1[i] * 30.4) ** 2 + 0.0027 * (vaches$agevel1[i] * 30.4) + 8 * (10 ** -15), 3) } else { vaches$agevel1_n[i] <- NA } } else { vaches$agevel1_n[i] <- NA } if (is.na(vaches$ivv1[i])) { vaches$ivv1_n[i] <- NA } else if (vaches$ivv1[i] > 460) { vaches$ivv1_n[i] <- 0 } else if (vaches$ivv1[i] < 390) { vaches$ivv1_n[i] <- 1 } else { vaches$ivv1_n[i] <- round(1 - abs(390 - vaches$ivv1[i]) / abs(390 - 460), 3) } if (is.na(vaches$ivv2p[i]) | is.nan(vaches$ivv2p[i])) { vaches$ivv2p_n[i] <- NA } else if (vaches$ivv2p[i] > 435) { vaches$ivv2p_n[i] <- 0 } else if (vaches$ivv2p[i] < 365) { vaches$ivv2p_n[i] <- 1 } else { vaches$ivv2p_n[i] <- round(1 - abs(365 - vaches$ivv2p[i]) / abs(365 - 435), 3) } if (is.na(vaches$pad[i])) { vaches$pad_n[i] <- NA } else { vaches$pad_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$pad')[,'max'] - vaches$pad[i]) / abs(subset(stats_chep, var == 'vaches$pad')[,'max'] - subset(stats_chep, var == 'vaches$pad')[,'min'])), 3) } if (is.na(vaches$ptgV[i])) { vaches$ptgv_n[i] <- NA } else { vaches$ptgv_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$ptgV')[,'max'] - vaches$ptgV[i]) / abs(subset(stats_chep, var == 'vaches$ptgV')[,'max'] - subset(stats_chep, var == 'vaches$ptgV')[,'min'])), 3) } if (vaches$prol[i] >= 100) { vaches$prol_n[i] <- 1 } else if (vaches$prol[i] < 50){ vaches$prol_n[i] <- 0 } else { vaches$prol_n[i] <- round(1 - (abs(100 - vaches$prol[i]) / abs(100 - 50)), 3) } if (is.na(vaches$pn_corr[i])) { vaches$pn_n[i] <- NA } else if (40 < vaches$pn_corr[i] & vaches$pn_corr[i] < 50) { vaches$pn_n[i] <- 1 } else if (22 > vaches$pn_corr[i] | vaches$pn_corr[i] > 68) { vaches$pn_n[i] <- 0 } else if (22 < vaches$pn_corr[i] & vaches$pn_corr[i] < 40) { vaches$pn_n[i] <- round(0.056 * (vaches$pn_corr[i] - 22), 3) } else { vaches$pn_n[i] <- round(1 - 0.056 * (vaches$pn_corr[i] - 50), 3) } vaches$txvf_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$txvf')[,'max'] - vaches$txvf[i]) / abs(subset(stats_chep, var == 'vaches$txvf')[,'max'] - subset(stats_chep, var == 'vaches$txvf')[,'min'])), 3) vaches$txm_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$txmales')[,'max'] - vaches$txmales[i]) / abs(subset(stats_chep, var == 'vaches$txmales')[,'max'] - subset(stats_chep, var == 'vaches$txmales')[,'min'])), 3) vaches$mort_n[i] <- round(1.0 * exp(-0.031 * vaches$mort[i]), 3) vaches$txrepros_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$txrepros')[,'max'] - vaches$txrepros[i]) / abs(subset(stats_chep, var == 'vaches$txrepros')[,'max'] - subset(stats_chep, var == 'vaches$txrepros')[,'min'])), 3) vaches$nbpp_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$nbpp_corr')[,'max'] - vaches$nbpp_c[i]) / abs(subset(stats_chep, var == 'vaches$nbpp_corr')[,'max'] - subset(stats_chep, var == 'vaches$nbpp_corr')[,'min'])), 3) vaches$ptgp_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$ptgP')[,'max'] - vaches$ptgP[i]) / abs(subset(stats_chep, var == 'vaches$ptgP')[,'max'] - subset(stats_chep, var == 'vaches$ptgP')[,'min'])), 3) vaches$p120_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$p120_corr')[,'max'] - vaches$p120_c[i]) / abs(subset(stats_chep, var == 'vaches$p120_corr')[,'max'] - subset(stats_chep, var == 'vaches$p120_corr')[,'min'])), 3) vaches$p210_n[i] <- round(1 - (abs(subset(stats_chep, var == 'vaches$p210_corr')[,'max'] - vaches$p210_c[i]) / abs(subset(stats_chep, var == 'vaches$p210_corr')[,'max'] - subset(stats_chep, var == 'vaches$p210_corr')[,'min'])), 3) # __________________________________________________ calcul des notes carriere somme <- 0 pond <- sum(Pcar[,c(2:16)]) for (j in c(190:204)){ # attention a la correspondance des numeros de colonnes !!! # modif du 29/04/2024 : passage de 189:203 à 190:204 if (is.na(vaches[i,j])){ valperf <- 0 #mt_col <- mt_col + 1 # nb de colonnes sans valeur pond <- pond - Pcar[1, (j - 189 + 1)] } else { valperf <- vaches[i, j] * Pcar[1, (j - 189 + 1)] # critere normalise X ponderation } somme <- somme + valperf # somme sur une ligne } SOMME_tot <- somme / pond * 10 # rapport en prenant que les criteres ayant une valeur if (is.na(vaches$ptgp_n[i]) & is.na(vaches$p120_n[i]) & is.na(vaches$p210_n[i])){ vaches$ecowcarr[i] <- NA } else { vaches$ecowcarr[i] <- round(SOMME_tot * 100, 0) } } vaches$rg_carr <- rank(1 / vaches$ecowcarr, na.last="keep") ##################################################### calcul des notes campagnes campagnes <- PROD %>% distinct(mere, campn, ravelamere) for (i in 1:nrow(campagnes)){ #y <- subset(VA,VA$ANIM==C$mereref[i]) # ligne de la mere dans VA veaux <- subset(PROD, PROD$campn == campagnes$campn[i] & PROD$mere == campagnes$mere[i]) # ligne(s) du ou des veaux dans PR campagnes$pn_c[i] <- round(mean(veaux$pn_corr, na.rm=TRUE), 1) campagnes$txvf[i] <- round(nrow(subset(veaux, veaux$conais %in% c('1','2'))) / nrow(veaux) * 100, 1) campagnes$txm[i] <- round(nrow(subset(veaux, veaux$sexbov == '1')) / nrow(veaux) * 100, 1) campagnes$ptgp[i] <- round(mean((0.75 * veaux$devmus + 0.25 * veaux$devsqe), na.rm=TRUE) ,1) campagnes$p120_c[i] <- round(mean(veaux$p120_corr, na.rm=TRUE), 1) campagnes$p210_c[i] <- round(mean(veaux$p210_corr, na.rm=TRUE), 1) campagnes$prol[i] <- nrow(veaux) * 100 campagnes$ivv[i] <- veaux$ivv[1] campagnes$mort[i] <- round(nrow(subset(veaux,veaux$mortsev == 'O')) / nrow(veaux) * 100, 1) L <- c('ptgp','pn_c','p120_c','p210_c') for (j in L){ if (is.nan(campagnes[i,j])){ campagnes[i,j] <- NA } } if (nrow(veaux) == 1){ nv <- paste(str_sub(veaux$anim[1], -4), trim_str(veaux$nobovi[1]), sep='_') } else if (nrow(veaux) == 2){ nv1 <- paste(str_sub(veaux$anim[1], -4), trim_str(veaux$nobovi[1]), sep='_') nv2 <- paste(str_sub(veaux$anim[2], -4), trim_str(veaux$nobovi[2]), sep='_') nv <- paste(nv1, nv2, sep=', ') } else if (nrow(veaux) == 3){ nv1 <- paste(str_sub(veaux$anim[1], -4), trim_str(veaux$nobovi[1]), sep='_') nv2 <- paste(str_sub(veaux$anim[2], -4), trim_str(veaux$nobovi[2]), sep='_') nv3 <- paste(str_sub(veaux$anim[3], -4), trim_str(veaux$nobovi[3]), sep='_') nv <- paste(nv1, nv2, nv3, sep=', ') } else if (nrow(veaux) == 4){ nv1 <- paste(str_sub(veaux$anim[1], -4), trim_str(veaux$nobovi[1]), sep='_') nv2 <- paste(str_sub(veaux$anim[2], -4), trim_str(veaux$nobovi[2]), sep='_') nv3 <- paste(str_sub(veaux$anim[3], -4), trim_str(veaux$nobovi[3]), sep='_') nv4 <- paste(str_sub(veaux$anim[4], -4), trim_str(veaux$nobovi[4]), sep='_') nv <- paste(nv1, nv2, nv3, nv4, sep=', ') } if(is.na(veaux$nompere[1])){ if (is.na(veaux$pere[1])){ pere <- '' } else { pere <- str_sub(trim_str(veaux$pere[1]), -4) } } else { pere <- trim_str(veaux$nompere[1]) } campagnes$noms[i] <- paste(nv, pere, sep=' / ') } stats_chep <- rbind(stats_chep, get_stats(campagnes,'campagnes','ivv'), get_stats(campagnes,'campagnes','prol'), get_stats(campagnes,'campagnes','mort'), get_stats(campagnes,'campagnes','txvf'), get_stats(campagnes,'campagnes','txm'), get_stats(campagnes,'campagnes','ptgp'), get_stats(campagnes,'campagnes','pn_c'), get_stats(campagnes,'campagnes','p120_c'), get_stats(campagnes,'campagnes','p210_c')) for (i in 1:nrow(campagnes)){ # _____________________________________ calcul des perfs campagnes normalis?es #pn if (is.na(campagnes$pn_c[i])) { campagnes$pn_n[i] <- NA } else if (campagnes$pn_c[i] >= 40 & campagnes$pn_c[i] <= 50) { campagnes$pn_n[i] <- 1 } else if (22 >= campagnes$pn_c[i] | campagnes$pn_c[i] >= 68) { campagnes$pn_n[i] <- 0 } else if (22 < campagnes$pn_c[i] & campagnes$pn_c[i] < 40) { campagnes$pn_n[i] <- round(0.056 * (campagnes$pn_c[i] - 22), 3) } else { campagnes$pn_n[i] <- round(1 - 0.056 * (campagnes$pn_c[i] - 50), 3) } campagnes$txvf_n[i] <- round(1 - (abs(subset(stats_chep, var == 'campagnes$txvf')[,'max'] - campagnes$txvf[i]) / abs(subset(stats_chep, var == 'campagnes$txvf')[,'max'] - subset(stats_chep, var == 'campagnes$txvf')[,'min'])), 3) campagnes$txm_n[i] <- round(1 - (abs(subset(stats_chep, var == 'campagnes$txm')[,'max'] - campagnes$txm[i]) / abs(subset(stats_chep, var == 'campagnes$txm')[,'max'] - subset(stats_chep, var == 'campagnes$txm')[,'min'])), 3) campagnes$ptgp_n[i] <- round(1 - (abs(subset(stats_chep, var == 'campagnes$ptgp')[,'max'] - campagnes$ptgp[i]) / abs(subset(stats_chep, var == 'campagnes$ptgp')[,'max'] - subset(stats_chep, var == 'campagnes$ptgp')[,'min'])), 3) campagnes$p120_n[i] <- round(1 - (abs(subset(stats_chep, var == 'campagnes$p120_c')[,'max'] - campagnes$p120_c[i]) / abs(subset(stats_chep, var == 'campagnes$p120_c')[,'max'] - subset(stats_chep, var == 'campagnes$p120_c')[,'min'])), 3) campagnes$p210_n[i] <- round(1 - (abs(subset(stats_chep, var == 'campagnes$p210_c')[,'max'] - campagnes$p210_c[i]) / abs(subset(stats_chep, var == 'campagnes$p210_c')[,'max'] - subset(stats_chep, var == 'campagnes$p210_c')[,'min'])), 3) #prol if (is.na(campagnes$prol[i])) { campagnes$prol_n[i] <- NA } else if (campagnes$prol[i] == 100) { campagnes$prol_n[i] <- 0.8 } else { campagnes$prol_n[i] <- 1 } campagnes$mort_n[i] <- round(1.0 * exp(-0.031 * campagnes$mort[i]), 3) #ivv if (is.na(campagnes$ravelamere[i]) | campagnes$ravelamere[i] == 1 | is.na(campagnes$ivv[i])) { campagnes$ivv_n[i] <- NA } else if (campagnes$ravelamere[i] == 2) { if (!is.na(campagnes$ivv[i])){ if (campagnes$ivv[i] > 460) { campagnes$ivv_n[i] <- 0 } else if (campagnes$ivv[i] < 390) { campagnes$ivv_n[i] <- 1 } else { campagnes$ivv_n[i] <- round(1 - abs(390 - campagnes$ivv[i]) / abs(390 - 460), 3) } } } else { if (!is.na(campagnes$ivv[i])) { if (campagnes$ivv[i] > 435) { campagnes$ivv_n[i] <- 0 } else if (campagnes$ivv[i] < 365) { campagnes$ivv_n[i] <- 1 } else { campagnes$ivv_n[i] <- round(1 - abs(365 - campagnes$ivv[i]) / abs(365 - 435), 3) } } } # _________________________________________________ calcul des notes campagnes somme <- 0 pond <- sum(Pcamp[2,c(2:10)]) for (j in c(14:22)){ # attention a la correspondance des num?ros de colonnes !!! if (is.na(campagnes[i,j])){ valperf <- 0 #mt_col <- mt_col + 1 # nb de colonnes sans valeur pond <- pond - Pcamp[1, (j - 13 + 1)] } else { valperf <- campagnes[i, j] * Pcamp[1, (j - 13 + 1)] # critere normalise X ponderation } somme <- somme + valperf # somme sur une ligne } SOMME_tot <- somme / pond * 10 # rapport en prenant que les criteres ayant une valeur if (is.na(campagnes$ptgp_n[i]) & is.na(campagnes$p120_n[i]) & is.na(campagnes$p210_n[i])){ campagnes$ecowcamp[i] <- round(SOMME_tot, 1) } else { campagnes$ecowcamp[i] <- round(SOMME_tot * 10, 0) } } # remplissage de la table vaches avec les notes campagnes for (i in 1:nrow(vaches)){ # moyenne notes campagnes subcamp <- subset(campagnes, campagnes$mere == vaches$anim[i] & campagnes$ecowcamp > 10) if (nrow(subcamp)>0){ vaches$moyecowcamp[i] <- round(mean(subcamp$ecowcamp, na.rm=TRUE), 1) } else { vaches$moyecowcamp[i] <- NA } # vaches non class?es en minuscules if (is.na(vaches$ecowcarr[i])) { vaches$nobovi[i] <- vaches$nobovi[i] %>% str_to_lower() } # donneuses soulignees par un # embr <- subset(PROD, PROD$mere == vaches$anim[i] & PROD$indite == 'O') if (nrow(embr) > 0) { vaches$nobovi[i] <- paste('#', vaches$nobovi[i], sep=' ') } } vaches$rg_camp <- rank(1 / vaches$moyecowcamp, na.last='keep') # creation du tableau CAMPAGNES nbcol <- max(campagnes$ravelamere, na.rm = TRUE) # nombre de colonnes de rangs de v?lage ? cr?er CAMP <- cbind('anim'=vaches$anim, create_df(nrow(vaches), c(1:nbcol))) for (i in 1:nrow(CAMP)){ subcamp <- subset(campagnes, campagnes$mere == CAMP$anim[i]) for (j in 2:ncol(CAMP)){ veaux <- subset(subcamp, subcamp$ravelamere == j-1) if (nrow(veaux) > 0) { CAMP[i,j] <- paste(veaux$noms[1], veaux$ecowcamp[1], sep=' : ') } } } vaches <- merge(vaches, CAMP, by.x='anim', by.y='anim', all.x=T, all.y=T) # selection des colonnes d'interet pour la table finale tabfinal <- merge(vaches[,c('chepdet', 'anim', 'nobovi', 'nompere', 'indisu', 'tempsprod', 'age_years', 'ecowcarr', 'rg_carr', 'ptgV', 'agevel1', 'ivv1', 'ivv2p', 'prol', 'mort', 'txrepros', 'nbpp', 'txvf', 'pn_m', 'pn_f', 'p120_m', 'p120_f', 'p210_m', 'p210_f', 'ptgP', 'moyecowcamp', 'rg_camp')], CAMP, by.x='anim', by.y='anim', all.x=T, all.y=T) tabfinal <- tabfinal[order(tabfinal$rg_carr),] tabfinal <- tabfinal %>% select(chepdet, everything()) colnames(tabfinal)=c("CHEPTEL", "NUM_VACHE", "NOM_VACHE", "PERE", "ISU", "% VIE PRODUCTIVE", "AGE (annees)", "note eCow CARRIERE (/1000)", "rang CARRIERE", "pointage VACHE *m", "age 1er velage (m)", "IVV1 (j)", "IVV2+ (j)", "prolificite (%)", "mortalite av.sevr (%)", "% produits repros", "nb petits-produits", "% velages tranquilles", "PN males (kg)", "PN femelles (kg)", "P120 males (kg)", "P120 femelles (kg)", "P210 males (kg)","P210 femelles (kg)", "pointage PRODUITS *m", "Moyenne notes eCow CAMPAGNE (/100)", "rang CAMPAGNE", c(1:nbcol)) write.table(tabfinal, file = paste(rep, '/', CHEP, '_classement_eCow5.csv', sep = ""), quote = FALSE, dec = ",", row.names = FALSE, col.names = TRUE, sep = ";", qmethod = c("escape"), na = "") new <- Sys.time() - old print(paste('Calcul du classement ?Cow :', new, sep = '')) # a revoir pour les petits cheptels #render_vn(CHEP, TECH) ################################################################################ ### calcul du resume cheptel ################################################### ################################################################################ # lecture du fichier des stats des adherents detail_stats_chep <- read_delim(paste(rep_exp, "detail_stats_chep.csv", sep=''), ";", escape_double = FALSE, locale = locale(decimal_mark = ",", grouping_mark = ""), trim_ws = TRUE) #detail_stats_chep$date_calc <- '2020-09-06' # perfs dont l'unit? de calcul est la vache : ie toutes les vaches actives # isu, age, temps prod, ptg adulte, agevel1, ivv1 et 2+ # perfs dont l'unit? de calcul est le produit : ie tous les produits issus de vaches actives # prol, mort, tx de repros, nb de PP, tx de VF, PN, P120 et 210, ptg sevrage ## stats du cheptel a inserer dans la liste des adherents pour comparaison stats_chep_bis <- detail_stats_chep[1,] stats_chep_bis[1,] <- NA stats_chep_bis$ADHHBC <- CHEP stats_chep_bis$isu[1] <- round( mean(vaches$indisu, na.rm=T), 1) stats_chep_bis$tps_prod[1] <- round( mean(vaches$tempsprod, na.rm=T), 1) stats_chep_bis$age[1] <- round( mean(vaches$age_years, na.rm=T), 1) stats_chep_bis$ptgv[1] <- round( mean(vaches$ptgV, na.rm=T), 1) stats_chep_bis$agevel1[1] <- round( mean(vaches$agevel1, na.rm=T), 1) stats_chep_bis$ivv1[1] <- round( mean(vaches$ivv1, na.rm=T), 1) stats_chep_bis$ivv2p[1] <- round( mean(vaches$ivv2p, na.rm=T), 1) stats_chep_bis$prol[1] <- round( nrow(PROD) / nrow(campagnes) * 100, 1) stats_chep_bis$mort[1] <- round( nrow(subset(PROD, PROD$mortsev == 'O')) / nrow(PROD) * 100, 1) stats_chep_bis$txvf[1] <- round( nrow(subset(PROD, PROD$conais %in% c('1','2'))) / nrow(PROD) * 100, 1) stats_chep_bis$tx_repros[1] <- round( nrow(subset(PROD, PROD$NBPRODIPG > 0)) / nrow(PROD) * 100, 1) stats_chep_bis$nbpp[1] <- sum(PROD$NBPRODIPG, na.rm=TRUE) stats_chep_bis$ptgp[1] <- round( mean(0.75 * PROD$devmus + 0.25 * PROD$devsqe, na.rm=TRUE), 1) stats_chep_bis$pnm[1] <- round( mean(subset(PROD, PROD$sexbov == '1')$ponais, na.rm=TRUE), 1) stats_chep_bis$pnf[1] <- round( mean(subset(PROD, PROD$sexbov == '2')$ponais, na.rm=TRUE), 1) stats_chep_bis$p120m[1] <- round( mean(subset(PROD, PROD$sexbov == '1')$pat04m, na.rm=TRUE), 1) stats_chep_bis$p120f[1] <- round( mean(subset(PROD, PROD$sexbov == '2')$pat04m, na.rm=TRUE), 1) stats_chep_bis$p210m[1] <- round( mean(subset(PROD, PROD$sexbov == '1')$pat07m, na.rm=TRUE), 1) stats_chep_bis$p210f[1] <- round( mean(subset(PROD, PROD$sexbov == '2')$pat07m, na.rm=TRUE), 1) stats_chep_bis$date_calc[1] <- as.character(Sys.Date()) # on met a jour le fichier des stats des adh #____________________________ prevoir une ?tape de verif de VALEURS ABERRENTES ! detail_stats_chep <- subset(detail_stats_chep, detail_stats_chep$ADHHBC != CHEP) detail_stats_chep <- rbind(detail_stats_chep, stats_chep_bis) write.table(detail_stats_chep, file = paste(rep_exp, "detail_stats_chep.csv", sep = ""), quote = FALSE, dec = ",", row.names = FALSE, col.names = TRUE, sep = ";", qmethod = c("escape"),na = "") ## stats du cheptel avec distribution des adh?rents et des vaches rownames(stats_chep) <- stats_chep$var res_chep <- stats_chep[c('vaches$indisu', 'vaches$tempsprod', 'vaches$age_years', 'vaches$ptgV','vaches$agevel1', 'vaches$ivv1', 'vaches$ivv2p', 'vaches$prol', 'vaches$mort', 'vaches$txrepros', 'vaches$nbpp', 'vaches$txvf', 'vaches$pn_m', 'vaches$pn_f', 'vaches$p120_m', 'vaches$p120_f', 'vaches$p210_m', 'vaches$p210_f', 'vaches$ptgP'), c('moy', 'min', 'q1', 'med', 'q3', 'max')] # creation d'un table contenant la distribution des cheptels pour chaque variable stats_adh <- data.frame(matrix(NA, ncol = 7,nrow = 19)) colnames(stats_adh) <- c("var", "moy_c", "min_c", "Q1_c", "med_c", "Q3_c", "max_c" ) stats_adh[,1] <- c('isu','tps_prod','age','ptgv','agevel1','ivv1','ivv2p', 'prol','mort','tx_repros','nbpp','txvf', 'pnm','pnf','p120m','p120f','p210m','p210f','ptgp') # remplissage de la table for (i in 1:nrow(stats_adh)){ stats_adh$moy_c[i] <- round(mean(unlist(detail_stats_chep[,i + 1]), na.rm = TRUE), 1) stats_adh$min_c[i] <- round(min(detail_stats_chep[,i + 1], na.rm = TRUE), 1) stats_adh$Q1_c[i] <- round(quantile(detail_stats_chep[,i + 1], probs = 0.25, na.rm = TRUE), 1) stats_adh$med_c[i] <- round(quantile(detail_stats_chep[,i + 1], probs = 0.50, na.rm = TRUE), 1) stats_adh$Q3_c[i] <- round(quantile(detail_stats_chep[,i + 1], probs = 0.75,na.rm = TRUE), 1) stats_adh$max_c[i] <- round(max(detail_stats_chep[,i + 1], na.rm = TRUE), 1) } # on fusionne distribution des adherents et des vaches du cheptel d'?tude STATS <- cbind(stats_adh, t(stats_chep_bis[, c(2 : (ncol(stats_chep_bis) - 1))])) STATS <- cbind(STATS, res_chep) STATS$var <- c("ISU", "% vie productive", "age (annees)", "pointage VACHE *m", "age 1er velage (m)", "IVV1 (j)", "IVV2+ (j)", "prolificite (%)", "mortalite av.sevr (%)", "% produits repros", "nb petits-produits", "% velages tranquilles", "PN males (kg)", "PN femelles (kg)", "P120 males (kg)", "P120 femelles (kg)", "P210 males (kg)", "P210 femelles (kg)", "pointage PRODUITS *m") colnames(STATS) <- c('Variable', 'Moyenne_ADH', 'Min_ADH', 'Q1_ADH', 'Mediane_ADH', 'Q3_ADH', 'Max_ADH', 'Moyenne_cheptel', 'Moyenne_vaches', 'Min_vaches', 'Q1_vaches', 'Mediane_vaches', 'Q3_vaches', 'Max_vaches') write.table(STATS, file = paste(rep, '/', CHEP, '_ResChep_eCow5.csv', sep = ""), quote = FALSE, dec = ",", row.names = FALSE, col.names = TRUE, sep = ";", qmethod = c("escape"), na = "") ################################################################################ ### remont?e des perfs des taureaux marquants ################################## ################################################################################ # on r?cupere les peres des animaux actifs # on regarde s'ils ont un nombre raisonnable de produits, ie moins de 275 # si c'est la cas, on r?cupere tous les produits puis on trie ceux n?s dans le cheptel ## update du 13dec2021 apres mise en prod du WS sur la production d'un animal dans un cheptel particulier peres <- inventaire %>% filter(trim_str(chna) == CHEP & !is.na(pere)) %>% distinct(pere, nompere) %>% add_column('naisseur' = NA) if (nrow(peres) > 0) { for (i in 1:nrow(peres)) { li_anim <- chgt_infos(trim_str(peres$pere[i])) if (is.data.frame(li_anim)) { peres$naisseur[i] <- li_anim$nomnais[1] } } prod_peres <- inventaire[0,] pp_peres <- inventaire[0,] for (i in 1 : nrow(peres)) { animal <- peres$pere[i] cat("\n", animal, peres$nompere[i]) try({ produits <- get_produits_in_chep(animal, CHEP) # loc update if (is.data.frame(produits) == TRUE) { #__________________________________ produits <- produits %>% filter(trim_str(chna) == CHEP) prod_peres <- rbind(prod_peres, produits) for (j in 1:nrow(produits)) { if (produits$sexbov[j] == '2' & as.numeric(produits$nbdescendants[j]) > 0) { pp <- get_produits_vache(trim_str(produits$anim[j])) if (is.data.frame(pp) == TRUE) { #______________________________ pp <- pp %>% filter(trim_str(chna) == CHEP) pp_peres <- rbind(pp_peres, pp) } } } } else { #________________________________________________________________ cat("\n", "Aucune donn?e charg?e") } }) } if (nrow(prod_peres) > 0) { if (!is.na(prod_peres$danais[1]) & nchar(as.character(prod_peres$danais[1])) > 10) { prod_peres$danais <- as.Date(substr(as.POSIXct(prod_peres$danais / 1000, origin = "1970-01-01"), 1, 10), format = "%Y-%m-%d", origin = "1970-01-01") } else { prod_peres$danais <- as.Date(prod_peres$danais, format = "%Y-%m-%d") } sortis <- subset(prod_peres, !is.na(prod_peres$dasort)) if (nrow(sortis) > 0 && nchar(as.character(sortis$dasort[1])) > 10) { prod_peres$dasort <- as.Date(substr(as.POSIXct(prod_peres$dasort / 1000, origin = "1970-01-01"), 1, 10), format = "%Y-%m-%d", origin = "1970-01-01") } else { prod_peres$dasort <- as.Date(prod_peres$dasort, format = "%Y-%m-%d") } if (!is.na(prod_peres$danaismere[1]) & nchar(as.character(prod_peres$danaismere[1])) > 10) { prod_peres$danaismere <- as.Date(substr(as.POSIXct(prod_peres$danaismere / 1000, origin = "1970-01-01"), 1, 10), format = "%Y-%m-%d", origin = "1970-01-01") } else { prod_peres$danaismere <- as.Date(prod_peres$danaismere, format = "%Y-%m-%d") } prod_peres$mere <- trim_str(prod_peres$mere) prod_peres$pere <- trim_str(prod_peres$pere) prod_peres$anim <- trim_str(prod_peres$anim) prod_peres$ds <- as.numeric(prod_peres$ds) prod_peres$af <- as.numeric(prod_peres$af) prod_peres$dmC <- as.numeric(prod_peres$dmC) # liste de tous leurs produitsdir produitsdir <- prod_peres #%>% filter(chna == CHEP) # _________________________ filtre a reflechir ????? # vachestot actives vachestot <- subset(prod_peres, prod_peres$sexbov == '2' & prod_peres$nbdescendants > 0 ) # les veaux port?s sont rajout?s aux produits si non r?cup?r?s avant if (nrow(porteuses) > 0) { for (i in 1:nrow(porteuses)) { if (!(porteuses$ANIM[i] %in% trim_str(produitsdir$anim))) { temp <- appel_infos(porteuses$ANIM[i], hbcanim) li_mere <- subset(vachestot, vachestot$anim == porteuses$MEREIPG[i]) if ( is.data.frame(temp) && nrow(temp) > 0 ) { temp$mere[1] <- porteuses$MEREIPG[i] temp[1, c(60:67, 86:103)] <- NA if ( nrow(li_mere) > 0){ temp$danaismere[1] <- as.character(li_mere$danais[1]) } temp$indite[1] <- 'O_corr' tryCatch({ produitsdir <- rbind(produitsdir, temp[,colnames(produitsdir)]) #-------------------------------- tryCatch à supp }, error = function(e) e) } } } } # modifs des types de donn?es, pour calcul par la suite produitsdir$danais <- as.Date(produitsdir$danais, format = "%Y-%m-%d") produitsdir$dasort <- as.Date(produitsdir$dasort, format = "%Y-%m-%d") produitsdir$mere <- trim_str(produitsdir$mere) produitsdir$pere <- trim_str(produitsdir$pere) produitsdir$anim <- trim_str(produitsdir$anim) produitsdir$ravelamere <- as.numeric(produitsdir$ravelamere) produitsdir$ivv <- as.numeric(produitsdir$ivv) produitsdir$campn <- as.numeric(produitsdir$campn) produitsdir$nbdescendants <- as.numeric(produitsdir$nbdescendants) produitsdir$ponais <- as.numeric(produitsdir$ponais) produitsdir$pat04m <- as.numeric(produitsdir$pat04m) produitsdir$pat07m <- as.numeric(produitsdir$pat07m) produitsdir$devsqe <- as.numeric(produitsdir$devsqe) produitsdir$devmus <- as.numeric(produitsdir$devmus) produitsdir$aptfon <- as.numeric(produitsdir$aptfon) # on ne garde que les TE port?s par une vache active du cheptel PRODDIR <- subset(produitsdir, produitsdir$indite != 'O') # ajout des produitsdir IPG PRODDIR <- merge(PRODDIR, parentsIPG, by.x='anim', by.y='ANIM', all.x=T, all.y=F) PRODDIR <- PRODDIR[order(PRODDIR$danais, decreasing = F),] PRODDIR <- PRODDIR[order(PRODDIR$mere, decreasing = T),] # correction des ravelamere des TE si possible for (i in 1:nrow(PRODDIR)) { if (is.na(PRODDIR$ravelamere[i])) { if (!is.na(PRODDIR$ravelamere[i+1]) & PRODDIR$ravelamere[i+1] %in% c(1, 2)) { PRODDIR$ravelamere[i] <- 1 PRODDIR$typemere[i] <- 'G' } else if (!is.na(PRODDIR$ravelamere[i+1]) & PRODDIR$ravelamere[i+1] > 1) { PRODDIR$ravelamere[i] <- PRODDIR$ravelamere[i+1] - 1 PRODDIR$typemere[i] <- 'V' } } } # age au velage de la mere PRODDIR$agevel <- round(time_length(interval(PRODDIR$danaismere, PRODDIR$danais), unit="months"), 1) # IVV : utilisation de la colonne deja pr?sente de HBCANIM for (i in 1:nrow(PRODDIR)) { if (PRODDIR$indite[i] == 'O_corr') { PRODDIR$nobovi[i] <- paste('#', PRODDIR$nobovi[i], sep='') } # repro if (PRODDIR$anim[i] %in% czhbc$ANIM | (!is.na(PRODDIR$NBPRODIPG[i]) & PRODDIR$NBPRODIPG[i] > 0) | (!is.na(PRODDIR$nbdescendants[i]) & as.numeric(PRODDIR$nbdescendants[i]) > 0)) { PRODDIR$repro[i] <- 'O' } else { PRODDIR$repro[i] <- NA PRODDIR$nobovi[i] <- PRODDIR$nobovi[i] %>% str_to_lower() } # mortalite if (!is.na(PRODDIR$dasort[i]) & !is.na(PRODDIR$casort[i]) & PRODDIR$casort[i] == 'M' & time_length(interval(PRODDIR$danais[i], PRODDIR$dasort[i]), unit="days") < 211){ PRODDIR$mortsev[i] <- 'O' PRODDIR$nobovi[i]=paste(PRODDIR$nobovi[i], ' (MavS)', sep='') } else { PRODDIR$mortsev[i] <- NA } # IVV if (i > 1) { # cas normaux if (!is.na(PRODDIR$ravelamere[i]) & !is.na(PRODDIR$ravelamere[i-1]) & PRODDIR$ravelamere[i] != 1 & PRODDIR$ravelamere[i] == PRODDIR$ravelamere[i-1] + 1 #& !is.na(PRODDIR$cofgmumere[i]) & PRODDIR$cofgmumere[i] != '2' & !is.na(PRODDIR$mere[i]) & PRODDIR$mere[i] == PRODDIR$mere[i-1]) { PRODDIR$ivv[i] <- time_length(interval(PRODDIR$danais[i-1], PRODDIR$danais[i]), unit="days") # jumeaux } else if (!is.na(PRODDIR$ravelamere[i]) & !is.na(PRODDIR$ravelamere[i-1]) & PRODDIR$ravelamere[i] != 1 & PRODDIR$ravelamere[i] == PRODDIR$ravelamere[i-1] & !is.na(PRODDIR$cofgmumere[i]) & PRODDIR$cofgmumere[i] == '2' & !is.na(PRODDIR$mere[i]) & PRODDIR$mere[i] == PRODDIR$mere[i-1]) { PRODDIR$ivv[i] <- PRODDIR$ivv[i-1] # rang de v?lage manquant } else if (!is.na(PRODDIR$ravelamere[i]) & !is.na(PRODDIR$ravelamere[i-1]) & PRODDIR$ravelamere[i] != 1 & !is.na(PRODDIR$cofgmumere[i]) & PRODDIR$cofgmumere[i] != '2' & !is.na(PRODDIR$mere[i]) & PRODDIR$mere[i] == PRODDIR$mere[i-1]) { PRODDIR$ivv[i] <- round(time_length(interval(PRODDIR$danais[i-1], PRODDIR$danais[i]), unit="days") / (PRODDIR$ravelamere[i] - PRODDIR$ravelamere[i-1]), 0) } else { PRODDIR$ivv[i] <- NA } } } # calcul des effets du cheptel : rang de velage et sexe du veau effet <- PRODDIR %>% group_by(typemere, sexbov) %>% summarise(m_PN = round(mean(ponais, na.rm=T), 1), m_p120 = round(mean(pat04m, na.rm=T), 1), m_p210 = round(mean(pat07m, na.rm=T), 1)) effet$diff_pn <- effet$m_PN - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_PN[1] effet$diff_p120 <- effet$m_p120 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p120[1] effet$diff_p210 <- effet$m_p210 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p210[1] # calcul des effets du cheptel : sexe sur la repro effetsexe <- PRODDIR %>% filter(NBPRODIPG > 0) %>% group_by(sexbov) %>% summarise(nbpp = round(mean(NBPRODIPG, na.rm=T), 1), nbpp_med = round(median(NBPRODIPG, na.rm=T), 1) ) rapport_MF <- round(subset(effetsexe, effetsexe$sexbov == '1')$nbpp_med[1] / subset(effetsexe, effetsexe$sexbov == '2')$nbpp_med[1], 0) # report des effets sur les produitsdir for (i in 1:nrow(PRODDIR)) { if (PRODDIR$sexbov[i] == '2') { #____________________________________ FEMELLES PRODDIR$nbpp_corr[i] <- PRODDIR$NBPRODIPG[i] * rapport_MF if (!is.na(PRODDIR$typemere[i]) & PRODDIR$typemere[i] == 'G') { #____genisses if (!is.na(PRODDIR$ponais[i])) { PRODDIR$pn_corr[i] <- (PRODDIR$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_pn[1]) } else { PRODDIR$pn_corr[i] <- NA } if (!is.na(PRODDIR$pat04m[i])) { PRODDIR$p120_corr[i] <- (PRODDIR$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p120[1]) } else { PRODDIR$p120_corr[i] <- NA } if (!is.na(PRODDIR$pat07m[i])) { PRODDIR$p210_corr[i] <- (PRODDIR$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p210[1]) } else { PRODDIR$p210_corr[i] <- NA } } else { #_____________________________________________ vachestot ou inconnu if (!is.na(PRODDIR$ponais[i])) { PRODDIR$pn_corr[i] <- (PRODDIR$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_pn[1]) } else { PRODDIR$pn_corr[i] <- NA } if (!is.na(PRODDIR$pat04m[i])) { PRODDIR$p120_corr[i] <- (PRODDIR$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p120[1]) } else { PRODDIR$p120_corr[i] <- NA } if (!is.na(PRODDIR$pat07m[i])) { PRODDIR$p210_corr[i] <- (PRODDIR$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p210[1]) } else { PRODDIR$p210_corr[i] <- NA } } } else { #______________________________________________________________ MALES PRODDIR$nbpp_corr[i] <- PRODDIR$NBPRODIPG[i] if (!is.na(PRODDIR$typemere[i]) & PRODDIR$typemere[i] == 'G') { #_________________________________genisses if (!is.na(PRODDIR$ponais[i])) { PRODDIR$pn_corr[i] <- (PRODDIR$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_pn[1]) } else { PRODDIR$pn_corr[i] <- NA } if (!is.na(PRODDIR$pat04m[i])) { PRODDIR$p120_corr[i] <- (PRODDIR$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p120[1]) } else { PRODDIR$p120_corr[i] <- NA } if (!is.na(PRODDIR$pat07m[i])) { PRODDIR$p210_corr[i] <- (PRODDIR$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p210[1]) } else { PRODDIR$p210_corr[i] <- NA } } else { #_____________________________________________ vachestot ou inconnu if (!is.na(PRODDIR$ponais[i])) { PRODDIR$pn_corr[i] <- (PRODDIR$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_pn[1]) } else { PRODDIR$pn_corr[i] <- NA } if (!is.na(PRODDIR$pat04m[i])) { PRODDIR$p120_corr[i] <- (PRODDIR$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p120[1]) } else { PRODDIR$p120_corr[i] <- NA } if (!is.na(PRODDIR$pat07m[i])) { PRODDIR$p210_corr[i] <- (PRODDIR$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p210[1]) } else { PRODDIR$p210_corr[i] <- NA } } } } } if (nrow(vachestot) > 0) { # recherche des meres dans les porteuses pour aller chercher # les produitstot s'ils existent dans HBCANIM porteuses <- subset(indite, !is.na(indite$MEREIPG) & indite$MEREIPG %in% trim_str(vachestot$anim)) donneuses <- subset(indite, !is.na(indite$MERECPB) & indite$MERECPB %in% trim_str(vachestot$anim)) # l'indicateur de donneuse d'embryon est renseign? apr?s dans --> vachestot$ACINAC for (i in 1:nrow(vachestot)) { if (is.na(vachestot$dasort[i])){ vachestot$age_days[i] <- time_length(interval(vachestot$danais[i], Sys.Date()), unit="days") } else { vachestot$age_days[i] <- time_length(interval(vachestot$danais[i], vachestot$dasort[i]), unit="days") } } vachestot$age_years <- round(vachestot$age_days / 365, 1) # liste de tous leurs produitstot produitstot <- pp_peres #%>% filter(chna == CHEP) # ___________________________ filtre a reflechir ????? # les veaux port?s sont rajout?s aux produits si non r?cup?r?s avant if (nrow(porteuses) > 0) { for (i in 1:nrow(porteuses)) { if (!(porteuses$ANIM[i] %in% trim_str(produitstot$anim))) { temp <- appel_infos(porteuses$ANIM[i], hbcanim) li_mere <- subset(vachestot, vachestot$anim == porteuses$MEREIPG[i]) if ( is.data.frame(temp) && nrow(temp) > 0 ) { temp$mere[1] <- porteuses$MEREIPG[i] temp[1, c(60:67, 86:103)] <- NA if ( nrow(li_mere) > 0){ temp$danaismere[1] <- as.character(li_mere$danais[1]) } temp$indite[1] <- 'O_corr' produitstot <- rbind(produitstot, temp[,colnames(produitstot)]) } } } } # modifs des types de donn?es, pour calcul par la suite produitstot$danais <- as.Date(produitstot$danais, format = "%Y-%m-%d") produitstot$dasort <- as.Date(produitstot$dasort, format = "%Y-%m-%d") produitstot$mere <- trim_str(produitstot$mere) produitstot$pere <- trim_str(produitstot$pere) produitstot$anim <- trim_str(produitstot$anim) produitstot$ravelamere <- as.numeric(produitstot$ravelamere) produitstot$ivv <- as.numeric(produitstot$ivv) produitstot$campn <- as.numeric(produitstot$campn) produitstot$nbdescendants <- as.numeric(produitstot$nbdescendants) produitstot$ponais <- as.numeric(produitstot$ponais) produitstot$pat04m <- as.numeric(produitstot$pat04m) produitstot$pat07m <- as.numeric(produitstot$pat07m) produitstot$devsqe <- as.numeric(produitstot$devsqe) produitstot$devmus <- as.numeric(produitstot$devmus) produitstot$aptfon <- as.numeric(produitstot$aptfon) # on ne garde que les TE port?s par une vache active du cheptel PRODTOT <- subset(produitstot, produitstot$indite != 'O') # ajout des produitstot IPG PRODTOT <- merge(PRODTOT, parentsIPG, by.x='anim', by.y='ANIM', all.x=T, all.y=F) PRODTOT <- PRODTOT[order(PRODTOT$danais, decreasing = F),] PRODTOT <- PRODTOT[order(PRODTOT$mere, decreasing = T),] # correction des ravelamere des TE si possible for (i in 1:nrow(PRODTOT)) { if (is.na(PRODTOT$ravelamere[i])) { if (!is.na(PRODTOT$ravelamere[i+1]) & PRODTOT$ravelamere[i+1] %in% c(1, 2)) { PRODTOT$ravelamere[i] <- 1 PRODTOT$typemere[i] <- 'G' } else if (!is.na(PRODTOT$ravelamere[i+1]) & PRODTOT$ravelamere[i+1] > 1) { PRODTOT$ravelamere[i] <- PRODTOT$ravelamere[i+1] - 1 PRODTOT$typemere[i] <- 'V' } } } # age au velage de la mere PRODTOT$agevel <- round(time_length(interval(PRODTOT$danaismere, PRODTOT$danais), unit="months"), 1) # IVV : utilisation de la colonne deja presente de HBCANIM for (i in 1:nrow(PRODTOT)) { if (PRODTOT$indite[i] == 'O_corr') { PRODTOT$nobovi[i] <- paste('#', PRODTOT$nobovi[i], sep='') } # repro if (PRODTOT$anim[i] %in% czhbc$ANIM | (!is.na(PRODTOT$NBPRODIPG[i]) & PRODTOT$NBPRODIPG[i] > 0) | (!is.na(PRODTOT$nbdescendants[i]) & as.numeric(PRODTOT$nbdescendants[i]) > 0)) { PRODTOT$repro[i] <- 'O' } else { PRODTOT$repro[i] <- NA PRODTOT$nobovi[i] <- PRODTOT$nobovi[i] %>% str_to_lower() } # mortalite if (!is.na(PRODTOT$dasort[i]) & !is.na(PRODTOT$casort[i]) & PRODTOT$casort[i] == 'M' & time_length(interval(PRODTOT$danais[i], PRODTOT$dasort[i]), unit="days") < 211){ PRODTOT$mortsev[i] <- 'O' PRODTOT$nobovi[i]=paste(PRODTOT$nobovi[i], ' (MavS)', sep='') } else { PRODTOT$mortsev[i] <- NA } # IVV if (i > 1) { # cas normaux if (!is.na(PRODTOT$ravelamere[i]) & !is.na(PRODTOT$ravelamere[i-1]) & PRODTOT$ravelamere[i] != 1 & PRODTOT$ravelamere[i] == PRODTOT$ravelamere[i-1] + 1 #& !is.na(PRODTOT$cofgmumere[i]) & PRODTOT$cofgmumere[i] != '2' & !is.na(PRODTOT$mere[i]) & PRODTOT$mere[i] == PRODTOT$mere[i-1]) { PRODTOT$ivv[i] <- time_length(interval(PRODTOT$danais[i-1], PRODTOT$danais[i]), unit="days") # jumeaux } else if (!is.na(PRODTOT$ravelamere[i]) & !is.na(PRODTOT$ravelamere[i-1]) & PRODTOT$ravelamere[i] != 1 & PRODTOT$ravelamere[i] == PRODTOT$ravelamere[i-1] & !is.na(PRODTOT$cofgmumere[i]) & PRODTOT$cofgmumere[i] == '2' & !is.na(PRODTOT$mere[i]) & PRODTOT$mere[i] == PRODTOT$mere[i-1]) { PRODTOT$ivv[i] <- PRODTOT$ivv[i-1] # rang de v?lage manquant } else if (!is.na(PRODTOT$ravelamere[i]) & !is.na(PRODTOT$ravelamere[i-1]) & PRODTOT$ravelamere[i] != 1 & !is.na(PRODTOT$cofgmumere[i]) & PRODTOT$cofgmumere[i] != '2' & !is.na(PRODTOT$mere[i]) & PRODTOT$mere[i] == PRODTOT$mere[i-1]) { PRODTOT$ivv[i] <- round(time_length(interval(PRODTOT$danais[i-1], PRODTOT$danais[i]), unit="days") / (PRODTOT$ravelamere[i] - PRODTOT$ravelamere[i-1]), 0) } else { PRODTOT$ivv[i] <- NA } } } # calcul des effets du cheptel : rang de velage et sexe du veau effet <- PRODTOT %>% group_by(typemere, sexbov) %>% summarise(m_PN = round(mean(ponais, na.rm=T), 1), m_p120 = round(mean(pat04m, na.rm=T), 1), m_p210 = round(mean(pat07m, na.rm=T), 1)) effet$diff_pn <- effet$m_PN - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_PN[1] effet$diff_p120 <- effet$m_p120 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p120[1] effet$diff_p210 <- effet$m_p210 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p210[1] # calcul des effets du cheptel : sexe sur la repro effetsexe <- PRODTOT %>% filter(NBPRODIPG > 0) %>% group_by(sexbov) %>% summarise(nbpp = round(mean(NBPRODIPG, na.rm=T), 1), nbpp_med = round(median(NBPRODIPG, na.rm=T), 1) ) rapport_MF <- round(subset(effetsexe, effetsexe$sexbov == '1')$nbpp_med[1] / subset(effetsexe, effetsexe$sexbov == '2')$nbpp_med[1], 0) # report des effets sur les produitstot for (i in 1:nrow(PRODTOT)) { if (PRODTOT$sexbov[i] == '2') { #___________________________________ FEMELLES PRODTOT$nbpp_corr[i] <- PRODTOT$NBPRODIPG[i] * rapport_MF if (!is.na(PRODTOT$typemere[i]) & PRODTOT$typemere[i] == 'G') { #___genisses if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } else { #________________________________________________ vachestot ou inconnu if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } } else { #______________________________________________________________ MALES PRODTOT$nbpp_corr[i] <- PRODTOT$NBPRODIPG[i] if ( !is.na(PRODTOT$typemere[i]) & PRODTOT$typemere[i] == 'G') { #_________________________________genisses if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } else { #_____________________________________________ vachestot ou inconnu if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } } } # calcul des donn?es ?labor?es par vache active for (i in 1:nrow(vachestot)) { # ___________________________________________rappel des produitstot par vache veaux <- PRODTOT %>% filter(mere == vachestot$anim[i]) # ___________________________________________calcul des infos utiles par vache # calcul du poids adulte estim? et synth?se pointage vache ___________________ if (!is.na(vachestot$dmC[i])) { vachestot$ptgV[i] <- round(0.6 * vachestot$dmC[i] + 0.15 * vachestot$ds[i] + 0.25 * vachestot$af[i], 1) } else { vachestot$ptgV[i] <- NA } if (nrow(veaux) > 3){ vachestot$precocite[i] <- round(mean((veaux$devsqe - veaux$devmus), na.rm=TRUE), 2) alpha <- 1.62 - 0.01 * vachestot$precocite[i] } else { vachestot$precocite[i] <- NA alpha <- 1.62 } if (!is.na(vachestot$pat24m[i])) { vachestot$pad[i] <- round((vachestot$pat24m[i] - 50 * exp(-720 * alpha * 10**(-3))) / (1 - exp(-720 * alpha * 10**(-3))), 1) } else if (!is.na(vachestot$pat18m[i])) { vachestot$pad[i] <- round((vachestot$pat18m[i] - 50 * exp(-540 * alpha * 10**(-3))) / (1 - exp(-540 * alpha * 10**(-3))), 1) } else if (!is.na(vachestot$pat12m[i])) { vachestot$pad[i] <- round((vachestot$pat12m[i] - 50 * exp(-360 * alpha * 10**(-3))) / (1-exp(-360 * alpha * 10**(-3))), 1) } else { vachestot$pad[i] <- NA } # calcul des perfs de repro et du temps productif ____________________________ vachestot$nbcampvel[i] <- (max(veaux$campn) - min(veaux$campn) + 1) if (1 %in% veaux$ravelamere) { vachestot$agevel1[i] <- subset(veaux, veaux$ravelamere == 1)$agevel[1] } else { vachestot$agevel1[i] <- NA } if (2 %in% veaux$ravelamere) { vachestot$ivv1[i] <- subset(veaux, veaux$ravelamere == 2)$ivv[1] } else { vachestot$ivv1[i] <- NA } if (3 %in% veaux$ravelamere) { vachestot$ivv2p[i] <- round(mean(subset(veaux, veaux$ravelamere > 2)$ivv, na.rm=T), 1) } if (is.na(vachestot$ivv1[i]) | (!is.na(vachestot$ivv1[i]) & vachestot$ivv1[i] < 390) ){ e2 <- 0 } else if (!is.na(vachestot$ivv1[i]) & vachestot$ivv1[i] >= 390) { e2 <- vachestot$ivv1[i] - 390 } if (is.na(vachestot$ivv2p[i]) | (!is.na(vachestot$ivv2p[i]) & vachestot$ivv2p[i] < 365) ){ e3 <- 0 } else if (!is.na(vachestot$ivv2p[i]) & vachestot$ivv2p[i] >= 365) { e3 <- vachestot$ivv1[i] - 365 } if (is.na(vachestot$dasort[i])) { if (time_length(interval(max(veaux$danais, na.rm=T), Sys.Date()), unit="days") < 365) { e4 <- 0 } else { e4 <- time_length(interval(max(veaux$danais, na.rm=T), Sys.Date()), unit="days") - 365 } } else if (!is.na(vachestot$dasort[i])) { if (time_length(interval(max(veaux$danais, na.rm=T), vachestot$dasort[i]), unit="days") < 365) { e4 <- 0 } else { e4 <- time_length(interval(max(veaux$danais, na.rm=T), vachestot$dasort[i]), unit="days") - 365 } } vachestot$tempsprod[i] <- round( (vachestot$age_days[i] - ( vachestot$agevel1[i] * 30.4 + e2 + e3 * (vachestot$nbcampvel[i] - 2) + e4 )) / vachestot$age_days[i] * 100, 1) # calcul des donn?es synthetiques sur les produitstot ___________________________ vachestot$prol[i] <- round(nrow(veaux) / (vachestot$nbcampvel[i]) * 100, 1) vachestot$mort[i] <- round(nrow(subset(veaux, veaux$mortsev == 'O')) / nrow(veaux)* 100, 1) vachestot$txrepros[i] <- round(nrow(subset(veaux, veaux$repro == 'O')) / nrow(veaux)* 100, 1) vachestot$nbpp[i] <- sum(veaux$NBPRODIPG, na.rm=T) vachestot$nbpp_corr[i] <- sum(veaux$nbpp_corr, na.rm=T) vachestot$txmales[i] <- round(nrow(subset(veaux, veaux$sexbov == '1')) / nrow(veaux)* 100, 1) vachestot$txvf[i] <- round(nrow(subset(veaux, veaux$conais %in% c('1','2') )) / nrow(veaux)* 100, 1) vachestot$ptgP[i] <- round(0.75 * mean(veaux$devmus, na.rm=TRUE) + 0.25 * mean(veaux$devsqe, na.rm=TRUE), 1) vachestot$pn_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$ponais, na.rm=T), 1) vachestot$p120_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$pat04m, na.rm=T), 1) vachestot$p210_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$pat07m, na.rm=T), 1) vachestot$pn_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$ponais, na.rm=T), 1) vachestot$p120_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$pat04m, na.rm=T), 1) vachestot$p210_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$pat07m, na.rm=T), 1) vachestot$pn_corr[i] <- round(mean(veaux$pn_corr, na.rm=T), 1) vachestot$p120_corr[i] <- round(mean(veaux$p120_corr, na.rm=T), 1) vachestot$p210_corr[i] <- round(mean(veaux$p210_corr, na.rm=T), 1) ### convertion des NaN en NA L <- c('ptgP','pn_m','pn_f','pn_corr','p120_m','p120_f','p120_corr', 'p210_m','p210_f','p210_corr') for (j in L){ if (is.nan(vachestot[i,j]) == TRUE){ vachestot[i,j] <- NA } } } } } # calcul des stats par pere ____________________________________________________ stats_peres <- PRODDIR %>% group_by(pere) %>% summarise(nb_prod_in_chep = n()) %>% filter(nb_prod_in_chep >=5) stats_peres <- stats_peres %>% add_column(utilgen = NA, prol = NA, mort = NA, txrepros = NA, nbpp = NA, txvf = NA, pnm = NA, pnf = NA, p120m = NA, p120f = NA, p210m = NA, p210f = NA, dmsev = NA, dssev = NA, nbfilles_avecprod = NA, pctfilles_avecprod = NA, isu_fillestot = NA, age_sort_fillestot = NA, agevel1_fillestot = NA, ivv1_fillestot = NA, ivv2p_fillestot = NA, vieprod_fillestot = NA, dmad_fillestot = NA, dsad_fillestot = NA, afad_fillestot = NA, nbprod_fillestot = NA, txrepros_fillestot = NA, nbpp_fillestot = NA, prol_fillestot = NA, mort_fillestot = NA, txvf_fillestot = NA, nbfillesact_avecprod = NA, pctfillesact_avecprod = NA, isu_fillesact = NA, age_sort_fillesact = NA, agevel1_fillesact = NA, ivv1_fillesact = NA, ivv2p_fillesact = NA, vieprod_fillesact = NA, dmad_fillesact = NA, dsad_fillesact = NA, afad_fillesact = NA, nbprod_fillesact = NA, txrepros_fillesact = NA, nbpp_fillesact = NA, prol_fillesact = NA, mort_fillesact = NA, txvf_fillesact = NA, nbfilles_renouv = NA) for (i in 1:nrow(stats_peres)) { # stats sur la prod directe __________________________________________________ li_prod <- subset(PRODDIR, PRODDIR$pere == stats_peres$pere[i]) stats_peres$utilgen[i] <- round(nrow(subset(li_prod, li_prod$ravelamere == 1)) / nrow(li_prod) * 100, 1) stats_peres$prol[i] <- round(nrow(li_prod) / nrow(li_prod %>% distinct(danais, mere)) * 100, 1) stats_peres$mort[i] <- round(nrow(subset(li_prod, li_prod$mortsev == 'O')) / nrow(li_prod) * 100, 1) stats_peres$txrepros[i] <- round(nrow(subset(li_prod, li_prod$repro == 'O')) / nrow(subset(li_prod, is.na(li_prod$mortsev))) * 100, 1) stats_peres$nbpp[i] <- sum(li_prod$nbdescendants) stats_peres$txvf[i] <- round(nrow(subset(li_prod, li_prod$conais %in% c('1','2'))) / nrow(li_prod) * 100, 1) stats_peres$pnm[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$ponais, na.rm=T),1) stats_peres$pnf[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$ponais, na.rm=T),1) stats_peres$p120m[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$pat04m, na.rm=T),1) stats_peres$p120f[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$pat04m, na.rm=T),1) stats_peres$p210m[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$pat07m, na.rm=T),1) stats_peres$p210f[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$pat07m, na.rm=T),1) stats_peres$dmsev[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$devmus, na.rm=T),1) stats_peres$dssev[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$devsqe, na.rm=T),1) # stats sur la prod par les filles ___________________________________________ li_filles <- subset(vachestot, vachestot$pere == stats_peres$pere[i]) # modif du 30/04/2024 if (nrow(li_filles) > 0){ stats_peres$nbfilles_avecprod[i] <- nrow(li_filles) stats_peres$pctfilles_avecprod[i] <- round(nrow(li_filles) / nrow(subset(li_prod, li_prod$sexbov == '2')) * 100, 1) } if (nrow(li_filles) >= 3) { stats_peres$isu_fillestot[i] <- round(mean(li_filles$indisu, na.rm=T),1) stats_peres$age_sort_fillestot[i] <- round(mean(li_filles$age_years, na.rm=T),1) stats_peres$agevel1_fillestot[i] <- round(mean(li_filles$agevel1, na.rm=T),1) stats_peres$vieprod_fillestot[i] <- round(mean(li_filles$tempsprod, na.rm=T),1) stats_peres$ivv1_fillestot[i] <- round(mean(li_filles$ivv1, na.rm=T),1) stats_peres$ivv2p_fillestot[i] <- round(mean(li_filles$ivv2p, na.rm=T),1) stats_peres$dmad_fillestot[i] <- round(mean(li_filles$dmC, na.rm=T),1) stats_peres$dsad_fillestot[i] <- round(mean(li_filles$ds, na.rm=T),1) stats_peres$afad_fillestot[i] <- round(mean(li_filles$af, na.rm=T),1) stats_peres$prol_fillestot[i] <- round(mean(li_filles$prol, na.rm=T),1) stats_peres$mort_fillestot[i] <- round(mean(li_filles$mort, na.rm=T),1) stats_peres$txvf_fillestot[i] <- round(mean(li_filles$txvf, na.rm=T),1) stats_peres$nbprod_fillestot[i] <- round(sum(li_filles$nbdescendants),1) stats_peres$txrepros_fillestot[i] <- round(mean(li_filles$txrepros, na.rm=T),1) stats_peres$nbpp_fillestot[i] <- round(sum(li_filles$nbpp),1) } # stats sur la prod par les filles actives ___________________________________ li_filles_act <- subset(vachestot, vachestot$pere == stats_peres$pere[i] & is.na(vachestot$dasort)) # modif du 30/04/2024 if (nrow(li_filles_act) > 0) { stats_peres$nbfillesact_avecprod[i] <- nrow(li_filles_act) stats_peres$pctfillesact_avecprod[i] <- round(nrow(li_filles_act) / nrow(subset(li_prod, li_prod$sexbov == '2')) * 100, 1) } if (nrow(li_filles_act) >= 3) { stats_peres$isu_fillesact[i] <- round(mean(li_filles_act$indisu, na.rm=T),1) stats_peres$age_sort_fillesact[i] <- round(mean(li_filles_act$age_years, na.rm=T),1) stats_peres$agevel1_fillesact[i] <- round(mean(li_filles_act$agevel1, na.rm=T),1) stats_peres$vieprod_fillesact[i] <- round(mean(li_filles_act$tempsprod, na.rm=T),1) stats_peres$ivv1_fillesact[i] <- round(mean(li_filles_act$ivv1, na.rm=T),1) stats_peres$ivv2p_fillesact[i] <- round(mean(li_filles_act$ivv2p, na.rm=T),1) stats_peres$dmad_fillesact[i] <- round(mean(li_filles_act$dmC, na.rm=T),1) stats_peres$dsad_fillesact[i] <- round(mean(li_filles_act$ds, na.rm=T),1) stats_peres$afad_fillesact[i] <- round(mean(li_filles_act$af, na.rm=T),1) stats_peres$prol_fillesact[i] <- round(mean(li_filles_act$prol, na.rm=T),1) stats_peres$mort_fillesact[i] <- round(mean(li_filles_act$mort, na.rm=T),1) stats_peres$txvf_fillesact[i] <- round(mean(li_filles_act$txvf, na.rm=T),1) stats_peres$nbprod_fillesact[i] <- round(sum(li_filles_act$nbdescendants),1) stats_peres$txrepros_fillesact[i] <- round(mean(li_filles_act$txrepros, na.rm=T),1) stats_peres$nbpp_fillesact[i] <- round(sum(li_filles_act$nbpp),1) } #filles a venir nbfr <- nrow(subset(inventaire, inventaire$pere == stats_peres$pere[i] & inventaire$nbdescendants == 0 & inventaire$sexbov == '2')) if (nbfr > 0 ){ stats_peres$nbfilles_renouv[i] <- nbfr } } stats_peres <- merge(peres, stats_peres, all.x=F, all.y=T) write.table(stats_peres, file = paste(rep, '/', CHEP, '_ResTaureaux_eCow5.csv', sep = ""), quote = FALSE, dec = ",", row.names = FALSE, col.names = TRUE, sep = ";", qmethod = c("escape"), na = "") ################################################################################ ### remontee des lignees femelles ############################################## ################################################################################ hbcgene_coltypes <- cols(anim = col_character(), nobovi = col_character(), nomnais = col_character(), qualifco = col_character(), pere = col_character(), mere = col_character(), dcre = col_character(), danais = col_character(), ifnais = col_integer(), crsevs = col_integer(), dmsevs = col_integer(), dssevs = col_integer(), alaits = col_integer(), isevre = col_integer(), ivmate = col_integer(), iqmqms = col_integer(), iabjbs = col_integer(), avelag = col_integer(), indisu = col_integer(), cdisev = col_number()) ## on remonte vers les fondatrices femelles <- inventaire %>% filter(sexbov == '2') femelles[] <- lapply(femelles, function(x) if(is.logical(x)) as.character(x) else x) old <- Sys.time() t_travail <- femelles t_temp = t_final <- inventaire[0,] line_mere <- inventaire[0,] #line_mere$iqmqms = line_mere$iabjbs <- NA # mise en commentaire : 07/03/2023 # t_travail[] <- lapply(t_travail, function(x) if(is.Date(x)) as.character(x) else x) # t_final[] <- lapply(t_final, function(x) if(is.Date(x)) as.character(x) else x) # t_temp[] <- lapply(t_temp, function(x) if(is.Date(x)) as.character(x) else x) t_travail[] <- lapply(t_travail, function(x) if(is.logical(x)) as.character(x) else x) t_final[] <- lapply(t_final, function(x) if(is.logical(x)) as.character(x) else x) t_temp[] <- lapply(t_temp, function(x) if(is.logical(x)) as.character(x) else x) nbl <- nrow(t_travail) nb_tours <- 0 while (nbl > 0) { for (i in 1:nrow(t_travail)) { if (!is.na(t_travail$mere[i])) { if ((trim_str(t_travail$mere[i]) %in% trim_str(t_final$anim)) | (trim_str(t_travail$mere[i]) %in% trim_str(t_travail$anim)) | (trim_str(t_travail$mere[i]) %in% trim_str(t_temp$anim))) { #print(paste0(as.character(i), "D?ja list?e")) } else { #print(t_travail$mere[i]) line_mere <- chgt_infos(trim_str(t_travail$mere[i])) if (is.data.frame(line_mere)) { if (nrow(line_mere) > 0 ) { # ajout du 07/03/2023 line_mere <- line_mere[, intersect(names(line_mere), names(femelles))] line_mere[] <- lapply(line_mere, function(x) if(is.logical(x)) as.character(x) else x) for ( x in colnames(line_mere) ) { line_mere[,x] <- eval(call( paste0("as.", class(femelles[,x])), line_mere[,x]) ) } if (ncol(line_mere) > 22) { # attribution a line_mere les memes types de col que inventaire # afin de permettre la jointure sans erreur de type # modif : mise en commentaire 07/03/2023 # line_mere$iqmqms = line_mere$iabjbs <- NA # line_mere <- line_mere[, colnames(t_final)] # line_mere[] <- mapply(FUN = as, line_mere, sapply(t_final, class), SIMPLIFY = FALSE) if ( !is.na(line_mere$chna) & trim_str(line_mere$chna) == CHEP) { t_temp <- bind_rows(t_temp, line_mere) } else { #print("N?e ailleurs") t_final <- bind_rows(t_final, line_mere) } } else { #print("Ligne de Hbcgene") # attribution a line_mere les types de col definis plus haut # afin de permettre la jointure sans erreur de type # modif : mise en commentaire 07/03/2023 # line_mere <- type.convert(line_mere, col_types = hbcgene_coltypes) # line_mere$nobovi <- as.character(line_mere$nobovi) #cat(i, class(line_mere$indite), class(t_final$indite)) # pb de types t_final <- bind_rows(t_final, line_mere) } } } else { #print("Retour vide du WS") } } } else { #print("Pas de mere") } } # for t_final <- bind_rows(t_final, t_travail) t_travail <- t_temp t_temp <- t_temp[0,] nbl <- nrow(t_travail) nb_tours <- nb_tours+1 print(paste("Nombre de g?n?rations depuis les animaux actifs : ", nb_tours, sep='')) } # while inv_asc <- t_final fondatrices <- subset(inv_asc, is.na(t_final$mere) | trim_str(t_final$chna) != CHEP | is.na(t_final$chna) | !(trim_str(inv_asc$mere) %in% trim_str(inv_asc$anim)) ) # modif du 27/03/2023 new <- Sys.time()-old cat("Remont?e des lign?es :", round(new, 1) , "sec") # on redescendant vers tous les animaux n?s dans le cheptel issus des fondatrices # on met de c?t? les vaches ayant produits a leur tour dans le cheptel # ainsi que les males ayant produit (peu importe ou) old <- Sys.time() t_travail <- fondatrices t_travail$fondatrice <- t_travail$anim t_temp = t_final <- inventaire[0,] t_final <- t_final %>% add_column(fondatrice = NA, iqmqms = NA, iabjbs = NA) t_temp <- t_temp %>% add_column(fondatrice = NA, iqmqms = NA, iabjbs = NA) t_travail[] <- lapply(t_travail, function(x) if(is.logical(x)) as.character(x) else x) t_final[] <- lapply(t_final, function(x) if(is.logical(x)) as.character(x) else x) t_temp[] <- lapply(t_temp, function(x) if(is.logical(x)) as.character(x) else x) # mise en commentaire : 07/03/2023 # t_travail[] <- lapply(t_travail, function(x) if(is.Date(x)) as.character(x) else x) # t_final[] <- lapply(t_final, function(x) if(is.Date(x)) as.character(x) else x) # t_temp[] <- lapply(t_temp, function(x) if(is.Date(x)) as.character(x) else x) nbl <- nrow(t_travail) nb_tours <- 0 while (nbl > 0) { for (i in 1:nrow(t_travail)) { cat(nbl, i, t_travail$anim[i], t_travail$nobovi[i], '\n') produits <- try(appel_infos(trim_str(t_travail$anim[i]), reqMere)) if (!is.null(produits)) { # MAJ du 07/03/2023 produits <- produits[, intersect(names(produits), names(femelles))] produits[] <- lapply(produits, function(x) if(is.logical(x)) as.character(x) else x) for ( x in colnames(produits) ) { produits[,x] <- eval(call( paste0("as.", class(femelles[,x])), produits[,x]) ) } # modif : mise en commentaire 07/03/2023 # produits$iqmqms = produits$iabjbs = produits$fondatrice <- NA # produits <- produits[,colnames(t_final)] # produits[] <- mapply(FUN = as, produits, sapply(t_final, class), SIMPLIFY = FALSE) # produits[] <- lapply(produits, function(x) if(is.logical(x)) as.character(x) else x) # produits[] <- lapply(produits, function(x) if(is.Date(x)) as.character(x) else x) produits <- subset(produits, trim_str(produits$chna) == CHEP) if (length(produits) > 0 & nrow(produits) > 0){ produits$fondatrice <- t_travail$fondatrice[i] t_final <- bind_rows(t_final, produits) repros <- subset(produits, produits$nbdescendants > 0 & produits$sexbov == '2') if (nrow(repros) > 0) { t_temp <- bind_rows(t_temp, repros) } } } } # for t_final <- bind_rows(t_final, t_travail) t_travail <- t_temp t_temp <- t_temp[0,] nbl <- nrow(t_travail) nb_tours <- nb_tours+1 print(paste("Nombre de g?n?rations apras les fondatrices : ", nb_tours, sep='')) } # while inv_desc <- t_final # doublons ??? inv_desc <- inv_desc[-which(duplicated(inv_desc$anim)),] if (nrow(inv_desc) == 0 ){ inv_desc <- t_final } # modif du 07/03/2023 # pb du nombre de produits non ramenés par WS en appellant la mère # inv_asc_not_in_desc <- inv_asc %>% filter( !(trim_str(anim) %in% trim_str(inv_desc$anim)) ) # if ( nrow(inv_asc_not_in_desc) > 0) { # inv_desc <- bind_rows(inv_desc, inv_asc_not_in_desc) # } new <- Sys.time()-old cat("Remont?e des lign?es :", round(new, 1)) # vaches tot vachestot <- inv_desc %>% filter(sexbov == '2' & nbdescendants > 0) produitstot <- subset(inv_desc, trim_str(inv_desc$mere) %in% trim_str(vachestot$anim)) if (nrow(vachestot) > 0) { # recherche des meres dans les porteuses pour aller chercher # les produitstot s'ils existent dans HBCANIM porteuses <- subset(indite, !is.na(indite$MEREIPG) & indite$MEREIPG %in% trim_str(vachestot$anim)) donneuses <- subset(indite, !is.na(indite$MERECPB) & indite$MERECPB %in% trim_str(vachestot$anim)) # l'indicateur de donneuse d'embryon est renseign? apres dans --> vachestot$ACINAC if ( is.numeric(vachestot$danais[1]) & vachestot$danais[1] > 1*(10**8) ) { vachestot$danais <- as.Date(as.POSIXct(vachestot$danais / 1000, origin="1970-01-01")) vachestot$dasort <- as.Date(as.POSIXct(vachestot$dasort / 1000, origin="1970-01-01")) } for (i in 1:nrow(vachestot)) { if (is.na(vachestot$dasort[i])){ vachestot$age_days[i] <- time_length(interval(vachestot$danais[i], Sys.Date()), unit="days") } else { vachestot$age_days[i] <- time_length(interval(vachestot$danais[i], vachestot$dasort[i]), unit="days") } } vachestot$age_years <- round(vachestot$age_days / 365, 1) # les veaux port?s sont rajout?s aux produitstot si non r?cup?r?s avant ________ non appliqu? car raisonnement sur lign?es # if (nrow(porteuses) > 0) { # for (i in 1:nrow(porteuses)) { # if (!(porteuses$ANIM[i] %in% trim_str(produitstot$anim))) { # # temp <- appel_infos(porteuses$ANIM[i], hbcanim) # a voir : gerer les retours vides !!!! # li_mere <- subset(vachestot, vachestot$anim == porteuses$MEREIPG[i]) # # temp$mere[1] <- porteuses$MEREIPG[i] # temp[1, c(60:67, 86:103)] <- NA # temp$danaismere[1] <- as.character(li_mere$danais[1]) # temp$indite[1] <- 'O_corr' # # produitstot <- rbind(produitstot, temp) # } # } # } # modifs des types de donn?es, pour calcul par la suite if ( is.numeric(produitstot$danais[1]) & produitstot$danais[1] > 1*(10**8) ) { produitstot$danais <- as.Date(as.POSIXct(produitstot$danais / 1000, origin="1970-01-01")) produitstot$dasort <- as.Date(as.POSIXct(produitstot$dasort / 1000, origin="1970-01-01")) produitstot$danaismere <- as.Date(as.POSIXct(produitstot$danaismere / 1000, origin="1970-01-01")) } test_date <- produitstot %>% filter( !is.na(danaismere) ) if (nrow(test_date) > 0){ if ( is.numeric(test_date$danaismere[1]) & test_date$danaismere[1] > 1*(10**8) ) { produitstot$danaismere <- as.Date(as.POSIXct(produitstot$danaismere / 1000, origin="1970-01-01")) } } produitstot$danais <- as.Date(produitstot$danais, format = "%Y-%m-%d") produitstot$dasort <- as.Date(produitstot$dasort, format = "%Y-%m-%d") produitstot$mere <- trim_str(produitstot$mere) produitstot$pere <- trim_str(produitstot$pere) produitstot$anim <- trim_str(produitstot$anim) produitstot$ravelamere <- as.numeric(produitstot$ravelamere) produitstot$ivv <- as.numeric(produitstot$ivv) produitstot$campn <- as.numeric(produitstot$campn) produitstot$nbdescendants <- as.numeric(produitstot$nbdescendants) produitstot$ponais <- as.numeric(produitstot$ponais) produitstot$pat04m <- as.numeric(produitstot$pat04m) produitstot$pat07m <- as.numeric(produitstot$pat07m) produitstot$devsqe <- as.numeric(produitstot$devsqe) produitstot$devmus <- as.numeric(produitstot$devmus) produitstot$aptfon <- as.numeric(produitstot$aptfon) # on ne garde que les TE port?s par une vache active du cheptel PRODTOT <- subset(produitstot, produitstot$indite != 'O') # ajout des produitstot IPG PRODTOT <- merge(PRODTOT, parentsIPG, by.x='anim', by.y='ANIM', all.x=T, all.y=F) PRODTOT <- PRODTOT[order(PRODTOT$danais, decreasing = F),] PRODTOT <- PRODTOT[order(PRODTOT$mere, decreasing = T),] # correction des ravelamere des TE si possible for (i in 1:nrow(PRODTOT)) { if (is.na(PRODTOT$ravelamere[i])) { if (!is.na(PRODTOT$ravelamere[i+1]) & PRODTOT$ravelamere[i+1] %in% c(1, 2)) { PRODTOT$ravelamere[i] <- 1 PRODTOT$typemere[i] <- 'G' } else if (!is.na(PRODTOT$ravelamere[i+1]) & PRODTOT$ravelamere[i+1] > 1) { PRODTOT$ravelamere[i] <- PRODTOT$ravelamere[i+1] - 1 PRODTOT$typemere[i] <- 'V' } } } # age au velage de la mere PRODTOT$agevel <- round(time_length(interval(PRODTOT$danaismere, PRODTOT$danais), unit="months"), 1) # IVV : utilisation de la colonne deja pr?sente de HBCANIM for (i in 1:nrow(PRODTOT)) { if (PRODTOT$indite[i] == 'O_corr') { PRODTOT$nobovi[i] <- paste('#', PRODTOT$nobovi[i], sep='') } # repro if (PRODTOT$anim[i] %in% czhbc$ANIM | (!is.na(PRODTOT$NBPRODIPG[i]) & PRODTOT$NBPRODIPG[i] > 0) | (!is.na(PRODTOT$nbdescendants[i]) & as.numeric(PRODTOT$nbdescendants[i]) > 0)) { PRODTOT$repro[i] <- 'O' } else { PRODTOT$repro[i] <- NA PRODTOT$nobovi[i] <- PRODTOT$nobovi[i] %>% str_to_lower() } # mortalite if (!is.na(PRODTOT$dasort[i]) & !is.na(PRODTOT$casort[i]) & PRODTOT$casort[i] == 'M' & time_length(interval(PRODTOT$danais[i], PRODTOT$dasort[i]), unit="days") < 211){ PRODTOT$mortsev[i] <- 'O' PRODTOT$nobovi[i]=paste(PRODTOT$nobovi[i], ' (MavS)', sep='') } else { PRODTOT$mortsev[i] <- NA } # IVV if (i > 1) { # cas normaux if (!is.na(PRODTOT$ravelamere[i]) & !is.na(PRODTOT$ravelamere[i-1]) & PRODTOT$ravelamere[i] != 1 & PRODTOT$ravelamere[i] == PRODTOT$ravelamere[i-1] + 1 #& !is.na(PRODTOT$cofgmumere[i]) & PRODTOT$cofgmumere[i] != '2' & !is.na(PRODTOT$mere[i]) & PRODTOT$mere[i] == PRODTOT$mere[i-1]) { PRODTOT$ivv[i] <- time_length(interval(PRODTOT$danais[i-1], PRODTOT$danais[i]), unit="days") # jumeaux } else if (!is.na(PRODTOT$ravelamere[i]) & !is.na(PRODTOT$ravelamere[i-1]) & PRODTOT$ravelamere[i] != 1 & PRODTOT$ravelamere[i] == PRODTOT$ravelamere[i-1] & !is.na(PRODTOT$cofgmumere[i]) & PRODTOT$cofgmumere[i] == '2' & !is.na(PRODTOT$mere[i]) & PRODTOT$mere[i] == PRODTOT$mere[i-1]) { PRODTOT$ivv[i] <- PRODTOT$ivv[i-1] # rang de v?lage manquant } else if (!is.na(PRODTOT$ravelamere[i]) & !is.na(PRODTOT$ravelamere[i-1]) & PRODTOT$ravelamere[i] != 1 & !is.na(PRODTOT$cofgmumere[i]) & PRODTOT$cofgmumere[i] != '2' & !is.na(PRODTOT$mere[i]) & PRODTOT$mere[i] == PRODTOT$mere[i-1]) { PRODTOT$ivv[i] <- round(time_length(interval(PRODTOT$danais[i-1], PRODTOT$danais[i]), unit="days") / (PRODTOT$ravelamere[i] - PRODTOT$ravelamere[i-1]), 0) } else { PRODTOT$ivv[i] <- NA } if (!is.na(PRODTOT$ivv[i]) & PRODTOT$ivv[i] < 280) { PRODTOT$ivv[i] <- NA } } } # calcul des effets du cheptel : rang de velage et sexe du veau effet <- PRODTOT %>% group_by(typemere, sexbov) %>% summarise(m_PN = round(mean(ponais, na.rm=T), 1), m_p120 = round(mean(pat04m, na.rm=T), 1), m_p210 = round(mean(pat07m, na.rm=T), 1)) effet$diff_pn <- effet$m_PN - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_PN[1] effet$diff_p120 <- effet$m_p120 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p120[1] effet$diff_p210 <- effet$m_p210 - subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$m_p210[1] # calcul des effets du cheptel : sexe sur la repro effetsexe <- PRODTOT %>% filter(NBPRODIPG > 0) %>% group_by(sexbov) %>% summarise(nbpp = round(mean(NBPRODIPG, na.rm=T), 1), nbpp_med = round(median(NBPRODIPG, na.rm=T), 1) ) rapport_MF <- round(subset(effetsexe, effetsexe$sexbov == '1')$nbpp_med[1] / subset(effetsexe, effetsexe$sexbov == '2')$nbpp_med[1], 0) # report des effets sur les produitstot for (i in 1:nrow(PRODTOT)) { if (PRODTOT$sexbov[i] == '2') { #___________________________________ FEMELLES PRODTOT$nbpp_corr[i] <- PRODTOT$NBPRODIPG[i] * rapport_MF if (!is.na(PRODTOT$typemere[i]) & PRODTOT$typemere[i] == 'G') { #___genisses if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'G')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } else { #________________________________________________ vachestot ou inconnu if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '2' & effet$typemere == 'V')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } } else { #______________________________________________________________ MALES PRODTOT$nbpp_corr[i] <- PRODTOT$NBPRODIPG[i] if ( !is.na(PRODTOT$typemere[i]) & PRODTOT$typemere[i] == 'G') { #_________________________________genisses if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'G')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } else { #_____________________________________________ vachestot ou inconnu if (!is.na(PRODTOT$ponais[i])) { PRODTOT$pn_corr[i] <- (PRODTOT$ponais[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_pn[1]) } else { PRODTOT$pn_corr[i] <- NA } if (!is.na(PRODTOT$pat04m[i])) { PRODTOT$p120_corr[i] <- (PRODTOT$pat04m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p120[1]) } else { PRODTOT$p120_corr[i] <- NA } if (!is.na(PRODTOT$pat07m[i])) { PRODTOT$p210_corr[i] <- (PRODTOT$pat07m[i] + subset(effet, effet$sexbov == '1' & effet$typemere == 'V')$diff_p210[1]) } else { PRODTOT$p210_corr[i] <- NA } } } } # calcul des donn?es ?labor?es par vache active for (i in 1:nrow(vachestot)) { # ___________________________________________rappel des produitstot par vache veaux <- PRODTOT %>% filter(mere == trim_str(vachestot$anim[i])) # ___________________________________________calcul des infos utiles par vache # calcul du poids adulte estim? et synthese pointage vache ___________________ if (!is.na(vachestot$dmC[i])) { vachestot$ptgV[i] <- round(0.6 * vachestot$dmC[i] + 0.15 * vachestot$ds[i] + 0.25 * vachestot$af[i], 1) } else { vachestot$ptgV[i] <- NA } if (nrow(veaux) > 3){ vachestot$precocite[i] <- round(mean((veaux$devsqe - veaux$devmus), na.rm=TRUE), 2) alpha <- 1.62 - 0.01 * vachestot$precocite[i] } else { vachestot$precocite[i] <- NA alpha <- 1.62 } if (!is.na(vachestot$pat24m[i])) { vachestot$pad[i] <- round((as.numeric(vachestot$pat24m[i]) - 50 * exp(-720 * alpha * 10**(-3))) / (1 - exp(-720 * alpha * 10**(-3))), 1) } else if (!is.na(vachestot$pat18m[i])) { vachestot$pad[i] <- round((as.numeric(vachestot$pat18m[i]) - 50 * exp(-540 * alpha * 10**(-3))) / (1 - exp(-540 * alpha * 10**(-3))), 1) } else if (!is.na(vachestot$pat12m[i])) { vachestot$pad[i] <- round((as.numeric(vachestot$pat12m[i]) - 50 * exp(-360 * alpha * 10**(-3))) / (1-exp(-360 * alpha * 10**(-3))), 1) } else { vachestot$pad[i] <- NA } # calcul des perfs de repro et du temps productif ____________________________ vachestot$nbcampvel[i] <- (max(veaux$campn) - min(veaux$campn) + 1) if (1 %in% veaux$ravelamere) { vachestot$agevel1[i] <- subset(veaux, veaux$ravelamere == 1)$agevel[1] } else { vachestot$agevel1[i] <- NA } if (2 %in% veaux$ravelamere) { vachestot$ivv1[i] <- subset(veaux, veaux$ravelamere == 2)$ivv[1] } else { vachestot$ivv1[i] <- NA } if (3 %in% veaux$ravelamere) { vachestot$ivv2p[i] <- round(mean(subset(veaux, veaux$ravelamere > 2)$ivv, na.rm=T), 1) } if (is.na(vachestot$ivv1[i]) | (!is.na(vachestot$ivv1[i]) & vachestot$ivv1[i] < 390) ){ e2 <- 0 } else if (!is.na(vachestot$ivv1[i]) & vachestot$ivv1[i] >= 390) { e2 <- vachestot$ivv1[i] - 390 } if (is.na(vachestot$ivv2p[i]) | (!is.na(vachestot$ivv2p[i]) & vachestot$ivv2p[i] < 365) ){ e3 <- 0 } else if (!is.na(vachestot$ivv2p[i]) & vachestot$ivv2p[i] >= 365) { e3 <- vachestot$ivv1[i] - 365 } if (is.na(vachestot$dasort[i])) { if (time_length(interval(max(veaux$danais, na.rm=T), Sys.Date()), unit="days") < 365) { e4 <- 0 } else { e4 <- time_length(interval(max(veaux$danais, na.rm=T), Sys.Date()), unit="days") - 365 } } else if (!is.na(vachestot$dasort[i])) { if (time_length(interval(max(veaux$danais, na.rm=T), vachestot$dasort[i]), unit="days") < 365) { e4 <- 0 } else { e4 <- time_length(interval(max(veaux$danais, na.rm=T), vachestot$dasort[i]), unit="days") - 365 } } vachestot$tempsprod[i] <- round( (vachestot$age_days[i] - ( vachestot$agevel1[i] * 30.4 + e2 + e3 * (vachestot$nbcampvel[i] - 2) + e4 )) / vachestot$age_days[i] * 100, 1) # calcul des donn?es synthetiques sur les produitstot ___________________________ vachestot$prol[i] <- round(nrow(veaux) / (vachestot$nbcampvel[i]) * 100, 1) vachestot$mort[i] <- round(nrow(subset(veaux, veaux$mortsev == 'O')) / nrow(veaux)* 100, 1) vachestot$txrepros[i] <- round(nrow(subset(veaux, veaux$repro == 'O')) / nrow(veaux)* 100, 1) vachestot$nbpp[i] <- sum(veaux$NBPRODIPG, na.rm=T) vachestot$nbpp_corr[i] <- sum(veaux$nbpp_corr, na.rm=T) vachestot$txmales[i] <- round(nrow(subset(veaux, veaux$sexbov == '1')) / nrow(veaux)* 100, 1) vachestot$txvf[i] <- round(nrow(subset(veaux, veaux$conais %in% c('1','2') )) / nrow(veaux)* 100, 1) vachestot$ptgP[i] <- round(0.75 * mean(veaux$devmus, na.rm=TRUE) + 0.25 * mean(veaux$devsqe, na.rm=TRUE), 1) vachestot$pn_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$ponais, na.rm=T), 1) vachestot$p120_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$pat04m, na.rm=T), 1) vachestot$p210_m[i] <- round(mean(subset(veaux, veaux$sexbov == '1')$pat07m, na.rm=T), 1) vachestot$pn_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$ponais, na.rm=T), 1) vachestot$p120_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$pat04m, na.rm=T), 1) vachestot$p210_f[i] <- round(mean(subset(veaux, veaux$sexbov == '2')$pat07m, na.rm=T), 1) vachestot$pn_corr[i] <- round(mean(veaux$pn_corr, na.rm=T), 1) vachestot$p120_corr[i] <- round(mean(veaux$p120_corr, na.rm=T), 1) vachestot$p210_corr[i] <- round(mean(veaux$p210_corr, na.rm=T), 1) ### convertion des NaN en NA L <- c('ptgP','pn_m','pn_f','pn_corr','p120_m','p120_f','p120_corr', 'p210_m','p210_f','p210_corr') for (j in L){ if (is.nan(vachestot[i,j]) == TRUE){ vachestot[i,j] <- NA } } } } # calcul des stats par fondatrice ______________________________________________ stats_lignees <- PRODTOT %>% group_by(fondatrice) %>% summarise(nb_desc_in_chep = n()) %>% filter(nb_desc_in_chep >=5) stats_lignees <- stats_lignees %>% add_column(utilgen = NA, prol = NA, mort = NA, txrepros = NA, nbpp = NA, txvf = NA, pnm = NA, pnf = NA, p120m = NA, p120f = NA, p210m = NA, p210f = NA, dmsev = NA, dssev = NA, nbfem_avecprod = NA, pctfem_avecprod = NA, isu_femtot = NA, age_sort_femtot = NA, agevel1_femtot = NA, ivv1_femtot = NA, ivv2p_femtot = NA, vieprod_femtot = NA, dmad_femtot = NA, dsad_femtot = NA, afad_femtot = NA, nbprod_femtot = NA, txrepros_femtot = NA, nbpp_femtot = NA, prol_femtot = NA, mort_femtot = NA, txvf_femtot = NA, nbfemact_avecprod = NA, pctfemact_avecprod = NA, isu_femact = NA, age_sort_femact = NA, agevel1_femact = NA, ivv1_femact = NA, ivv2p_femact = NA, vieprod_femact = NA, dmad_femact = NA, dsad_femact = NA, afad_femact = NA, nbprod_femact = NA, txrepros_femact = NA, nbpp_femact = NA, prol_femact = NA, mort_femact = NA, txvf_femact = NA, nbfem_renouv = NA) for (i in 1:nrow(stats_lignees)) { # stats sur la prod directe __________________________________________________ li_prod <- subset(PRODTOT, PRODTOT$fondatrice == stats_lignees$fondatrice[i]) stats_lignees$utilgen[i] <- round(nrow(subset(li_prod, li_prod$ravelamere == 1)) / nrow(li_prod) * 100, 1) stats_lignees$prol[i] <- round(nrow(li_prod) / nrow(li_prod %>% distinct(danais, mere)) * 100, 1) stats_lignees$mort[i] <- round(nrow(subset(li_prod, li_prod$mortsev == 'O')) / nrow(li_prod) * 100, 1) stats_lignees$txrepros[i] <- round(nrow(subset(li_prod, li_prod$repro == 'O')) / nrow(subset(li_prod, is.na(li_prod$mortsev))) * 100, 1) stats_lignees$nbpp[i] <- sum(li_prod$nbdescendants) stats_lignees$txvf[i] <- round(nrow(subset(li_prod, li_prod$conais %in% c('1','2'))) / nrow(li_prod) * 100, 1) stats_lignees$pnm[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$ponais, na.rm=T),1) stats_lignees$pnf[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$ponais, na.rm=T),1) stats_lignees$p120m[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$pat04m, na.rm=T),1) stats_lignees$p120f[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$pat04m, na.rm=T),1) stats_lignees$p210m[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$pat07m, na.rm=T),1) stats_lignees$p210f[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$pat07m, na.rm=T),1) stats_lignees$dmsev[i] <- round(mean(subset(li_prod, li_prod$sexbov == '1')$devmus, na.rm=T),1) stats_lignees$dssev[i] <- round(mean(subset(li_prod, li_prod$sexbov == '2')$devsqe, na.rm=T),1) # stats sur la prod par les fem ___________________________________________ li_fem <- subset(vachestot, vachestot$fondatrice == stats_lignees$fondatrice[i]) # modif du 30/04/2024 if (nrow(li_fem) > 0) { stats_lignees$nbfem_avecprod[i] <- nrow(li_fem) stats_lignees$pctfem_avecprod[i] <- round(nrow(li_fem) / nrow(subset(li_prod, li_prod$sexbov == '2')) * 100, 1) } if (nrow(li_fem) >= 3) { stats_lignees$isu_femtot[i] <- round(mean(li_fem$indisu, na.rm=T),1) stats_lignees$age_sort_femtot[i] <- round(mean(li_fem$age_years, na.rm=T),1) stats_lignees$agevel1_femtot[i] <- round(mean(li_fem$agevel1, na.rm=T),1) stats_lignees$vieprod_femtot[i] <- round(mean(li_fem$tempsprod, na.rm=T),1) stats_lignees$ivv1_femtot[i] <- round(mean(li_fem$ivv1, na.rm=T),1) stats_lignees$ivv2p_femtot[i] <- round(mean(as.numeric(li_fem$ivv2p), na.rm=T),1) stats_lignees$dmad_femtot[i] <- round(mean(li_fem$dmC, na.rm=T),1) stats_lignees$dsad_femtot[i] <- round(mean(li_fem$ds, na.rm=T),1) stats_lignees$afad_femtot[i] <- round(mean(li_fem$af, na.rm=T),1) stats_lignees$prol_femtot[i] <- round(mean(li_fem$prol, na.rm=T),1) stats_lignees$mort_femtot[i] <- round(mean(li_fem$mort, na.rm=T),1) stats_lignees$txvf_femtot[i] <- round(mean(li_fem$txvf, na.rm=T),1) stats_lignees$nbprod_femtot[i] <- round(sum(li_fem$nbdescendants),1) stats_lignees$txrepros_femtot[i] <- round(mean(li_fem$txrepros, na.rm=T),1) stats_lignees$nbpp_femtot[i] <- round(sum(li_fem$nbpp),1) } # stats sur la prod par les fem actives ___________________________________ li_fem_act <- subset(vachestot, vachestot$fondatrice == stats_lignees$fondatrice[i] & is.na(vachestot$dasort)) # modif du 30/04/2024 if (nrow(li_fem_act) > 0) { stats_lignees$nbfemact_avecprod[i] <- nrow(li_fem_act) stats_lignees$pctfemact_avecprod[i] <- round(nrow(li_fem_act) / nrow(subset(li_prod, li_prod$sexbov == '2')) * 100, 1) } if (nrow(li_fem_act) >= 3) { stats_lignees$isu_femact[i] <- round(mean(li_fem_act$indisu, na.rm=T),1) stats_lignees$age_sort_femact[i] <- round(mean(li_fem_act$age_years, na.rm=T),1) stats_lignees$agevel1_femact[i] <- round(mean(li_fem_act$agevel1, na.rm=T),1) stats_lignees$vieprod_femact[i] <- round(mean(li_fem_act$tempsprod, na.rm=T),1) stats_lignees$ivv1_femact[i] <- round(mean(li_fem_act$ivv1, na.rm=T),1) stats_lignees$ivv2p_femact[i] <- round(mean(as.numeric(li_fem_act$ivv2p), na.rm=T),1) stats_lignees$dmad_femact[i] <- round(mean(li_fem_act$dmC, na.rm=T),1) stats_lignees$dsad_femact[i] <- round(mean(li_fem_act$ds, na.rm=T),1) stats_lignees$afad_femact[i] <- round(mean(li_fem_act$af, na.rm=T),1) stats_lignees$prol_femact[i] <- round(mean(li_fem_act$prol, na.rm=T),1) stats_lignees$mort_femact[i] <- round(mean(li_fem_act$mort, na.rm=T),1) stats_lignees$txvf_femact[i] <- round(mean(li_fem_act$txvf, na.rm=T),1) stats_lignees$nbprod_femact[i] <- round(sum(li_fem_act$nbdescendants),1) stats_lignees$txrepros_femact[i] <- round(mean(li_fem_act$txrepros, na.rm=T),1) stats_lignees$nbpp_femact[i] <- round(sum(li_fem_act$nbpp),1) } # filles a venir nbfr <- nrow(subset(inv_desc, inv_desc$fondatrice == stats_lignees$fondatrice[i] & inv_desc$nbdescendants == 0 & inv_desc$sexbov == '2' & inv_desc$actif == '1')) if (nbfr > 0) { stats_lignees$nbfem_renouv[i] <- nbfr } } fondatrices$anim <- trim_str(fondatrices$anim) stats_lignees$fondatrice <- trim_str(stats_lignees$fondatrice) stats_lignees <- merge(fondatrices[,c('anim', 'nobovi', 'danais', 'nomnais')], stats_lignees, by.x='anim', by.y='fondatrice', all.x=F, all.y=T) write.table(stats_lignees, file = paste(rep, '/', CHEP, '_ResLigneesF_eCow5.csv', sep = ""), quote = FALSE, dec = ",", row.names = FALSE, col.names = TRUE, sep = ";", qmethod = c("escape"), na = "") ################################################################################ ### trac? des lign?es sur PDF __________________________________________________ ################################################################################ # modif 27/03/2023 : # déduction campagne en cours pour garder les femelles de renouvellement # sans les laitonnes de la campagne en cours camp_actuelle = ifelse(month(Sys.Date()) %in% c('08','09','10','11','12'), year(Sys.Date()) + 1, year(Sys.Date())) fem_tot <- inv_desc %>% filter(sexbov == '2' & campn < camp_actuelle & (nbdescendants > 0 | actif == '1')) # modif 27/03/2023 : # modif de la valeur "actif" pour mettre en rouge les vaches actives ailleurs fem_tot$actif <- ifelse(fem_tot$actif == '1' & trim_str(fem_tot$chepdet) == CHEP, '1', '0') fem_tot$anim <- trim_str(fem_tot$anim) fem_tot$mere <- trim_str(fem_tot$mere) fem_tot$pere <- trim_str(fem_tot$pere) for (i in 1:nrow(fem_tot)) { if (fem_tot$indite[i] == 'O') { fem_tot$nobovi[i] <- paste(fem_tot$nobovi[i], ' (TE)', sep='') } if (fem_tot$nbdescendants[i] == 0) { fem_tot$nobovi[i] <- fem_tot$nobovi[i] %>% tolower() } if (fem_tot$corabo[i] == '38'){ fem_tot$corabo[i] <- 'CHAROLAISE' } else { fem_tot$corabo[i] <- 'CROISEE' } if (fem_tot$sexbov[i] == '2') { fem_tot$sexbov[i] <- 'female' } else if (fem_tot$sexbov[i] == '1'){ fem_tot$sexbov[i] <- 'male'} if (is.na(fem_tot$nobovi[i])){ fem_tot$nobovi[i] <- paste(str_sub(fem_tot$anim[i], -4), subset(LETTRES, LETTRES$ANNEE == fem_tot$campn[i])[1,'LETTRE'], sep='_') } } cla_rg <- tabfinal[,c('NUM_VACHE', 'rang CARRIERE')] nbvcla <- nrow(subset(cla_rg, !is.na(cla_rg$`rang CARRIERE`))) for(i in 1:nrow(cla_rg)) { if (!is.na(cla_rg$`rang CARRIERE`[i])){ cla_rg$`rang CARRIERE`[i] <- paste('eCow : ', cla_rg$`rang CARRIERE`[i], ' / ', nbvcla, sep='') } else { cla_rg$`rang CARRIERE`[i] <- 'eCow : NC' } } sub_ped <- fem_tot[,c('anim', 'pere', 'mere', 'sexbov', 'corabo', 'campn', 'actif', 'nobovi')] sub_ped <- merge(sub_ped, cla_rg, by.x='anim', by.y='NUM_VACHE', all.x=T, all.y=T) colnames(sub_ped)=c('Indiv','Sire','Dam','Sex','Breed','Born','Affected','Nom','ecowcarr') Pedig <- prePed(sub_ped) for(i in 1:nrow(Pedig)) { if (is.na(Pedig$ecowcarr[i])){ Pedig$ecowcarr[i] <- '' } if (!is.na(Pedig$Sex[i]) & Pedig$Sex[i] == 'male'){ toro <- subset(inv_desc, trim_str(inv_desc$pere) == Pedig$Indiv[i]) Pedig$Nom[i] <- toro$nompere[1] } if (!is.na(Pedig$Sex[i]) & Pedig$Sex[i] == 'female' & is.na(Pedig$Nom[i]) ){ mom <- subset(inv_desc, trim_str(inv_desc$mere) == Pedig$Indiv[i]) Pedig$Nom[i] <- mom$nommere[1] } } img=readPNG("C:/Users/LJeannot/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/eCow5/IMPORTS_R/HBC-Logo.png") dir.create(path=paste(rep, "/", CHEP, '_pdf_ligneesF', sep='')) sousrep=paste(rep, "/" ,CHEP, '_pdf_ligneesF', sep='') fondatrices$anim <- trim_str(fondatrices$anim) fondatrices <- subset(fondatrices, (fondatrices$nbdescendants > 0 | is.na(fondatrices$nbdescendants)) & fondatrices$anim %in% trim_str(fem_tot$fondatrice)) if (nrow(fondatrices) > 0) { for (i in 1:nrow(fondatrices)) { print(fondatrices$anim[i]) sPed <- subPed(Pedig, keep=fondatrices$anim[i], prevGen=0, succGen=10) taille <- nrow(sPed) print(taille) nbt <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv)) nb <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv & vaches$rg_carr <= (nbvcla / 2))) tx <- round(nb / nbt * 100, 1) tx2 <- round(nbt / nrow(vaches) * 100, 1) if (taille <= 20) {ecr <- 0.5} else if (taille > 20 & taille <= 50) {ecr <- 0.4} else if (taille > 50 & taille <= 100){ecr <- 0.3} else if (taille > 100 & taille <= 150){ecr <- 0.2} else {ecr <- 0.1} for (j in 1:nrow(sPed)) { #sPed$Indiv[j]=str_sub(sPed$Indiv[j],-4) #sPed$Sire[j]=str_sub(sPed$Sire[j],-4) #sPed$Dam[j]=str_sub(sPed$Dam[j],-4) sPed$Nom[j] <- paste(str_sub(sPed$Indiv[j], -4), sPed$Nom[j], sep='\n') } tryCatch( expr = { if (nrow(sPed) > 1 & nbt > 0) { nom <- paste(fondatrices$anim[i], '_', fondatrices$nobovi[i], '.pdf', sep='') pdf(file = paste(sousrep, "/", nom, sep=""), width = 29.5, height = 21, pointsize = 50) pedplot(sPed, label=c('Nom','ecowcarr'), # nom des champs a afficher sous les figures symbolsize=0.6, pos=1, # 1 --> centr? mais un peu superpos?, 4 --> pas superpos? mais align? a droite cex=ecr, # taille d'?criture branch=0.8, # lignes verticales adoucies srt=-90, # angle d'orientation du texte mar=c(2, 2, 2, 5), # marges lwd=5, # epaisseur des traits --> ne marche pas col=ifelse(sPed$Sex == 'male', "blue", ifelse(sPed$Affected == '1', "orange", "red"))) corners <- par("usr") par(xpd=TRUE) text(x=corners[2] + corners[2] / 8, y=corners[4], adj=0, paste(paste(CHEP, vaches$nomdete[1], sep=' - '), paste('Lignee :', fondatrices$nobovi[i], fondatrices$anim[i], sep=' '), sep='\n'), srt=270, cex=0.8, col='dark red', font=2) text(x=corners[2] + corners[2] / 8, y=corners[3], adj=1, c('LEGENDE :\nBLEU : males\nJAUNE : vaches actives\nROUGE : vaches non actives'), srt=270, cex=0.3) text(x=corners[2] + corners[2] / 15, y=mean(corners[3:4]), adj=0.5, paste('Les vaches actives de cette lignee representent ',tx2,"% des vaches en production du cheptel.",sep=''), srt=270, cex=0.5, col='dark green') text(x=corners[2] + corners[2] / 20, y=mean(corners[3:4]), adj=0.5, paste('Synthese eCow : ',tx,"% des vaches actives de cette lignee appartiennent a la moitie superieure classee du cheptel.",sep=''), srt=270, cex=0.5, col='dark green', font=2) grid.raster(img, x=0.05, y=0.1, width=0.05) dev.off() } if (taille >= 80){ z <- subset(fem_tot, fem_tot$mere == fondatrices$anim[i]) if (nrow(z) > 1){ for (k in 1:nrow(z)){ sPed <- subPed(Pedig, keep=z$anim[k], prevGen=0, succGen=10) taille <- nrow(sPed) nbt <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv)) nb <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv & vaches$rg_carr <= (nbvcla / 2))) tx <- round(nb / nbt * 100,1) tx2 <- round(nbt / nrow(vaches) * 100, 1) if (taille <= 20) {ecr <- 0.5} else if (taille > 20 & taille <= 50) {ecr <- 0.4} else if (taille > 50 & taille <= 100){ecr <- 0.3} else if (taille > 100 & taille <= 150){ecr <- 0.2} else {ecr <- 0.1} for (j in 1:nrow(sPed)){ #sPed$Indiv[j]=str_sub(sPed$Indiv[j],-4) #sPed$Sire[j]=str_sub(sPed$Sire[j],-4) #sPed$Dam[j]=str_sub(sPed$Dam[j],-4) sPed$Nom[j] <- paste(str_sub(sPed$Indiv[j], -4), sPed$Nom[j], sep='\n') } if (nrow(sPed) > 1 & nbt > 0){ nom <- paste(fondatrices$anim[i], '_', fondatrices$nobovi[i], '_sl_', z$anim[k], '.pdf', sep='') pdf(file = paste(sousrep, "/", nom, sep=""), width = 29.5, height = 21, pointsize = 50) pedplot(sPed, label=c('Nom','ecowcarr'), # nom des champs a afficher sous les figures symbolsize=0.6, pos=1, # 1 --> centr? mais un peu superpos?, 4 --> pas superpos? mais align? a droite cex=ecr, # taille d'?criture branch=0.8, # lignes verticales adoucies srt=-90, # angle d'orientation du texte mar=c(2,2,2,5), # marges lwd=5, # epaisseur des traits --> ne marche pas col=ifelse(sPed$Sex == 'male', "blue", ifelse(sPed$Affected == 1, "orange", "red"))) corners <- par("usr") par(xpd=TRUE) text(x=corners[2] + corners[2] / 8, y=corners[4], adj=0, paste(paste(CHEP, vaches$nomdete[1], sep=' - '), paste('Lignee :', fondatrices$nobovi[i], fondatrices$anim[i], sep=' '), sep='\n'), srt=270, cex=0.8, col='dark red', font=2) text(x=corners[2] + corners[2] / 12, y=corners[4], adj=0, paste('Sous-lignee : fille', z$nobovi[k], str_sub(z$anim[k], -4), sep=' '), srt=270, cex=0.6, col='dark red', font=1) text(x=corners[2] + corners[2] / 8, y=corners[3], adj=1, c('LEGENDE :\nBLEU : males\nJAUNE : vaches actives\nROUGE : vaches non actives'), srt=270, cex=0.3) text(x=corners[2] + corners[2] / 16, y=mean(corners[3:4]), adj=0.5, paste('Les vaches actives de cette sous-lignee representent ', tx2, "% des vaches en production du cheptel.", sep=''), srt=270, cex=0.5, col='dark green') text(x=corners[2] + corners[2] / 22, y=mean(corners[3:4]), adj=0.5, paste('Synthese eCow : ', tx, "% des vaches actives de cette sous-lignee appartiennent a la moitie superieure classee du cheptel.", sep=''), srt=270, cex=0.5, col='dark green', font=2) grid.raster(img, x=0.05, y=0.1, width=0.05) dev.off() if (taille >= 80){ a <- subset(fem_tot, fem_tot$mere == z$anim[k]) if (nrow(a) > 1){ for (n in 1:nrow(a)){ sPed <- subPed(Pedig, keep=a$anim[n], prevGen=0, succGen=10) taille <- nrow(sPed) nbt <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv)) nb <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv & vaches$rg_carr <= (nbvcla / 2))) tx <- round(nb / nbt * 100, 1) tx2 <- round(nbt / nrow(vaches) * 100, 1) if (taille <= 20) {ecr <- 0.5} else if (taille > 20 & taille <= 50) {ecr <- 0.4} else if (taille > 50 & taille <= 100){ecr <- 0.3} else if (taille > 100 & taille <= 150){ecr <- 0.2} else {ecr <- 0.1} for (j in 1:nrow(sPed)){ #sPed$Indiv[j]=str_sub(sPed$Indiv[j],-4) #sPed$Sire[j]=str_sub(sPed$Sire[j],-4) #sPed$Dam[j]=str_sub(sPed$Dam[j],-4) sPed$Nom[j] <- paste(str_sub(sPed$Indiv[j],-4), sPed$Nom[j], sep='\n') } if (nrow(sPed) > 1 & nbt > 0){ nom <- paste(fondatrices$anim[i], '_', fondatrices$nobovi[i], '_ssl_', z$anim[k], '_', a$anim[n], '.pdf',sep='') pdf(file = paste(sousrep,"/",nom,sep=""), width = 29.5, height = 21, pointsize = 50) pedplot(sPed, label=c('Nom','ecowcarr'), # nom des champs a afficher sous les figures symbolsize=0.6, pos=1, # 1 --> centr? mais un peu superpos?, 4 --> pas superpos? mais align? ? droite cex=ecr, # taille d'?criture branch=0.8, # lignes verticales adoucies srt=-90, # angle d'orientation du texte mar=c(2,2,2,5), # marges lwd=5, # epaisseur des traits --> ne marche pas col=ifelse(sPed$Sex == 'male', "blue", ifelse(sPed$Affected == 1, "orange", "red"))) corners <- par("usr") par(xpd=TRUE) text(x=corners[2] + corners[2] / 8, y=corners[4], adj=0, paste(paste(CHEP, vaches$nomdete[1], sep=' - '), paste('Lignee :', fondatrices$nobovi[i], fondatrices$anim[i], sep=' '), sep='\n'), srt=270, cex=0.8, col='dark red', font=2) text(x=corners[2] + corners[2] / 12, y=corners[4], adj=0, paste('Sous-lignee : petite-fille',a$nobovi[n], str_sub(a$anim[n],-4),sep=' '), srt=270, cex=0.6, col='dark red', font=1) text(x=corners[2] + corners[2] / 8, y=corners[3], adj=1, c('LEGENDE :\nBLEU : males\nJAUNE : vaches actives\nROUGE : vaches non actives'), srt=270, cex=0.3) text(x=corners[2] + corners[2] / 16, y=mean(corners[3:4]), adj=0.5, paste('Les vaches actives de cette sous-lignee representent ', tx2, "% des vaches en production du cheptel.", sep=''), srt=270, cex=0.5, col='dark green') text(x=corners[2] + corners[2] / 22, y=mean(corners[3:4]), adj=0.5, paste('Synthese eCow : ', tx, "% des vaches actives de cette sous-lignee appartiennent a la moitie superieure classee du cheptel.", sep=''), srt=270, cex=0.5, col='dark green', font=2) grid.raster(img, x=0.05, y=0.1, width=0.05) dev.off() } } } } } } } else { w <- subset(fem_tot, fem_tot$mere == z$anim[1]) if (nrow(w) > 1){ for (m in 1:nrow(w)){ sPed <- subPed(Pedig, keep=w$anim[m], prevGen=0, succGen=10) taille <- nrow(sPed) nbt <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv)) nb <- nrow(subset(vaches, vaches$anim %in% sPed$Indiv & vaches$rg_carr <= (nbvcla / 2))) tx <- round(nb / nbt * 100, 1) tx2 <- round(nbt / nrow(vaches) * 100, 1) if (taille <= 20) {ecr <- 0.5} else if (taille > 20 & taille <= 50) {ecr <- 0.4} else if (taille > 50 & taille <= 100){ecr <- 0.3} else if (taille > 100 & taille <= 150){ecr <- 0.2} else {ecr <- 0.1} for (j in 1:nrow(sPed)){ #sPed$Indiv[j]=str_sub(sPed$Indiv[j],-4) #sPed$Sire[j]=str_sub(sPed$Sire[j],-4) #sPed$Dam[j]=str_sub(sPed$Dam[j],-4) sPed$Nom[j] <- paste(str_sub(sPed$Indiv[j], -4), sPed$Nom[j], sep='\n') } if (nrow(sPed) > 1 & nbt > 0){ nom <- paste(fondatrices$anim[i], '_', fondatrices$nobovi[i], '_ssl_', w$anim[m], '.pdf', sep='') pdf(file = paste(sousrep, "/", nom, sep=""), width = 29.5, height = 21, pointsize = 50) pedplot(sPed, label=c('Nom','ecowcarr'), # nom des champs a afficher sous les figures symbolsize=0.6, pos=1, # 1 --> centr? mais un peu superpos?, 4 --> pas superpos? mais align? ? droite cex=ecr, # taille d'?criture branch=0.8, # lignes verticales adoucies srt=-90, # angle d'orientation du texte mar=c(2,2,2,5), # marges lwd=5, # epaisseur des traits --> ne marche pas col=ifelse(sPed$Sex == 'male', "blue", ifelse(sPed$Affected == 1, "orange", "red"))) corners <- par("usr") par(xpd=TRUE) text(x=corners[2] + corners[2] / 8, y=corners[4], adj=0, paste(paste(CHEP, vaches$nomdete[1], sep=' - '), paste('Lign?e :', fondatrices$nobovi[i], fondatrices$anim[i], sep=' '), sep='\n'), srt=270, cex=0.8, col='dark red', font=2) text(x=corners[2] + corners[2] / 12, y=corners[4], adj=0, paste('Sous-lignee : petite-fille', w$nobovi[m], str_sub(w$anim[m], -4), sep=' '), srt=270, cex=0.6, col='dark red', font=1) text(x=corners[2] + corners[2] / 8, y=corners[3], adj=1, c('LEGENDE :\nBLEU : males\nJAUNE : vaches actives\nROUGE : vaches non actives'), srt=270, cex=0.3) text(x=corners[2] + corners[2] / 16, y=mean(corners[3:4]), adj=0.5, paste('Les vaches actives de cette sous-lignee representent ', tx2, "% des vaches en production du cheptel.", sep=''), srt=270, cex=0.5, col='dark green') text(x=corners[2] + corners[2] / 22, y=mean(corners[3:4]), adj=0.5, paste('Synthese eCow : ', tx, "% des vaches actives de cette sous-lignee appartiennent a la moitie superieure classee du cheptel.", sep=''), srt=270, cex=0.5, col='dark green', font=2) grid.raster(img, x=0.05, y=0.1, width=0.05) dev.off() } } } } } }, error = function(erreur) { print("Erreur") } ) } } contenu <- as.data.frame(list.files(paste0(rep, "/", CHEP, '_pdf_ligneesF'))) if (nrow(contenu) > 0) { staple_pdf(input_directory = sousrep, input_files = NULL, output_filepath = paste(rep, '/', CHEP, "_ArbreLigneesF_eCow5.pdf", sep=''), overwrite = TRUE) rotate_pdf(page_rotation = 270, input_filepath = paste(rep, '/', CHEP, "_ArbreLigneesF_eCow5.pdf", sep=''), output_filepath = paste(rep, '/', CHEP, "_ArbreLigneesF_eCow5.pdf", sep=''), overwrite = TRUE) } unlink(paste(rep, '/', CHEP, '_pdf_ligneesF', sep=''), recursive=TRUE) new=Sys.time()-old print(paste('Trac? des lign?es femelles :',new,sep='')) ### g?n?ration du rapport HTML ################################################ # a revoir pour les petits cheptels render_report(CHEP, TECH, date_imp) render_synthese(CHEP, TECH, date_imp) # temps total NEW <- Sys.time() - OLD print(paste("Temps total d'execution :", NEW, sep='')) } else { print("inventaire vide") } } ################################################################################ ### saisie des cheptels ? sortir ############################################### ################################################################################ # CHEP <- 'FR63119077' # avec le FR # TECH <- 'GADES' # # render_all_fic(CHEP, TECH) # # # render_report(CHEP, TECH, date_imp) # render_synthese(CHEP, TECH, date_imp) ################################################################################ ### requete sur les cheptels ? rechercher pr?vus en tourn?e #################### ################################################################################ # dept_tech <- read_delim("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/eCow5/IMPORTS_R/dept_tech.csv", # ";", escape_double = FALSE, locale = locale(encoding = "ISO-8859-1"), # trim_ws = TRUE) # # # itic <- "https://dga.jouy.inra.fr/HbcWebServices/webresources/hbcitic/finddatefieldbynamedquery/Hbcitic.findByPrevejo/" # date_req <- Sys.Date() # li_dates <- seq(as.Date(Sys.Date()), as.Date(Sys.Date()+21), by="days") # # itineraires <- fromJSON(paste(itic, "2021-06-11", sep=''))[0,] # # for (i in 1:length(li_dates)){ # it <- fromJSON(paste(itic, li_dates[i], sep='')) # itineraires <- bind_rows(itineraires, it) # } # # li_erreurs <- c() # for (i in 1:nrow(itineraires)) { # CHEP <- paste('FR', substr(itineraires$nuchep[i],1,8) , sep='') # if (itineraires$codoper[i] %in% c('ERLAM', 'STBIL', 'FRROB', 'JEAUC', 'GADES', 'ETJON', 'LOCDG', 'ANHUV')) { # TECH <- itineraires$codoper[i] # } else { # li_tech <- subset(dept_tech, dept_tech$num == substr(itineraires$nuchep[i], 1, 2)) # TECH <- li_tech$tech1[1] # } # cat(CHEP, TECH, '\n') # if (dir.exists(path=paste(rep_exp, TECH, '/', CHEP, sep='')) == FALSE # | file.exists(paste(paste(rep_exp, TECH, '/' ,CHEP, sep=''), # '/', CHEP, '_synthese_eCow5.html', sep = "")) == FALSE) { # # tryCatch( # # expr = { # render_all_fic(CHEP, TECH) # # }, # # error = function(e) { # # cat('ERREUR CALCUL', CHEP, '\n') # # append(li_erreurs, CHEP) # # }) # #render_all_fic(CHEP, TECH) # } # } # print(li_erreurs) ################################################################################ ### requete sur les cheptels d'une liste d?finie ############################### ################################################################################ options(timeout = 1200) li_chep <- c( "FR63118167" ) TECH <- 'VN2025' li_erreurs <- c() for (i in 1:length(li_chep)) { CHEP <- li_chep[i] cat(CHEP, TECH, '\n') if (dir.exists(path=paste(rep_exp, TECH, '/', CHEP, sep='')) == FALSE | file.exists(paste(paste(rep_exp, TECH, '/' ,CHEP, sep=''), '/', CHEP, '_synthese_eCow5.html', sep = "")) == FALSE) { tryCatch( expr = { render_all_fic(CHEP, TECH) }, error = function(e) { cat('ERREUR CALCUL', CHEP) li_erreurs[[(length(li_erreurs) + 1)]] <- CHEP }) render_all_fic(CHEP, TECH) } } adh_avril2024 <- read_delim("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/Bureau/adhhbc_20240429.csv", delim = ";", escape_double = FALSE, trim_ws = TRUE) adh_avril2024$export <- NA for (i in 1:nrow(adh_avril2024)){ CHEP <- adh_avril2024$CHEP[i] TECH <- adh_avril2024$TECH[i] cat(CHEP, TECH, '\n') tryCatch( expr = { render_all_fic(CHEP, TECH) }, error = function(e){ cat('ERREUR CALCUL', CHEP, "\n") adh_avril2024$export[i] <- "ERREUR" } ) } ################################################################################ ### requete ? partir d'un fichier de cheptels et techs ######################## ################################################################################ # # li_spec <- read_delim("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/Bureau/pre_engagement_VN2023_14juin.csv", # ";", escape_double = FALSE, trim_ws = TRUE) # # li_erreurs <- c() # # for (i in 1:nrow(li_spec)) { # CHEP <- li_spec$cheptel[i] # TECH <- li_spec$tech[i] # cat(CHEP, TECH, '\n') # tryCatch( # expr = { # render_all_fic(CHEP, TECH) # }, # error = function(e) { # cat('ERREUR CALCUL', CHEP) # li_erreurs[[(length(li_erreurs) + 1)]] <- CHEP # }) # #render_all_fic(CHEP, TECH) # } ################################################################################ ### SCRIPT d'ARCHIVAGE des VIEUX FICHIERS/DOSSIERS ############################# ################################################################################ # # contenu du dossier EXPORT # li_doc_rep <- as.data.frame(list.files(path = rep_exp)) # # #contenu des dossiers TECH # li_doc_sousrep <- as.data.frame(list.files(path = paste(rep_exp, li_doc_rep[2,1], sep = ''))) # #contenu des dossiers CHEPTEL # li_doc_ssrep <- as.data.frame(list.files(path = paste(rep_exp, li_doc_rep[2,1], '/', li_doc_sousrep[1,1], sep = ''))) # # auj <- Sys.time() # # nb_fic_supp <- 0 # nb_fic_archive <- 0 # # for (i in 2:nrow(li_doc_rep)) { # # contenu des dossiers TECH # li_doc_sousrep <- as.data.frame(list.files(path = paste(rep_exp, li_doc_rep[i,1], sep = ''))) # for (j in 1:nrow(li_doc_sousrep)) { # # contenu des dossiers CHEPTEL # li_doc_ssrep <- as.data.frame(list.files(path = paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], sep = ''))) # # dc <- file.info(paste(rep_exp, li_doc_rep[i,1], '/',li_doc_sousrep[j,1], '/',li_doc_ssrep[1,1], sep = ''))$ctime # #cat(dc, '\n') # # if (is.na(dc)) { # si dossier vide, on le supprime # print('VIDE') # print(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], sep = '')) # unlink(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], sep = ''), recursive = TRUE) # nb_fic_supp <- nb_fic_supp + 1 # # } else if (time_length(interval(dc, auj), "days") > 180) { # sinon on l'archive # print('VIEUX') # print(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], sep = '')) # nb_fic_archive <- nb_fic_archive + 1 # # # on supprime les fichiers html et pdf (car volumineux) # if (file.exists(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], '/', li_doc_sousrep[j,1], '_ArbreLigneesF_eCow5.pdf', sep = ''))) { # unlink(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], '/', li_doc_sousrep[j,1], '_ArbreLigneesF_eCow5.pdf', sep = ''), recursive = TRUE) # } # if (file.exists(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], '/', li_doc_sousrep[j,1], '_rapport_eCow5.html', sep = ''))) { # unlink(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], '/', li_doc_sousrep[j,1], '_rapport_eCow5.html', sep = ''), recursive = TRUE) # } # if (file.exists(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], '/', li_doc_sousrep[j,1], '_synthese_eCow5.html', sep = ''))) { # unlink(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], '/', li_doc_sousrep[j,1], '_synthese_eCow5.html', sep = ''), recursive = TRUE) # } # # # on archive les fichiers csv en dehors du fichier export ------------------------------------- date à modifier !!!!!!!!!!!!!!! # dir.create(paste("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/eCow5/archives_EXPORTS_R/20231205/", li_doc_sousrep[j,1], sep='')) # li_doc_ssrep2 <- as.data.frame(list.files(path = paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], sep = ''))) # for (k in 1:nrow(li_doc_ssrep2)) { # filesstrings::file.move(paste(rep_exp, li_doc_rep[i,1], '/',li_doc_sousrep[j,1], '/',li_doc_ssrep2[k,1], sep = ''), # paste("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/eCow5/archives_EXPORTS_R/20231205/", li_doc_sousrep[j,1], sep='')) # } # unlink(paste(rep_exp, li_doc_rep[i,1], '/', li_doc_sousrep[j,1], sep = ''), recursive = TRUE) # # } # } # print(paste("NB fichiers supprimes : ", nb_fic_supp, sep='')) # print(paste("NB fichiers archives : ", nb_fic_archive)) # } ################################################################################ ### Fonction de recuperation des classements eCow pour la Vente Nationale 2022 ### ################################################################################ li_vn <- read_delim("C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/VN/VN2025_liste_meres.csv", delim = ";") li_vn$NOM_MERE = li_vn$AGE = li_vn$nb_VA_tot = li_vn$nb_VA_cla = li_vn$rg <- NA # clsst = data.frame(matrix(NA, ncol = 6, nrow = 1)) # colnames(clsst) = c('ANIM', 'NOBOVI', 'AGE', 'nb_VA_tot', 'nb_VA_cla', 'rg') for(i in 1:nrow(li_vn)){ print(i) CHEP = li_vn$CHEPDET[i] #TECH = li_vn$TECH[i] ANIM = li_vn$MERE[i] ## si le fichier existe pathVN = "C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/eCow5/EXPORTS_2/VN2025" #paste(rep_exp, TECH, '/', CHEP, sep='') if (dir.exists(path = pathVN) == TRUE & file.exists(paste(pathVN, '/', CHEP,'/', CHEP, '_classement_eCow5.csv', sep = "")) == TRUE) { ## si il est assez recent : < 3 mois if( file.info(paste(pathVN, '/', CHEP,'/', CHEP, '_classement_eCow5.csv', sep = ""))$ctime > "2022-03-27") { # on va chercher les infos recup <- read_delim( paste(pathVN, '/', CHEP, '/', CHEP, '_classement_eCow5.csv', sep = ""), delim = ";", escape_double = FALSE, locale = locale(decimal_mark = ","), trim_ws = TRUE) li_vn$nb_VA_tot[i] = nrow(recup) x = subset(recup, recup$NUM_VACHE == ANIM) cla = subset(recup, !is.na(recup$`rang CARRIERE`)) if(nrow(x) > 0){ li_vn$NOM_MERE[i] = x$NOM_VACHE[1] li_vn$AGE[i] = x$`AGE (annees)`[1] li_vn$rg[i] = x$`rang CARRIERE`[1] li_vn$nb_VA_cla[i] = nrow(cla) } else { li_vn$rg[i] = 'abs' } } else { print("else0") ## sinon on le genere # tryCatch( # expr = { # render_all_fic(CHEP, TECH) # }, # error = function(e) { # cat('ERREUR CALCUL', CHEP, '\n') # }) # ## puis on va chercher le fichier # recup <- read_delim( paste( paste(rep_exp, TECH, '/' ,CHEP, sep=''), # '/', CHEP, '_classement_eCow5.csv', sep = ""), # delim = ";", escape_double = FALSE, # locale = locale(decimal_mark = ","), # trim_ws = TRUE) # li_vn$nb_VA_tot[i] = nrow(recup) # x = subset(recup, recup$NUM_VACHE == ANIM) # cla = subset(recup, !is.na(recup$`rang CARRIERE`)) # if(nrow(x) > 0){ # li_vn$NOBOVI[i] = x$NOM_VACHE[1] # li_vn$AGE[i] = x$`AGE (annees)`[1] # li_vn$rg[i] = x$`rang CARRIERE`[1] # li_vn$nb_VA_cla[i] = nrow(cla) # } else { # li_vn$rg[i] = 'abs' # } } } else { print("else1") ## sinon on genere le fichier # tryCatch( # expr = { # render_all_fic(CHEP, TECH) # }, # error = function(e) { # cat('ERREUR CALCUL', CHEP, '\n') # }) # ## puis on va chercher le fichier # recup <- read_delim( paste( paste(rep_exp, TECH, '/' ,CHEP, sep=''), # '/', CHEP, '_classement_eCow5.csv', sep = ""), # delim = ";", escape_double = FALSE, # locale = locale(decimal_mark = ","), # trim_ws = TRUE) # li_vn$nb_VA_tot[i] = nrow(recup) # x = subset(recup, recup$NUM_VACHE == ANIM) # cla = subset(recup, !is.na(recup$`rang CARRIERE`)) # if(nrow(x) > 0){ # li_vn$NOBOVI[i] = x$NOM_VACHE[1] # li_vn$AGE[i] = x$`AGE (annees)`[1] # li_vn$rg[i] = x$`rang CARRIERE`[1] # li_vn$nb_VA_cla[i] = nrow(cla) # } else { # li_vn$rg[i] = 'abs' # } } } write.table(li_vn, file = "C:/Users/LJEANNOT/OneDrive - HERD BOOK CHAROLAIS/2_HBC/07_PROJETS/ECOW/VN/VN2025_eCow_MERES.csv", quote = FALSE, dec = ",", row.names = FALSE, col.names = TRUE, sep = ";", qmethod = c("escape"), na = "")