| Previous changeset 4:5873ac1a5a44 (2020-07-27) Next changeset 6:2cd0a5a321c2 (2021-04-26) |
|
Commit message:
"planemo upload for repository https://github.com/ColineRoyaux/PAMPA-Galaxy commit 04381ca7162ec3ec68419e308194b91d11cacb04" |
|
modified:
CalculateCommunityMetrics.xml FunctExeCalcCommIndexesGalaxy.r FunctPAMPAGalaxy.r pampa_macros.xml test-data/Community_metrics_cropped.tabular |
| b |
| diff -r 5873ac1a5a44 -r 5bd7ddd7601f CalculateCommunityMetrics.xml --- a/CalculateCommunityMetrics.xml Mon Jul 27 09:49:33 2020 -0400 +++ b/CalculateCommunityMetrics.xml Mon Nov 16 11:02:24 2020 +0000 |
| b |
| @@ -26,7 +26,7 @@ <data name="output_community" from_work_dir="TabCommunityIndexes.tabular" format="tabular"/> </outputs> <tests> - <test> + <test expect_num_outputs="1"> <param name="input" value="ObservationsSansszcl_cropped.tabular"/> <param name="indexes" value="all"/> <output name="output_community" value="Community_metrics_cropped.tabular"/> |
| b |
| diff -r 5873ac1a5a44 -r 5bd7ddd7601f FunctExeCalcCommIndexesGalaxy.r --- a/FunctExeCalcCommIndexesGalaxy.r Mon Jul 27 09:49:33 2020 -0400 +++ b/FunctExeCalcCommIndexesGalaxy.r Mon Nov 16 11:02:24 2020 +0000 |
| [ |
| b'@@ -1,157 +1,140 @@\n-#Rscript \n-\n-#####################################################################################################################\n-#####################################################################################################################\n-################################# Calculate community indexes from observation data #################################\n-#####################################################################################################################\n-#####################################################################################################################\n-\n-###################### Packages R \n-\n-suppressMessages(library(tidyr))\n-\n-###################### Load arguments and declaring variables\n-\n-args = commandArgs(trailingOnly=TRUE)\n-#options(encoding = "UTF-8")\n-\n-if (length(args) < 4) {\n- 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\n-\n-} else {\n- Importdata<-args[1] ###### Nom du fichier import\xc3\xa9 avec son extension / file name imported with the file type ".filetype" \n- index <- args[2] ###### List of selected metrics to calculate\n- source(args[3]) ###### Import functions\n-\n-}\n-#### Data must be a dataframe with at least 3 variables : unitobs representing location and year ("observation.unit"), species code ("species.code") and abundance ("number")\n-\n-\n-#Import des donn\xc3\xa9es / Import data \n-obs<- read.table(Importdata,sep="\\t",dec=".",header=TRUE,encoding="UTF-8") #\n-obs[obs == -999] <- NA \n-factors <- fact.det.f(Obs=obs)\n-ObsType <- def.typeobs.f(Obs=obs)\n-obs <- create.unitobs(data=obs)\n-\n-vars_data<-c("observation.unit","species.code","number")\n-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"\n-check_file(obs,err_msg_data,vars_data,3)\n-\n-\n-\n-####################################################################################################\n-################## create community metrics table ## Function : calcBiodiv.f #######################\n-####################################################################################################\n-\n-########################################################################################################################\n-calcBiodiv.f <- function(Data, MPA, unitobs="observation.unit", code.especes="species.code", nombres="number",\n- indices=index)\n-{\n- ## Purpose: calcul des indices de biodiversit\xc3\xa9\n- ## ----------------------------------------------------------------------\n- ## Arguments: Data : les donn\xc3\xa9es \xc3\xa0 partir desquelles calculer les\n- ## indices. Doivent comporter au minimum (colones) :\n- ## * unit\xc3\xa9s d\'observations/sites\n- ## * esp\xc3\xa8ces pr\xc3\xa9sentes\n- ## * nombre d\'individus /esp\xc3\xa8ce/unitobs.\n- ## refesp : le r\xc3\xa9f\xc3\xa9rentiel esp\xc3\xa8ces.\n- ## MPA : l\'AMP (cha\xc3\xaene de charact\xc3\xa8res).\n- ## unitobs : nom de la colone d\'unit\xc3\xa9s d\'observation.\n- ## code.especes : nom de la colone d\'esp\xc3\xa8ces.\n- ## nombres : nom de la colone de nombres.\n- ## indices : liste des indices \xc3\xa0 calculer\n- ## (vecteur de caract\xc3\xa8res)\n- ## ----------------------------------------------------------------------\n- ## Author: Yves Reecht, Date: 29 oct. 2010, 08:58\n-\n- ## Supression de tout ce qui n\'a pas d\'esp\xc3\xa8ce pr\xc3\xa9cisee (peut \xc3\xaatre du non biotique ou identification >= genre) :\n-\n- notspline <- grep("(sp\\\\.)$|([1-9])$|^(Absencemacrofaune)$|^(NoID)$|^(Acrobranc)$|^(Acrodigit)$|^(Acroencr)$|^(Acrosubm)$|^(Acrotabu)$|^(Adredure)$|^(Adremoll)$|^(Algaturf)$|^(Balimona)$|^(Corablan)$|^(CoradurV)$|^(Coraenal)$|^(Coramor1)$|^(Coramor2)$|^(Cora'..b' ## Author: Yves Reecht, Date: 29 oct. 2010, 08:58 modified by Coline ROYAUX in june 2020\r\n+\r\n+ ## Supress lines that doesn\'t represent a species :\r\n+\r\n+ 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)\r\n+ if (length(notspline) != 0) {\r\n+ d_ata <- d_ata[-notspline, ]\r\n+ }\r\n+\r\n+ ## Suppress unused factor levels :\r\n+ d_ata <- .GlobalEnv$drop_levels_f(df = d_ata)\r\n+\r\n+\r\n+ ## aggregation of data if not already done :\r\n+ if (nrow(d_ata) > nrow(expand.grid(unique(d_ata[, unitobs]), unique(d_ata[, code_species])))) {\r\n+ d_ata <- agregations_generic_f(d_ata = d_ata, metrics = nombres,\r\n+ factors = c(unitobs, code_species),\r\n+ list_fact = NULL)\r\n+ }\r\n+\r\n+ df_biodiv <- as.data.frame(as.table(tapply(d_ata[, nombres],\r\n+ d_ata[, unitobs],\r\n+ sum, na.rm = TRUE)))\r\n+\r\n+ colnames(df_biodiv) <- c(unitobs, nombres)\r\n+\r\n+## ##################################################\r\n+ ## species richness :\r\n+ d_ata$presence_absence <- .GlobalEnv$pres_abs_f(nombres = d_ata[, nombres], logical = FALSE)\r\n+\r\n+ df_biodiv$species_richness <- as.vector(tapply(d_ata$presence_absence,\r\n+ d_ata[, unitobs], sum, na.rm = TRUE),\r\n+ "integer")\r\n+ ## ... as.vector to avoid the class "array".\r\n+\r\n+ ## ##################################################\r\n+ ## Simpson, Shannon indexes and derivatives :\r\n+\r\n+ mat_nb <- tapply(d_ata[, nombres], # Matrix of individual count /species/unitobs.\r\n+ list(d_ata[, unitobs], d_ata[, code_species]),\r\n+ sum, na.rm = TRUE)\r\n+\r\n+ mat_nb[is.na(mat_nb)] <- 0 # Vrais z\xc3\xa9ros\r\n+\r\n+ ## each species individual proportion in the dataset :\r\n+ prop_indiv <- sweep(mat_nb, 1,\r\n+ apply(mat_nb, 1, sum, na.rm = TRUE), # individual count / unitobs ; equiv df_biodiv$nombre.\r\n+ FUN = "/")\r\n+\r\n+ ## Simpson indexes :\r\n+ df_biodiv$simpson <- apply(prop_indiv^2, 1, sum, na.rm = TRUE)\r\n+\r\n+ if (any(is.element(c("all", "simpson.l"), indices))) {\r\n+ df_biodiv$simpson_l <- 1 - df_biodiv$simpson\r\n+ }\r\n+\r\n+ ## Shannon index :\r\n+ df_biodiv$shannon <- -1 * apply(prop_indiv * log(prop_indiv), 1, sum, na.rm = TRUE)\r\n+\r\n+ ## Pielou index :\r\n+ if (any(is.element(c("all", "pielou"), indices))) {\r\n+ df_biodiv$pielou <- df_biodiv$shannon / log(df_biodiv$species_richness)\r\n+ }\r\n+\r\n+ ## Hill index :\r\n+ if (any(is.element(c("all", "hill"), indices))) {\r\n+ df_biodiv$hill <- (1 - df_biodiv$simpson) / exp(df_biodiv$shannon) # equiv df_biodiv$l.simpson / exp(df_biodiv$shannon)\r\n+ }\r\n+\r\n+\r\n+ return(df_biodiv)\r\n+}\r\n+\r\n+################# Analysis\r\n+\r\n+res <- calc_numbers_f(obs, obs_type = obs_type, factors = factors, nb_name = "number")\r\n+\r\n+table_comm_indexes <- calc_biodiv_f(res, unitobs = "observation.unit", code_species = "species.code", nombres = "number",\r\n+ indices = index)\r\n+table_comm_indexes <- create_year_location(table_comm_indexes)\r\n+#Save dataframe in a tabular format\r\n+\r\n+filename_comm <- "TabCommunityIndexes.tabular"\r\n+write.table(table_comm_indexes, filename_comm, row.names = FALSE, sep = "\\t", dec = ".", fileEncoding = "UTF-8")\r\n+cat(paste("\\nWrite table with Community indexes. \\n--> \\"", filename_comm, "\\"\\n", sep = ""))\r\n' |
| b |
| diff -r 5873ac1a5a44 -r 5bd7ddd7601f FunctPAMPAGalaxy.r --- a/FunctPAMPAGalaxy.r Mon Jul 27 09:49:33 2020 -0400 +++ b/FunctPAMPAGalaxy.r Mon Nov 16 11:02:24 2020 +0000 |
| [ |
| b'@@ -11,77 +11,71 @@\n ######################################### start of the function fact.def.f called by FunctExeCalcCommIndexesGalaxy.r and FunctExeCalcPresAbsGalaxy.r\n ####### Define the finest aggregation with the observation table\n \n-fact.det.f <- function (Obs,\n- size.class="size.class",\n- code.especes="species.code",\n- unitobs="observation.unit")\n-{\n- if (any(is.element(c(size.class), colnames(obs))) && all(! is.na(obs[, size.class])))\n- {\n- factors <- c(unitobs, code.especes, size.class)\n+fact_det_f <- function(obs,\n+ size_class = "size.class",\n+ code_species = "species.code",\n+ unitobs = "observation.unit") {\n+ if (any(is.element(c(size_class), colnames(obs))) && all(! is.na(obs[, size_class]))) {\n+ factors <- c(unitobs, code_species, size_class)\n }else{\n- factors <- c(unitobs, code.especes)\n+ factors <- c(unitobs, code_species)\n }\n return(factors)\n }\n \n-######################################### end of the function fact.def.f \n+######################################### end of the function fact.def.f\n \n-######################################### start of the function def.typeobs.f called by FunctExeCalcCommIndexesGalaxy.r and FunctExeCalcPresAbsGalaxy.r\n+######################################### start of the function def_typeobs_f called by FunctExeCalcCommIndexesGalaxy.r and FunctExeCalcPresAbsGalaxy.r\n ####### Define observation type from colnames\n \n-def.typeobs.f <- function(Obs)\n-{\n- if (any(is.element(c("rotation","rot","rotate"),colnames(obs))))\n- {\n- ObsType <- "SVR"\n+def_typeobs_f <- function(obs) {\n+ if (any(is.element(c("rotation", "rot", "rotate"), colnames(obs)))) {\n+ obs_type <- "SVR"\n }else{\n- ObsType <- "other"\n+ obs_type <- "other"\n }\n- return(ObsType)\n+ return(obs_type)\n }\n-######################################### end of the function fact.def.f \n+######################################### end of the function fact.def.f\n \n-######################################### start of the function create.unitobs called by FunctExeCalcCommIndexesGalaxy.r and FunctExeCalcPresAbsGalaxy.r\n+######################################### start of the function create_unitobs called by FunctExeCalcCommIndexesGalaxy.r and FunctExeCalcPresAbsGalaxy.r\n ####### Create unitobs column when inexistant\n-create.unitobs <- function(data,year="year",point="point", unitobs="observation.unit")\n-{\n- if (is.element(paste(unitobs),colnames(data)) && all(grepl("[1-2][0|8|9][0-9]{2}_.*",data[,unitobs])==FALSE))\n- {\n- unitab <- data\n+create_unitobs <- function(data, year = "year", location = "location", unitobs = "observation.unit") {\n+ if (is.element(paste(unitobs), colnames(data))) {\n+ unitab <- data\n+ }else{\n \n- }else{ \n-\n- unitab <- unite(data,col="observation.unit",c(year,point))\n+ unitab <- tidyr::unite(data, col = "observation.unit", c(year, location))\n }\n return(unitab)\n }\n-######################################### start of the function create.unitobs\n+######################################### start of the function create_unitobs\n \n-######################################### start of the function create.year.point called by FunctExeCalcCommIndexesGalaxy.r and FunctExeCalcPresAbsGalaxy.r\n+######################################### start of the function create_year_location called by FunctExeCalcCommIndexesGalaxy.r and FunctExeCalcPresAbsGalaxy.r\n ####### separate unitobs column when existant\n-create.year.point <- function(data,year="year",point="point", unitobs="observation.unit")\n-{\n- if (all(grepl("[1-2][0|8|9][0-9]{2}_.*",data[,unitobs]))==TRUE)\n- {\n- tab <- separate(data,col=unitobs,into=c(year,point),sep="_")\n+create_year_location <- function(data, year = "year", location = "location", unitobs = "observation.uni'..b' "Raw residuals" , ylab = "Residual", xlab = "Predicted")\n- mtext("Conventional residual plots", outer = T)\n-}\n-\n-\n-\n-\n-#\n-#\n-# if(quantreg == F){\n-#\n-# lines(smooth.spline(simulationOutput$fittedPredictedResponse, simulationOutput$scaledResiduals, df = 10), lty = 2, lwd = 2, col = "red")\n-#\n-# abline(h = 0.5, col = "red", lwd = 2)\n-#\n-# }else{\n-#\n-# #library(gamlss)\n-#\n-# # qrnn\n-#\n-# # http://r.789695.n4.nabble.com/Quantile-GAM-td894280.html\n-#\n-# #require(quantreg)\n-# #dat <- plyr::arrange(dat,pred)\n-# #fit<-quantreg::rqss(resid~qss(pred,constraint="N"),tau=0.5,data = dat)\n-#\n-# probs = c(0.25, 0.50, 0.75)\n-#\n-# w <- p <- list()\n-# for(i in seq_along(probs)){\n-# capture.output(w[[i]] <- qrnn::qrnn.fit(x = as.matrix(simulationOutput$fittedPredictedResponse), y = as.matrix(simulationOutput$scaledResiduals), n.hidden = 4, tau = probs[i], iter.max = 1000, n.trials = 1, penalty = 1))\n-# p[[i]] <- qrnn::qrnn.predict(as.matrix(sort(simulationOutput$fittedPredictedResponse)), w[[i]])\n-# }\n-#\n-#\n-#\n-# #plot(simulationOutput$fittedPredictedResponse, simulationOutput$scaledResiduals, xlab = "Predicted", ylab = "Residual", main = "Residual vs. predicted\\n lines should match", cex.main = 1)\n-#\n-# #lines(sort(simulationOutput$fittedPredictedResponse), as.vector(p[[1]]), col = "red")\n-#\n-# matlines(sort(simulationOutput$fittedPredictedResponse), matrix(unlist(p), nrow = length(simulationOutput$fittedPredictedResponse), ncol = length(p)), col = "red", lty = 1)\n-#\n-# # as.vector(p[[1]])\n-# #\n-# #\n-# # lines(simulationOutput$fittedPredictedResponse,p[[1]], col = "red", lwd = 2)\n-# # abline(h = 0.5, col = "red", lwd = 2)\n-# #\n-# # fit<-quantreg::rqss(resid~qss(pred,constraint="N"),tau=0.25,data = dat)\n-# # lines(unique(dat$pred)[-1],fit$coef[1] + fit$coef[-1], col = "green", lwd = 2, lty =2)\n-# # abline(h = 0.25, col = "green", lwd = 2, lty =2)\n-# #\n-# # fit<-quantreg::rqss(resid~qss(pred,constraint="N"),tau=0.75,data = dat)\n-# # lines(unique(dat$pred)[-1],fit$coef[1] + fit$coef[-1], col = "blue", lwd = 2, lty = 2)\n-# # abline(h = 0.75, col = "blue", lwd = 2, lty =2)\n-# }\n-\n-####################### plot.R\n-\n-####################### random.R\n-\n-#\' Record and restore a random state\n-#\' \n-#\' The aim of this function is to record, manipualate and restor a random state\n-#\' \n-#\' @details This function is intended for two (not mutually exclusive tasks)\n-#\' \n-#\' a) record the current random state\n-#\' \n-#\' b) change the current random state in a way that the previous state can be restored\n-#\' \n-#\' @return a list with various infos about the random state that after function execution, as well as a function to restore the previous state before the function execution\n-#\' \n-#\' @param seed seed argument to set.seed(). NULL = no seed, but random state will be restored. F = random state will not be restored\n-#\' @export\n-#\' @example inst/examples/getRandomStateHelp.R\n-#\' @author Florian Hartig\n-#\' \n-getRandomState <- function(seed = NULL){\n- \n- # better to explicitly access the global RS?\n- # current = get(".Random.seed", .GlobalEnv, ifnotfound = NULL)\n- \n- current = mget(".Random.seed", envir = .GlobalEnv, ifnotfound = list(NULL))[[1]]\n- \n- if(is.logical(seed) & seed == F){\n- restoreCurrent <- function(){} \n- }else{\n- restoreCurrent <- function(){\n- if(is.null(current)) rm(".Random.seed", envir = .GlobalEnv) else assign(".Random.seed", current , envir = .GlobalEnv)\n- } \n- }\n-\n- # setting seed\n- if(is.numeric(seed)) set.seed(seed)\n-\n- # ensuring that RNG has been initialized\n- if (is.null(current))runif(1) \n- \n- randomState = list(seed, state = get(".Random.seed", globalenv()), kind = RNGkind(), restoreCurrent = restoreCurrent) \n- return(randomState)\n-}\n-\n-####################### random.R\n-\n-######################################### Package DHARMa\n+######################################### start of the function summary_fr\n' |
| b |
| diff -r 5873ac1a5a44 -r 5bd7ddd7601f pampa_macros.xml --- a/pampa_macros.xml Mon Jul 27 09:49:33 2020 -0400 +++ b/pampa_macros.xml Mon Nov 16 11:02:24 2020 +0000 |
| [ |
| @@ -1,5 +1,5 @@ <macros> - <token name="@VERSION@">0.0.1</token> + <token name="@VERSION@">0.0.2</token> <xml name="Pampa_requirements"> <requirements> <requirement type="package" version="1.0.2">r-tidyr</requirement> @@ -10,11 +10,13 @@ <requirement type="package" version="1.2.2">r-gap</requirement> <requirement type="package" version="1.0.1">r-glmmtmb</requirement> <requirement type="package" version="1.4_13">r-multcomp</requirement> + <requirement type="package" version="0.3.3.0">r-dharma</requirement> </requirements> </xml> <xml name="Plot_requirements"> <requirements> <requirement type="package" version="3.1.1">r-ggplot2</requirement> + <requirement type="package" version="1.3_25">r-boot</requirement> </requirements> </xml> <xml name="pampa_input_calculate"> @@ -46,6 +48,7 @@ <option value="quasibinomial">Quasi-Binomial</option> <option value="Gamma">Gamma</option> </param> + <param name="rdata" type="boolean" checked="yes" label="GLM object(s) as .Rdata output ?"/> </when> </xml> <xml name="pampa_input_GLM"> @@ -67,6 +70,10 @@ <xml name="pampa_output_GLM"> <data name="output_recap" from_work_dir="GLMSummaryFull.txt" format="txt" label="Simple statistics on chosen variables on ${on_string}"/> <data name="output_rate" from_work_dir="RatingGLM.txt" format="txt" label="Your analysis rating file on ${on_string}"/> + <collection type="list" name="output_GLM"> + <discover_datasets pattern="(?P<designation>.+)\.Rdata" visible="false" format="Rdata"/> + <filter> settings['advanced'] == 'advanced' and settings['rdata']</filter> + </collection> </xml> <xml name="pampa_bibref"> <citations> |
| b |
| diff -r 5873ac1a5a44 -r 5bd7ddd7601f test-data/Community_metrics_cropped.tabular --- a/test-data/Community_metrics_cropped.tabular Mon Jul 27 09:49:33 2020 -0400 +++ b/test-data/Community_metrics_cropped.tabular Mon Nov 16 11:02:24 2020 +0000 |
| b |
| @@ -1,4 +1,4 @@ -"point" "year" "number" "species.richness" "simpson" "simpson.l" "shannon" "pielou" "hill" "observation.unit" +"location" "year" "number" "species_richness" "simpson" "simpson_l" "shannon" "pielou" "hill" "observation.unit" "AB_0008" "08" 2.66666666666667 1 1 0 0 NA 0 "AB080008" "AB_0015" "08" 3 1 1 0 0 NA 0 "AB080015" "AB_0027" "08" 1.33333333333333 1 1 0 0 NA 0 "AB080027" |