diff purityX.R @ 8:94a2b6571758 draft

planemo upload for repository https://github.com/computational-metabolomics/mspurity-galaxy commit 7e1748612a9f9dce11a9e54ff36752b600e7aea3

--- a/purityX.R	Tue Feb 08 13:58:36 2022 +0000
+++ b/purityX.R	Wed Jun 12 16:06:42 2024 +0000
@@ -22,7 +22,7 @@
   make_option("--galaxy_files", type = "character"),
   make_option("--choose_class", type = "character"),
   make_option("--ignore_files", type = "character"),
-  make_option("--rtraw_columns",  action = "store_true")
+  make_option("--rtraw_columns", action = "store_true")
 )
 
 
@@ -31,9 +31,9 @@
 
 
 if (!is.null(opt$xgroups)) {
-    xgroups <- as.numeric(strsplit(opt$xgroups, ",")[[1]])
-}else{
-    xgroups <- NULL
+  xgroups <- as.numeric(strsplit(opt$xgroups, ",")[[1]])
+} else {
+  xgroups <- NULL
 }
 
 
@@ -44,55 +44,75 @@
 }
 
 if (is.null(opt$isotope_matrix)) {
-    im <- NULL
-}else{
-    im <- read.table(opt$isotope_matrix,
-                     header = TRUE, sep = "\t", stringsAsFactors = FALSE)
+  im <- NULL
+} else {
+  im <- read.table(opt$isotope_matrix,
+    header = TRUE, sep = "\t", stringsAsFactors = FALSE
+  )
 }
 
 if (is.null(opt$exclude_isotopes)) {
-    isotopes <- FALSE
-}else{
-    isotopes <- TRUE
+  isotopes <- FALSE
+} else {
+  isotopes <- TRUE
 }
 
 if (is.null(opt$rtraw_columns)) {
-    rtraw_columns <- FALSE
-}else{
-    rtraw_columns <- TRUE
+  rtraw_columns <- FALSE
+} else {
+  rtraw_columns <- TRUE
 }
 
 loadRData <- function(rdata_path, xset_name) {
-#loads an RData file, and returns the named xset object if it is there
-    load(rdata_path)
-    return(get(ls()[ls() == xset_name]))
+  # loads an RData file, and returns the named xset object if it is there
+  load(rdata_path)
+  return(get(ls()[ls() == xset_name]))
+}
+
+
+
+
+getxcmsSetObject <- function(xobject) {
+  # XCMS 1.x
+  if (class(xobject) == "xcmsSet") {
+    return(xobject)
+  }
+  # XCMS 3.x
+  if (class(xobject) == "XCMSnExp") {
+    # Get the legacy xcmsSet object
+    suppressWarnings(xset <- as(xobject, "xcmsSet"))
+    sampclass(xset) <- xset@phenoData$sample_group
+    return(xset)
+  }
 }
 
 target_obj <- loadRData(opt$xset_path, opt$rdata_name)
 
 if (opt$camera_xcms == "camera") {
-    xset <- target_obj@xcmsSet
-}else{
-    xset <- target_obj
+  xset <- target_obj@xcmsSet
+} else {
+  xset <- target_obj
 }
 
+xset <- getxcmsSetObject(xset)
+
 print(xset)
 
 minOffset <- as.numeric(opt$minOffset)
 maxOffset <- as.numeric(opt$maxOffset)
 
 if (opt$iwNorm == "none") {
-    iwNorm <- FALSE
-    iwNormFun <- NULL
-}else if (opt$iwNorm == "gauss") {
-    iwNorm <- TRUE
-    iwNormFun <- msPurity::iwNormGauss(minOff = -minOffset, maxOff = maxOffset)
-}else if (opt$iwNorm == "rcosine") {
-    iwNorm <- TRUE
-    iwNormFun <- msPurity::iwNormRcosine(minOff = -minOffset, maxOff = maxOffset)
-}else if (opt$iwNorm == "QE5") {
-    iwNorm <- TRUE
-    iwNormFun <- msPurity::iwNormQE.5()
+  iwNorm <- FALSE
+  iwNormFun <- NULL
+} else if (opt$iwNorm == "gauss") {
+  iwNorm <- TRUE
+  iwNormFun <- msPurity::iwNormGauss(minOff = -minOffset, maxOff = maxOffset)
+} else if (opt$iwNorm == "rcosine") {
+  iwNorm <- TRUE
+  iwNormFun <- msPurity::iwNormRcosine(minOff = -minOffset, maxOff = maxOffset)
+} else if (opt$iwNorm == "QE5") {
+  iwNorm <- TRUE
+  iwNormFun <- msPurity::iwNormQE.5()
 }
 
 print(xset@filepaths)
@@ -105,13 +125,13 @@
   original_filenames <- basename(xset@filepaths)
   update_idx <- match(updated_filenames, original_filenames)
 
-    if (!is.null(opt$galaxy_files)) {
-        galaxy_files <- trimws(strsplit(opt$galaxy_files, ",")[[1]])
-        galaxy_files <- galaxy_files[galaxy_files != ""]
-        xset@filepaths <- galaxy_files[update_idx]
-    }else{
-        xset@filepaths <- updated_filepaths[update_idx]
-    }
+  if (!is.null(opt$galaxy_files)) {
+    galaxy_files <- trimws(strsplit(opt$galaxy_files, ",")[[1]])
+    galaxy_files <- galaxy_files[galaxy_files != ""]
+    xset@filepaths <- galaxy_files[update_idx]
+  } else {
+    xset@filepaths <- updated_filepaths[update_idx]
+  }
 }
 
 if (!is.null(opt$choose_class)) {
@@ -121,7 +141,7 @@
 
   print("choose class")
   print(ignore_files_class)
-}else{
+} else {
   ignore_files_class <- NA
 }
 
@@ -132,37 +152,40 @@
 
   ignore_files <- unique(c(ignore_files, ignore_files_class))
   ignore_files <- ignore_files[ignore_files != ""]
-}else{
+} else {
   if (anyNA(ignore_files_class)) {
     ignore_files <- NULL
-  }else{
+  } else {
     ignore_files <- ignore_files_class
   }
-
 }
 
 print("ignore_files")
 print(ignore_files)
 
 
-ppLCMS <- msPurity::purityX(xset = xset,
-                            offsets = c(minOffset, maxOffset),
-                            cores = opt$cores,
-                            xgroups = xgroups,
-                            purityType = opt$purityType,
-                            ilim = opt$ilim,
-                            isotopes = isotopes,
-                            im = im,
-                            iwNorm = iwNorm,
-                            iwNormFun = iwNormFun,
-                            singleFile = opt$singleFile,
-                            fileignore = ignore_files,
-                            rtrawColumns = rtraw_columns)
+ppLCMS <- msPurity::purityX(
+  xset = xset,
+  offsets = c(minOffset, maxOffset),
+  cores = opt$cores,
+  xgroups = xgroups,
+  purityType = opt$purityType,
+  ilim = opt$ilim,
+  isotopes = isotopes,
+  im = im,
+  iwNorm = iwNorm,
+  iwNormFun = iwNormFun,
+  singleFile = opt$singleFile,
+  fileignore = ignore_files,
+  rtrawColumns = rtraw_columns
+)
 
 dfp <- ppLCMS@predictions
 
 # to make compatable with deconrank
-colnames(dfp)[colnames(dfp) == "grpid"] <- "peakID"
+# (keep grpid for other compatibility)
+dfp <- data.frame("peakID"=dfp$grpid, dfp)
+
 colnames(dfp)[colnames(dfp) == "median"] <- "medianPurity"
 colnames(dfp)[colnames(dfp) == "mean"] <- "meanPurity"
 colnames(dfp)[colnames(dfp) == "sd"] <- "sdPurity"