Mercurial > repos > ecology > pampa_communitymetrics
diff FunctExeCalcCommIndexesGalaxy.r @ 5:5bd7ddd7601f draft
"planemo upload for repository https://github.com/ColineRoyaux/PAMPA-Galaxy commit 04381ca7162ec3ec68419e308194b91d11cacb04"
author | ecology |
---|---|
date | Mon, 16 Nov 2020 11:02:24 +0000 |
parents | ddd5b2e74b8b |
children | 2cd0a5a321c2 |
line wrap: on
line diff
--- a/FunctExeCalcCommIndexesGalaxy.r Mon Jul 27 09:49:33 2020 -0400 +++ b/FunctExeCalcCommIndexesGalaxy.r Mon Nov 16 11:02:24 2020 +0000 @@ -1,157 +1,140 @@ -#Rscript - -##################################################################################################################### -##################################################################################################################### -################################# Calculate community indexes from observation data ################################# -##################################################################################################################### -##################################################################################################################### - -###################### Packages R - -suppressMessages(library(tidyr)) - -###################### Load arguments and declaring variables - -args = commandArgs(trailingOnly=TRUE) -#options(encoding = "UTF-8") - -if (length(args) < 4) { - stop("At least one argument must be supplied, an input dataset file (.tabular).", call.=FALSE) #si pas d'arguments -> affiche erreur et quitte / if no args -> error and exit1 - -} else { - Importdata<-args[1] ###### Nom du fichier importé avec son extension / file name imported with the file type ".filetype" - index <- args[2] ###### List of selected metrics to calculate - source(args[3]) ###### Import functions - -} -#### Data must be a dataframe with at least 3 variables : unitobs representing location and year ("observation.unit"), species code ("species.code") and abundance ("number") - - -#Import des données / Import data -obs<- read.table(Importdata,sep="\t",dec=".",header=TRUE,encoding="UTF-8") # -obs[obs == -999] <- NA -factors <- fact.det.f(Obs=obs) -ObsType <- def.typeobs.f(Obs=obs) -obs <- create.unitobs(data=obs) - -vars_data<-c("observation.unit","species.code","number") -err_msg_data<-"The input dataset doesn't have the right format. It need to have at least the following 3 variables :\n- observation.unit (or point and year)\n- species.code\n- number\n" -check_file(obs,err_msg_data,vars_data,3) - - - -#################################################################################################### -################## create community metrics table ## Function : calcBiodiv.f ####################### -#################################################################################################### - -######################################################################################################################## -calcBiodiv.f <- function(Data, MPA, unitobs="observation.unit", code.especes="species.code", nombres="number", - indices=index) -{ - ## Purpose: calcul des indices de biodiversité - ## ---------------------------------------------------------------------- - ## Arguments: Data : les données à partir desquelles calculer les - ## indices. Doivent comporter au minimum (colones) : - ## * unités d'observations/sites - ## * espèces présentes - ## * nombre d'individus /espèce/unitobs. - ## refesp : le référentiel espèces. - ## MPA : l'AMP (chaîne de charactères). - ## unitobs : nom de la colone d'unités d'observation. - ## code.especes : nom de la colone d'espèces. - ## nombres : nom de la colone de nombres. - ## indices : liste des indices à calculer - ## (vecteur de caractères) - ## ---------------------------------------------------------------------- - ## Author: Yves Reecht, Date: 29 oct. 2010, 08:58 - - ## Supression de tout ce qui n'a pas d'espèce précisee (peut être du non biotique ou identification >= genre) : - - notspline <- grep("(sp\\.)$|([1-9])$|^(Absencemacrofaune)$|^(NoID)$|^(Acrobranc)$|^(Acrodigit)$|^(Acroencr)$|^(Acrosubm)$|^(Acrotabu)$|^(Adredure)$|^(Adremoll)$|^(Algaturf)$|^(Balimona)$|^(Corablan)$|^(CoradurV)$|^(Coraenal)$|^(Coramor1)$|^(Coramor2)$|^(Coramou)$|^( Dallcora)$|^(Debrcora)$|^(Debris)$|^(Hare)$|^(HexaChar)$|^(MuraCong)$|^(Nacrbran)$|^(Nacrcham)$|^(Nacrencr)$|^(Nacrfoli)$|^(Nacrmass)$|^(Nacrsubm)$|^(Recrcora)$|^(Roche)$|^(Sable)$|^(Vase)$",Data[, code.especes], value=FALSE) - if (length(notspline) != 0) - { - Data <- Data[-notspline, ] - }else{} - - ## Suppression des niveaux de facteur inutilisés : - Data <- dropLevels.f(df=Data) - - - ## Si les données ne sont pas encore agrégées /espèce/unitobs on le fait ici : - if (nrow(Data) > nrow(expand.grid(unique(Data[ , unitobs]), unique(Data[ , code.especes])))) - { - Data <- agregations.generic.f(Data=Data, metrics=nombres, - factors=c(unitobs, code.especes), - listFact=NULL) - }else{} - - df.biodiv <- as.data.frame(as.table(tapply(Data[ , nombres], - Data[ , unitobs], - sum, na.rm=TRUE))) - - colnames(df.biodiv) <- c(unitobs, nombres) - -## ################################################## - ## Richesse spécifique : - Data$pres.abs <- presAbs.f(nombres=Data[ , nombres], logical = FALSE) - - df.biodiv$species.richness <- as.vector(tapply(Data$pres.abs, - Data[ , unitobs], sum, na.rm=TRUE), - "integer") - ## ... as.vector to avoid the class "array". - - ## ################################################## - ## Indices de Simpson et Shannon et dérivés : - - matNombres <- tapply(Data[ , nombres], # Matrice de nombres d'individus /espèce/unitobs. - list(Data[ , unitobs], Data[ , code.especes]), - sum, na.rm=TRUE) - - matNombres[is.na(matNombres)] <- 0 # Vrais zéros - - ## Proportion d'individus de chaque espèce dans l'unitobs : - propIndiv <- sweep(matNombres, 1, - apply(matNombres, 1, sum, na.rm = TRUE), # Nombre d'individus / unitobs ; équiv df.biodiv$nombre. - FUN="/") - - ## Indices de Simpson : - df.biodiv$simpson <- apply(propIndiv^2, 1, sum, na.rm=TRUE) - - if (any(is.element(c("all", "simpson.l"), indices))) - { - df.biodiv$simpson.l <- 1 - df.biodiv$simpson - } - - ## calcul de l'indice de Shannon : - df.biodiv$shannon <- -1 * apply(propIndiv * log(propIndiv), 1, sum, na.rm=TRUE) - - ## calcul de l'indice de Pielou : - if (any(is.element(c("all", "pielou"), indices))) - { - df.biodiv$pielou <- df.biodiv$shannon / log(df.biodiv$species.richness) - } - - ## calcul de l'indice de Hill : - if (any(is.element(c("all", "hill"), indices))) - { - df.biodiv$hill <- (1 - df.biodiv$simpson) / exp(df.biodiv$shannon) - # équiv df.biodiv$l.simpson / exp(df.biodiv$shannon) - } - - - return(df.biodiv) -} - -################# Analysis - -res <- calc.numbers.f(obs, ObsType=ObsType , factors=factors, nbName="number") - -tableCommunityIndexes <- calcBiodiv.f(res, MPA, unitobs="observation.unit", code.especes="species.code", nombres="number", - indices=index) -tableCommunityIndexes <- create.year.point(tableCommunityIndexes) -#Save dataframe in a tabular format - -filenameComm <- "TabCommunityIndexes.tabular" -write.table(tableCommunityIndexes, filenameComm, row.names=FALSE, sep="\t", dec=".",fileEncoding="UTF-8") -cat(paste("\nWrite table with Community indexes. \n--> \"",filenameComm,"\"\n",sep="")) - +#Rscript + +##################################################################################################################### +##################################################################################################################### +################################# Calculate community indexes from observation data ################################# +##################################################################################################################### +##################################################################################################################### + +###################### Packages R + +suppressMessages(library(tidyr)) + +###################### Load arguments and declaring variables + +args <- commandArgs(trailingOnly = TRUE) + +if (length(args) < 4) { + stop("At least one argument must be supplied, an input dataset file (.tabular).", call. = FALSE) # if no args -> error and exit1 + +} else { + import_data <- args[1] ###### Nom du fichier importé avec son extension / file name imported with the file type ".filetype" + index <- args[2] ###### List of selected metrics to calculate + source(args[3]) ###### Import functions +} +#### d_ata must be a dataframe with at least 3 variables : unitobs representing location and year ("observation.unit"), species code ("species.code") and abundance ("number") + + +#Import des données / Import data +obs <- read.table(import_data, sep = "\t", dec = ".", header = TRUE, encoding = "UTF-8") # +obs[obs == -999] <- NA +factors <- fact_det_f(obs = obs) +obs_type <- def_typeobs_f(obs = obs) +obs <- create_unitobs(data = obs) + +vars_data <- c("observation.unit", "species.code", "number") +err_msg_data <- "The input dataset doesn't have the right format. It need to have at least the following 3 variables :\n- observation.unit (or location and year)\n- species.code\n- number\n" +check_file(obs, err_msg_data, vars_data, 3) + + + +#################################################################################################### +################# create community metrics table ## Function : calc_biodiv_f ####################### +#################################################################################################### + +######################################################################################################################## +calc_biodiv_f <- function(d_ata, unitobs = "observation.unit", code_species = "species.code", nombres = "number", + indices = index) { + ## Purpose: compute biodiversity indexes + ## ---------------------------------------------------------------------- + ## Arguments: d_ata : input observation file + ## unitobs : name of column observation unit + ## code_species : name of species column + ## nombres : name of abundance column + ## indices : list of indexes to compute + ## ---------------------------------------------------------------------- + ## Author: Yves Reecht, Date: 29 oct. 2010, 08:58 modified by Coline ROYAUX in june 2020 + + ## Supress lines that doesn't represent a species : + + notspline <- grep("(sp\\.)$|([1-9])$|^(Absencemacrofaune)$|^(NoID)$|^(Acrobranc)$|^(Acrodigit)$|^(Acroencr)$|^(Acrosubm)$|^(Acrotabu)$|^(Adredure)$|^(Adremoll)$|^(Algaturf)$|^(Balimona)$|^(Corablan)$|^(CoradurV)$|^(Coraenal)$|^(Coramor1)$|^(Coramor2)$|^(Coramou)$|^( Dallcora)$|^(Debrcora)$|^(Debris)$|^(Hare)$|^(HexaChar)$|^(MuraCong)$|^(Nacrbran)$|^(Nacrcham)$|^(Nacrencr)$|^(Nacrfoli)$|^(Nacrmass)$|^(Nacrsubm)$|^(Recrcora)$|^(Roche)$|^(Sable)$|^(Vase)$", d_ata[, code_species], value = FALSE) + if (length(notspline) != 0) { + d_ata <- d_ata[-notspline, ] + } + + ## Suppress unused factor levels : + d_ata <- .GlobalEnv$drop_levels_f(df = d_ata) + + + ## aggregation of data if not already done : + if (nrow(d_ata) > nrow(expand.grid(unique(d_ata[, unitobs]), unique(d_ata[, code_species])))) { + d_ata <- agregations_generic_f(d_ata = d_ata, metrics = nombres, + factors = c(unitobs, code_species), + list_fact = NULL) + } + + df_biodiv <- as.data.frame(as.table(tapply(d_ata[, nombres], + d_ata[, unitobs], + sum, na.rm = TRUE))) + + colnames(df_biodiv) <- c(unitobs, nombres) + +## ################################################## + ## species richness : + d_ata$presence_absence <- .GlobalEnv$pres_abs_f(nombres = d_ata[, nombres], logical = FALSE) + + df_biodiv$species_richness <- as.vector(tapply(d_ata$presence_absence, + d_ata[, unitobs], sum, na.rm = TRUE), + "integer") + ## ... as.vector to avoid the class "array". + + ## ################################################## + ## Simpson, Shannon indexes and derivatives : + + mat_nb <- tapply(d_ata[, nombres], # Matrix of individual count /species/unitobs. + list(d_ata[, unitobs], d_ata[, code_species]), + sum, na.rm = TRUE) + + mat_nb[is.na(mat_nb)] <- 0 # Vrais zéros + + ## each species individual proportion in the dataset : + prop_indiv <- sweep(mat_nb, 1, + apply(mat_nb, 1, sum, na.rm = TRUE), # individual count / unitobs ; equiv df_biodiv$nombre. + FUN = "/") + + ## Simpson indexes : + df_biodiv$simpson <- apply(prop_indiv^2, 1, sum, na.rm = TRUE) + + if (any(is.element(c("all", "simpson.l"), indices))) { + df_biodiv$simpson_l <- 1 - df_biodiv$simpson + } + + ## Shannon index : + df_biodiv$shannon <- -1 * apply(prop_indiv * log(prop_indiv), 1, sum, na.rm = TRUE) + + ## Pielou index : + if (any(is.element(c("all", "pielou"), indices))) { + df_biodiv$pielou <- df_biodiv$shannon / log(df_biodiv$species_richness) + } + + ## Hill index : + if (any(is.element(c("all", "hill"), indices))) { + df_biodiv$hill <- (1 - df_biodiv$simpson) / exp(df_biodiv$shannon) # equiv df_biodiv$l.simpson / exp(df_biodiv$shannon) + } + + + return(df_biodiv) +} + +################# Analysis + +res <- calc_numbers_f(obs, obs_type = obs_type, factors = factors, nb_name = "number") + +table_comm_indexes <- calc_biodiv_f(res, unitobs = "observation.unit", code_species = "species.code", nombres = "number", + indices = index) +table_comm_indexes <- create_year_location(table_comm_indexes) +#Save dataframe in a tabular format + +filename_comm <- "TabCommunityIndexes.tabular" +write.table(table_comm_indexes, filename_comm, row.names = FALSE, sep = "\t", dec = ".", fileEncoding = "UTF-8") +cat(paste("\nWrite table with Community indexes. \n--> \"", filename_comm, "\"\n", sep = ""))