| Previous changeset 2:f1bfdeb5ebfe (2020-07-27) Next changeset 4:07b081730994 (2021-04-26) |
|
Commit message:
"planemo upload for repository https://github.com/ColineRoyaux/PAMPA-Galaxy commit 04381ca7162ec3ec68419e308194b91d11cacb04" |
|
modified:
CalculatePresAbs.xml FunctExeCalcPresAbsGalaxy.r FunctPAMPAGalaxy.r pampa_macros.xml test-data/Presence_absence_table_sansszcl_cropped.tabular |
| b |
| diff -r f1bfdeb5ebfe -r 8d8aec182fb1 CalculatePresAbs.xml --- a/CalculatePresAbs.xml Mon Jul 27 09:46:51 2020 -0400 +++ b/CalculatePresAbs.xml Mon Nov 16 11:02:09 2020 +0000 |
| [ |
| @@ -19,7 +19,7 @@ <data name="output_presabs" from_work_dir="TabPresAbs.tabular" format="tabular"/> </outputs> <tests> - <test> + <test expect_num_outputs="1"> <param name="input" value="ObservationsSansszcl_cropped.tabular"/> <output name="output_presabs" value="Presence_absence_table_sansszcl_cropped.tabular"/> </test> @@ -29,6 +29,7 @@ <edam_topic>topic_3050</edam_topic> </edam_topics> <help><![CDATA[ + ==================================================== Calculate presence absence table from abundance data ==================================================== @@ -82,6 +83,5 @@ Derived from PAMPA scripts (https://wwz.ifremer.fr/pampa/Meth.-Outils/Outils) written by Yves Reecht. ]]></help> - <expand macro="pampa_bibref" /> </tool> |
| b |
| diff -r f1bfdeb5ebfe -r 8d8aec182fb1 FunctExeCalcPresAbsGalaxy.r --- a/FunctExeCalcPresAbsGalaxy.r Mon Jul 27 09:46:51 2020 -0400 +++ b/FunctExeCalcPresAbsGalaxy.r Mon Nov 16 11:02:09 2020 +0000 |
| [ |
| @@ -1,75 +1,73 @@ -#Rscript - -##################################################################################################################### -##################################################################################################################### -############################ Calculate presence absence table from observation data ################################# -##################################################################################################################### -##################################################################################################################### - -###################### Packages -suppressMessages(library(tidyr)) - -###################### Load arguments and declaring variables - -args = commandArgs(trailingOnly=TRUE) -#options(encoding = "UTF-8") - -if (length(args) < 2) { - 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" - source(args[2]) ###### 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 presence/absence table ## Function : calc.presAbs.f #################### -#################################################################################################### - -calc.presAbs.f <- function(Data, - nbName="number") -{ - ## Purpose: Compute presence absence - ## ---------------------------------------------------------------------- - ## Arguments: Data : temporary metrics table - ## nbName : name of abundance column - ## - ## Output: presence absence vector - ## ---------------------------------------------------------------------- - ## Author: Yves Reecht, Date: 20 déc. 2011, 12:04 modified by Coline ROYAUX 04 june 2020 - - ## Presence - absence : - presAbs <- integer(nrow(Data)) - presAbs[Data[ , nbName] > 0] <- as.integer(1) - presAbs[Data[ , nbName] == 0] <- as.integer(0) - - return(presAbs) -} - - -################# Analysis - -res <- calc.numbers.f(obs, ObsType=ObsType , factors=factors, nbName="number") -res$pres.abs <- calc.presAbs.f(res, nbName="number") -res <- create.year.point(res) - -#Save dataframe in a tabular format -filenamePresAbs <- "TabPresAbs.tabular" -write.table(res, filenamePresAbs, row.names=FALSE, sep="\t", dec=".",fileEncoding="UTF-8") -cat(paste("\nWrite table with presence/absence. \n--> \"",filenamePresAbs,"\"\n",sep="")) - +#Rscript + +##################################################################################################################### +##################################################################################################################### +############################ Calculate presence absence table from observation data ################################# +##################################################################################################################### +##################################################################################################################### + +###################### Packages +suppressMessages(library(tidyr)) + +###################### Load arguments and declaring variables + +args <- commandArgs(trailingOnly = TRUE) + + +if (length(args) < 2) { + 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" + source(args[2]) ###### 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 presence/absence table ## Function : calc_pres_abs_f #################### +#################################################################################################### + +calc_pres_abs_f <- function(d_ata, + nb_name = "number") { + ## Purpose: Compute presence absence + ## ---------------------------------------------------------------------- + ## Arguments: d_ata : temporary metrics table + ## nb_name : name of abundance column + ## + ## Output: presence absence vector + ## ---------------------------------------------------------------------- + ## Author: Yves Reecht, Date: 20 déc. 2011, 12:04 modified by Coline ROYAUX 04 june 2020 + + ## Presence - absence : + pres_abs <- integer(nrow(d_ata)) + pres_abs[d_ata[, nb_name] > 0] <- as.integer(1) + pres_abs[d_ata[, nb_name] == 0] <- as.integer(0) + + return(pres_abs) +} + + +################# Analysis + +res <- calc_numbers_f(obs, obs_type = obs_type, factors = factors, nb_name = "number") +res$presence_absence <- calc_pres_abs_f(res, nb_name = "number") +res <- create_year_location(res) + +#Save dataframe in a tabular format +filename_pres_abs <- "TabPresAbs.tabular" +write.table(res, filename_pres_abs, row.names = FALSE, sep = "\t", dec = ".", fileEncoding = "UTF-8") +cat(paste("\nWrite table with presence/absence. \n--> \"", filename_pres_abs, "\"\n", sep = "")) |
| b |
| diff -r f1bfdeb5ebfe -r 8d8aec182fb1 FunctPAMPAGalaxy.r --- a/FunctPAMPAGalaxy.r Mon Jul 27 09:46:51 2020 -0400 +++ b/FunctPAMPAGalaxy.r Mon Nov 16 11:02:09 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 f1bfdeb5ebfe -r 8d8aec182fb1 pampa_macros.xml --- a/pampa_macros.xml Mon Jul 27 09:46:51 2020 -0400 +++ b/pampa_macros.xml Mon Nov 16 11:02:09 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 f1bfdeb5ebfe -r 8d8aec182fb1 test-data/Presence_absence_table_sansszcl_cropped.tabular --- a/test-data/Presence_absence_table_sansszcl_cropped.tabular Mon Jul 27 09:46:51 2020 -0400 +++ b/test-data/Presence_absence_table_sansszcl_cropped.tabular Mon Nov 16 11:02:09 2020 +0000 |
| b |
| @@ -1,4 +1,4 @@ -"point" "year" "species.code" "number" "number.max" "number.sd" "pres.abs" "observation.unit" +"location" "year" "species.code" "number" "number.max" "number.sd" "presence_absence" "observation.unit" "AB_0008" "08" "Abalstel" 0 0 0 0 "AB080008" "AB_0015" "08" "Abalstel" 0 0 0 0 "AB080015" "AB_0027" "08" "Abalstel" 0 0 0 0 "AB080027" |