Repository 'pampa_presabs'
hg clone https://toolshed.g2.bx.psu.edu/repos/ecology/pampa_presabs

Changeset 3:8d8aec182fb1 (2020-11-16)
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&lt;designation&gt;.+)\.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"