# HG changeset patch # User workflow4metabolomics # Date 1738594126 0 # Node ID 1ae878634ab346f25450c1af2b82b9ac285b2501 # Parent 444e3ed135e3930b7f6fabb0e414ed6449c8b84b planemo upload for repository https://github.com/workflow4metabolomics/tools-metabolomics/ commit 95721ced8347c09e79340e6d67ecb41c5cc64163 diff -r 444e3ed135e3 -r 1ae878634ab3 abims_xcms_summary.xml --- a/abims_xcms_summary.xml Mon Jul 15 16:02:39 2024 +0000 +++ b/abims_xcms_summary.xml Mon Feb 03 14:48:46 2025 +0000 @@ -12,11 +12,14 @@ bioconductor-camera r-batch - + + + + 1) { - names(group_colors) <- unique(xdata$sample_group) - plotAdjustedRtime(xdata, col = group_colors[xdata$sample_group]) - legend("topright", legend = names(group_colors), col = group_colors, cex = 0.8, lty = 1) - } + # Color by group + if (length(unique(xdata$sample_group)) < 10) { + group_colors <- brewer.pal(length(unique(xdata$sample_group)), "Set1") + } else { + group_colors <- hcl.colors(length(unique(xdata$sample_group)), palette = "Dark 3") + } + if (length(group_colors) > 1) { + names(group_colors) <- unique(xdata$sample_group) + plotAdjustedRtime(xdata, col = group_colors[xdata$sample_group]) + legend("topright", legend = names(group_colors), col = group_colors, cex = 0.8, lty = 1) + } - # Color by sample - plotAdjustedRtime(xdata, col = rainbow(length(xdata@phenoData@data$sample_name))) - legend("topright", legend = xdata@phenoData@data$sample_name, col = rainbow(length(xdata@phenoData@data$sample_name)), cex = 0.8, lty = 1) + # Color by sample + plotAdjustedRtime(xdata, col = rainbow(length(xdata@phenoData@data$sample_name))) + legend("topright", legend = xdata@phenoData@data$sample_name, col = rainbow(length(xdata@phenoData@data$sample_name)), cex = 0.8, lty = 1) - dev.off() + dev.off() } -#@author G. Le Corguille +# @author G. Le Corguille # value: intensity values to be used into, maxo or intb getPeaklistW4M <- function(xdata, intval = "into", convertRTMinute = FALSE, numDigitsMZ = 4, numDigitsRT = 0, naTOzero = TRUE, variableMetadataOutput, dataMatrixOutput, sampleNamesList) { - dataMatrix <- featureValues(xdata, method = "medret", value = intval) - colnames(dataMatrix) <- make.names(tools::file_path_sans_ext(colnames(dataMatrix))) - dataMatrix <- cbind(name = groupnames(xdata), dataMatrix) - variableMetadata <- featureDefinitions(xdata) - colnames(variableMetadata)[1] <- "mz" - colnames(variableMetadata)[4] <- "rt" - variableMetadata <- data.frame(name = groupnames(xdata), variableMetadata) + dataMatrix <- featureValues(xdata, method = "medret", value = intval) + colnames(dataMatrix) <- make.names(tools::file_path_sans_ext(colnames(dataMatrix))) + dataMatrix <- cbind(name = groupnames(xdata), dataMatrix) + variableMetadata <- featureDefinitions(xdata) + colnames(variableMetadata)[1] <- "mz" + colnames(variableMetadata)[4] <- "rt" + variableMetadata <- data.frame(name = groupnames(xdata), variableMetadata) - variableMetadata <- RTSecondToMinute(variableMetadata, convertRTMinute) - variableMetadata <- formatIonIdentifiers(variableMetadata, numDigitsRT = numDigitsRT, numDigitsMZ = numDigitsMZ) - dataMatrix <- naTOzeroDataMatrix(dataMatrix, naTOzero) + variableMetadata <- RTSecondToMinute(variableMetadata, convertRTMinute) + variableMetadata <- formatIonIdentifiers(variableMetadata, numDigitsRT = numDigitsRT, numDigitsMZ = numDigitsMZ) + dataMatrix <- naTOzeroDataMatrix(dataMatrix, naTOzero) - # FIX: issue when the vector at peakidx is too long and is written in a new line during the export - variableMetadata[, "peakidx"] <- vapply(variableMetadata[, "peakidx"], FUN = paste, FUN.VALUE = character(1), collapse = ",") + # FIX: issue when the vector at peakidx is too long and is written in a new line during the export + variableMetadata[, "peakidx"] <- vapply(variableMetadata[, "peakidx"], FUN = paste, FUN.VALUE = character(1), collapse = ",") - write.table(variableMetadata, file = variableMetadataOutput, sep = "\t", quote = FALSE, row.names = FALSE) - write.table(dataMatrix, file = dataMatrixOutput, sep = "\t", quote = FALSE, row.names = FALSE) - + write.table(variableMetadata, file = variableMetadataOutput, sep = "\t", quote = FALSE, row.names = FALSE) + write.table(dataMatrix, file = dataMatrixOutput, sep = "\t", quote = FALSE, row.names = FALSE) } -#@author G. Le Corguille +# @author G. Le Corguille # It allow different of field separators getDataFrameFromFile <- function(filename, header = TRUE) { - myDataFrame <- read.table(filename, header = header, sep = ";", stringsAsFactors = FALSE) - if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header = header, sep = "\t", stringsAsFactors = FALSE) - if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header = header, sep = ",", stringsAsFactors = FALSE) - if (ncol(myDataFrame) < 2) { - error_message <- "Your tabular file seems not well formatted. The column separators accepted are ; , and tabulation" - print(error_message) - stop(error_message) - } - return(myDataFrame) + myDataFrame <- read.table(filename, header = header, sep = ";", stringsAsFactors = FALSE) + if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header = header, sep = "\t", stringsAsFactors = FALSE) + if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header = header, sep = ",", stringsAsFactors = FALSE) + if (ncol(myDataFrame) < 2) { + error_message <- "Your tabular file seems not well formatted. The column separators accepted are ; , and tabulation" + print(error_message) + stop(error_message) + } + return(myDataFrame) } -#@author G. Le Corguille +# @author G. Le Corguille # Draw the BPI and TIC graphics # colored by sample names or class names getPlotChromatogram <- function(chrom, xdata, pdfname = "Chromatogram.pdf", aggregationFun = "max") { - - if (aggregationFun == "sum") - type <- "Total Ion Chromatograms" - else - type <- "Base Peak Intensity Chromatograms" + if (aggregationFun == "sum") { + type <- "Total Ion Chromatograms" + } else { + type <- "Base Peak Intensity Chromatograms" + } - adjusted <- "Raw" - if (hasAdjustedRtime(xdata)) - adjusted <- "Adjusted" + adjusted <- "Raw" + if (hasAdjustedRtime(xdata)) { + adjusted <- "Adjusted" + } - main <- paste(type, ":", adjusted, "data") + main <- paste(type, ":", adjusted, "data") - pdf(pdfname, width = 16, height = 10) + pdf(pdfname, width = 16, height = 10) - # Color by group - if (length(unique(xdata$sample_group)) < 10) { - group_colors <- brewer.pal(length(unique(xdata$sample_group)), "Set1") - } else { - group_colors <- hcl.colors(length(unique(xdata$sample_group)), palette = "Dark 3") - } - if (length(group_colors) > 1) { - names(group_colors) <- unique(xdata$sample_group) - plot(chrom, col = group_colors[chrom$sample_group], main = main, peakType = "none") - legend("topright", legend = names(group_colors), col = group_colors, cex = 0.8, lty = 1) - } + # Color by group + if (length(unique(xdata$sample_group)) < 10) { + group_colors <- brewer.pal(length(unique(xdata$sample_group)), "Set1") + } else { + group_colors <- hcl.colors(length(unique(xdata$sample_group)), palette = "Dark 3") + } + if (length(group_colors) > 1) { + names(group_colors) <- unique(xdata$sample_group) + plot(chrom, col = group_colors[chrom$sample_group], main = main, peakType = "none") + legend("topright", legend = names(group_colors), col = group_colors, cex = 0.8, lty = 1) + } - # Color by sample - plot(chrom, col = rainbow(length(xdata@phenoData@data$sample_name)), main = main, peakType = "none") - legend("topright", legend = xdata@phenoData@data$sample_name, col = rainbow(length(xdata@phenoData@data$sample_name)), cex = 0.8, lty = 1) + # Color by sample + plot(chrom, col = rainbow(length(xdata@phenoData@data$sample_name)), main = main, peakType = "none") + legend("topright", legend = xdata@phenoData@data$sample_name, col = rainbow(length(xdata@phenoData@data$sample_name)), cex = 0.8, lty = 1) - dev.off() + dev.off() } # Get the polarities from all the samples of a condition -#@author Misharl Monsoor misharl.monsoor@sb-roscoff.fr ABiMS TEAM -#@author Gildas Le Corguille lecorguille@sb-roscoff.fr ABiMS TEAM +# @author Misharl Monsoor misharl.monsoor@sb-roscoff.fr ABiMS TEAM +# @author Gildas Le Corguille lecorguille@sb-roscoff.fr ABiMS TEAM getSampleMetadata <- function(xdata = NULL, sampleMetadataOutput = "sampleMetadata.tsv") { - cat("Creating the sampleMetadata file...\n") + cat("Creating the sampleMetadata file...\n") - #Create the sampleMetada dataframe - sampleMetadata <- xdata@phenoData@data - rownames(sampleMetadata) <- NULL - colnames(sampleMetadata) <- c("sample_name", "class") + # Create the sampleMetada dataframe + sampleMetadata <- xdata@phenoData@data + rownames(sampleMetadata) <- NULL + colnames(sampleMetadata) <- c("sample_name", "class") - sampleNamesOrigin <- sampleMetadata$sample_name - sampleNamesMakeNames <- make.names(sampleNamesOrigin) + sampleNamesOrigin <- sampleMetadata$sample_name + sampleNamesMakeNames <- make.names(sampleNamesOrigin) - if (any(duplicated(sampleNamesMakeNames))) { - write("\n\nERROR: Usually, R has trouble to deal with special characters in its column names, so it rename them using make.names().\nIn your case, at least two columns after the renaming obtain the same name, thus XCMS will collapse those columns per name.", stderr()) - for (sampleName in sampleNamesOrigin) { - write(paste(sampleName, "\t->\t", make.names(sampleName)), stderr()) + if (any(duplicated(sampleNamesMakeNames))) { + write("\n\nERROR: Usually, R has trouble to deal with special characters in its column names, so it rename them using make.names().\nIn your case, at least two columns after the renaming obtain the same name, thus XCMS will collapse those columns per name.", stderr()) + for (sampleName in sampleNamesOrigin) { + write(paste(sampleName, "\t->\t", make.names(sampleName)), stderr()) + } + stop("\n\nERROR: One or more of your files will not be import by xcmsSet. It may due to bad characters in their filenames.") } - stop("\n\nERROR: One or more of your files will not be import by xcmsSet. It may due to bad characters in their filenames.") - } - if (!all(sampleNamesOrigin == sampleNamesMakeNames)) { - cat("\n\nWARNING: Usually, R has trouble to deal with special characters in its column names, so it rename them using make.names()\nIn your case, one or more sample names will be renamed in the sampleMetadata and dataMatrix files:\n") - for (sampleName in sampleNamesOrigin) { - cat(paste(sampleName, "\t->\t", make.names(sampleName), "\n")) + if (!all(sampleNamesOrigin == sampleNamesMakeNames)) { + cat("\n\nWARNING: Usually, R has trouble to deal with special characters in its column names, so it rename them using make.names()\nIn your case, one or more sample names will be renamed in the sampleMetadata and dataMatrix files:\n") + for (sampleName in sampleNamesOrigin) { + cat(paste(sampleName, "\t->\t", make.names(sampleName), "\n")) + } } - } - sampleMetadata$sample_name <- sampleNamesMakeNames + sampleMetadata$sample_name <- sampleNamesMakeNames - #For each sample file, the following actions are done - for (fileIdx in seq_len(length(fileNames(xdata)))) { - #Check if the file is in the CDF format - if (!mzR:::netCDFIsFile(fileNames(xdata))) { - - # If the column isn't exist, with add one filled with NA - if (is.null(sampleMetadata$polarity)) sampleMetadata$polarity <- NA + # For each sample file, the following actions are done + for (fileIdx in seq_len(length(fileNames(xdata)))) { + # Check if the file is in the CDF format + if (!mzR:::netCDFIsFile(fileNames(xdata))) { + # If the column isn't exist, with add one filled with NA + if (is.null(sampleMetadata$polarity)) sampleMetadata$polarity <- NA - #Extract the polarity (a list of polarities) - polarity <- fData(xdata)[fData(xdata)$fileIdx == fileIdx, "polarity"] - #Verify if all the scans have the same polarity - uniq_list <- unique(polarity) - if (length(uniq_list) > 1) { - polarity <- "mixed" - } else { - polarity <- as.character(uniq_list) - } + # Extract the polarity (a list of polarities) + polarity <- fData(xdata)[fData(xdata)$fileIdx == fileIdx, "polarity"] + # Verify if all the scans have the same polarity + uniq_list <- unique(polarity) + if (length(uniq_list) > 1) { + polarity <- "mixed" + } else { + polarity <- as.character(uniq_list) + } - #Set the polarity attribute - sampleMetadata$polarity[fileIdx] <- polarity + # Set the polarity attribute + sampleMetadata$polarity[fileIdx] <- polarity + } } - } + write.table(sampleMetadata, sep = "\t", quote = FALSE, row.names = FALSE, file = sampleMetadataOutput) - write.table(sampleMetadata, sep = "\t", quote = FALSE, row.names = FALSE, file = sampleMetadataOutput) - - return(list("sampleNamesOrigin" = sampleNamesOrigin, "sampleNamesMakeNames" = sampleNamesMakeNames)) - + return(list("sampleNamesOrigin" = sampleNamesOrigin, "sampleNamesMakeNames" = sampleNamesMakeNames)) } # This function will compute MD5 checksum to check the data integrity -#@author Gildas Le Corguille lecorguille@sb-roscoff.fr +# @author Gildas Le Corguille lecorguille@sb-roscoff.fr getMd5sum <- function(files) { - cat("Compute md5 checksum...\n") - library(tools) - return(as.matrix(md5sum(files))) + cat("Compute md5 checksum...\n") + library(tools) + return(as.matrix(md5sum(files))) } # This function retrieve the raw file in the working directory # - if zipfile: unzip the file with its directory tree # - if singlefiles: set symlink with the good filename -#@author Gildas Le Corguille lecorguille@sb-roscoff.fr +# @author Gildas Le Corguille lecorguille@sb-roscoff.fr retrieveRawfileInTheWorkingDir <- function(singlefile, zipfile, args, prefix = "") { - - if (!(prefix %in% c("", "Positive", "Negative", "MS1", "MS2"))) stop("prefix must be either '', 'Positive', 'Negative', 'MS1' or 'MS2'") + if (!(prefix %in% c("", "Positive", "Negative", "MS1", "MS2"))) stop("prefix must be either '', 'Positive', 'Negative', 'MS1' or 'MS2'") - # single - if the file are passed in the command arguments -> refresh singlefile - if (!is.null(args[[paste0("singlefile_galaxyPath", prefix)]])) { - singlefile_galaxyPaths <- unlist(strsplit(args[[paste0("singlefile_galaxyPath", prefix)]], "\\|")) - singlefile_sampleNames <- unlist(strsplit(args[[paste0("singlefile_sampleName", prefix)]], "\\|")) + # single - if the file are passed in the command arguments -> refresh singlefile + if (!is.null(args[[paste0("singlefile_galaxyPath", prefix)]])) { + singlefile_galaxyPaths <- unlist(strsplit(args[[paste0("singlefile_galaxyPath", prefix)]], "\\|")) + singlefile_sampleNames <- unlist(strsplit(args[[paste0("singlefile_sampleName", prefix)]], "\\|")) - singlefile <- NULL - for (singlefile_galaxyPath_i in seq_len(length(singlefile_galaxyPaths))) { - singlefile_galaxyPath <- singlefile_galaxyPaths[singlefile_galaxyPath_i] - singlefile_sampleName <- singlefile_sampleNames[singlefile_galaxyPath_i] - # In case, an url is used to import data within Galaxy - singlefile_sampleName <- tail(unlist(strsplit(singlefile_sampleName, "/")), n = 1) - singlefile[[singlefile_sampleName]] <- singlefile_galaxyPath + singlefile <- NULL + for (singlefile_galaxyPath_i in seq_len(length(singlefile_galaxyPaths))) { + singlefile_galaxyPath <- singlefile_galaxyPaths[singlefile_galaxyPath_i] + singlefile_sampleName <- singlefile_sampleNames[singlefile_galaxyPath_i] + # In case, an url is used to import data within Galaxy + singlefile_sampleName <- tail(unlist(strsplit(singlefile_sampleName, "/")), n = 1) + singlefile[[singlefile_sampleName]] <- singlefile_galaxyPath + } } - } - # zipfile - if the file are passed in the command arguments -> refresh zipfile - if (!is.null(args[[paste0("zipfile", prefix)]])) - zipfile <- args[[paste0("zipfile", prefix)]] + # zipfile - if the file are passed in the command arguments -> refresh zipfile + if (!is.null(args[[paste0("zipfile", prefix)]])) { + zipfile <- args[[paste0("zipfile", prefix)]] + } - # single - if (!is.null(singlefile) && (length("singlefile") > 0)) { - files <- vector() - for (singlefile_sampleName in names(singlefile)) { - singlefile_galaxyPath <- singlefile[[singlefile_sampleName]] - if (!file.exists(singlefile_galaxyPath)) { - error_message <- paste("Cannot access the sample:", singlefile_sampleName, "located:", singlefile_galaxyPath, ". Please, contact your administrator ... if you have one!") - print(error_message) - stop(error_message) - } + # single + if (!is.null(singlefile) && (length("singlefile") > 0)) { + files <- vector() + for (singlefile_sampleName in names(singlefile)) { + singlefile_galaxyPath <- singlefile[[singlefile_sampleName]] + if (!file.exists(singlefile_galaxyPath)) { + error_message <- paste("Cannot access the sample:", singlefile_sampleName, "located:", singlefile_galaxyPath, ". Please, contact your administrator ... if you have one!") + print(error_message) + stop(error_message) + } - if (!suppressWarnings(try(file.link(singlefile_galaxyPath, singlefile_sampleName), silent = TRUE))) - file.copy(singlefile_galaxyPath, singlefile_sampleName) - files <- c(files, singlefile_sampleName) + if (!suppressWarnings(try(file.link(singlefile_galaxyPath, singlefile_sampleName), silent = TRUE))) { + file.copy(singlefile_galaxyPath, singlefile_sampleName) + } + files <- c(files, singlefile_sampleName) + } } - } - # zipfile - if (!is.null(zipfile) && (zipfile != "")) { - if (!file.exists(zipfile)) { - error_message <- paste("Cannot access the Zip file:", zipfile, ". Please, contact your administrator ... if you have one!") - print(error_message) - stop(error_message) - } - suppressWarnings(unzip(zipfile, unzip = "unzip")) + # zipfile + if (!is.null(zipfile) && (zipfile != "")) { + if (!file.exists(zipfile)) { + error_message <- paste("Cannot access the Zip file:", zipfile, ". Please, contact your administrator ... if you have one!") + print(error_message) + stop(error_message) + } + suppressWarnings(unzip(zipfile, unzip = "unzip")) - #get the directory name - suppressWarnings(filesInZip <- unzip(zipfile, list = TRUE)) - directories <- unique(unlist(lapply(strsplit(filesInZip$Name, "/"), function(x) x[1]))) - directories <- directories[!(directories %in% c("__MACOSX")) & file.info(directories)$isdir] - directory <- "." - if (length(directories) == 1) directory <- directories + # get the directory name + suppressWarnings(filesInZip <- unzip(zipfile, list = TRUE)) + directories <- unique(unlist(lapply(strsplit(filesInZip$Name, "/"), function(x) x[1]))) + directories <- directories[!(directories %in% c("__MACOSX")) & file.info(directories)$isdir] + directory <- "." + if (length(directories) == 1) directory <- directories - cat("files_root_directory\t", directory, "\n") + cat("files_root_directory\t", directory, "\n") - filepattern <- c("[Cc][Dd][Ff]", "[Nn][Cc]", "([Mm][Zz])?[Xx][Mm][Ll]", "[Mm][Zz][Dd][Aa][Tt][Aa]", "[Mm][Zz][Mm][Ll]") - filepattern <- paste(paste("\\.", filepattern, "$", sep = ""), collapse = "|") - info <- file.info(directory) - listed <- list.files(directory[info$isdir], pattern = filepattern, recursive = TRUE, full.names = TRUE) - files <- c(directory[!info$isdir], listed) - exists <- file.exists(files) - files <- files[exists] - - } - return(list(zipfile = zipfile, singlefile = singlefile, files = files)) + filepattern <- c("[Cc][Dd][Ff]", "[Nn][Cc]", "([Mm][Zz])?[Xx][Mm][Ll]", "[Mm][Zz][Dd][Aa][Tt][Aa]", "[Mm][Zz][Mm][Ll]") + filepattern <- paste(paste("\\.", filepattern, "$", sep = ""), collapse = "|") + info <- file.info(directory) + listed <- list.files(directory[info$isdir], pattern = filepattern, recursive = TRUE, full.names = TRUE) + files <- c(directory[!info$isdir], listed) + exists <- file.exists(files) + files <- files[exists] + } + return(list(zipfile = zipfile, singlefile = singlefile, files = files)) } # This function retrieve a xset like object -#@author Gildas Le Corguille lecorguille@sb-roscoff.fr +# @author Gildas Le Corguille lecorguille@sb-roscoff.fr 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")) - if (!is.null(xset@phenoData$sample_group)) - sampclass(xset) <- xset@phenoData$sample_group - else - sampclass(xset) <- "." - return(xset) - } + # 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")) + if (!is.null(xset@phenoData$sample_group)) { + sampclass(xset) <- xset@phenoData$sample_group + } else { + sampclass(xset) <- "." + } + return(xset) + } } diff -r 444e3ed135e3 -r 1ae878634ab3 macros_xcms.xml --- a/macros_xcms.xml Mon Jul 15 16:02:39 2024 +0000 +++ b/macros_xcms.xml Mon Feb 03 14:48:46 2025 +0000 @@ -2,7 +2,7 @@ 3.12.0 - 1 + 3 21.09 diff -r 444e3ed135e3 -r 1ae878634ab3 xcms_summary.r --- a/xcms_summary.r Mon Jul 15 16:02:39 2024 +0000 +++ b/xcms_summary.r Mon Feb 03 14:48:46 2025 +0000 @@ -3,20 +3,20 @@ # ----- ARGUMENTS BLACKLIST ----- -#xcms.r +# xcms.r argBlacklist <- c("zipfile", "singlefile_galaxyPath", "singlefile_sampleName", "xfunction", "xsetRdataOutput", "sampleMetadataOutput", "ticspdf", "bicspdf", "rplotspdf") -#CAMERA.r +# CAMERA.r argBlacklist <- c(argBlacklist, "dataMatrixOutput", "variableMetadataOutput", "new_file_path") # ----- PACKAGE ----- cat("\tSESSION INFO\n") -#Import the different functions +# Import the different functions source_local <- function(fname) { - argv <- commandArgs(trailingOnly = FALSE) - base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)) - source(paste(base_dir, fname, sep = "/")) + argv <- commandArgs(trailingOnly = FALSE) + base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)) + source(paste(base_dir, fname, sep = "/")) } source_local("lib.r") @@ -27,43 +27,47 @@ # ----- FUNCTION ----- writehtml <- function(...) { - cat(..., "\n", file = htmlOutput, append = TRUE, sep = "") + cat(..., "\n", file = htmlOutput, append = TRUE, sep = "") } writeraw <- function(htmlOutput, object, open = "at") { - log_file <- file(htmlOutput, open = open) - sink(log_file) - sink(log_file, type = "output") - print(object) - sink() - close(log_file) + log_file <- file(htmlOutput, open = open) + sink(log_file) + sink(log_file, type = "output") + print(object) + sink() + close(log_file) } getSampleNames <- function(xobject) { - if (class(xobject) == "xcmsSet") - return(sampnames(xobject)) - if (class(xobject) == "XCMSnExp") - return(xobject@phenoData@data$sample_name) + if (class(xobject) == "xcmsSet") { + return(sampnames(xobject)) + } + if (class(xobject) == "XCMSnExp") { + return(xobject@phenoData@data$sample_name) + } } getFilePaths <- function(xobject) { - if (class(xobject) == "xcmsSet") - return(xobject@filepaths) - if (class(xobject) == "XCMSnExp") - return(fileNames(xobject)) + if (class(xobject) == "xcmsSet") { + return(xobject@filepaths) + } + if (class(xobject) == "XCMSnExp") { + return(fileNames(xobject)) + } } equalParams <- function(param1, param2) { - writeraw("param1.txt", param1, open = "wt") - writeraw("param2.txt", param2, open = "wt") - return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt")) + writeraw("param1.txt", param1, open = "wt") + writeraw("param2.txt", param2, open = "wt") + return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt")) } # ----- ARGUMENTS ----- -args <- parseCommandArgs(evaluate = FALSE) #interpretation of arguments given in command line as an R list of objects +args <- parseCommandArgs(evaluate = FALSE) # interpretation of arguments given in command line as an R list of objects # ----- ARGUMENTS PROCESSING ----- -#image is an .RData file necessary to use xset variable given by previous tools +# image is an .RData file necessary to use xset variable given by previous tools load(args$image) htmlOutput <- "summary.html" @@ -74,19 +78,19 @@ # if the RData come from XCMS 1.x if (exists("xset")) { - xobject <- xset - # retrocompatability - if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject))) + xobject <- xset + # retrocompatability + if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject))) } # if the RData come from CAMERA if (exists("xa")) { - xobject <- xa@xcmsSet - if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name)) + xobject <- xa@xcmsSet + if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name)) } # if the RData come from XCMS 3.x if (exists("xdata")) { - xobject <- xdata - if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name)) + xobject <- xdata + if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name)) } if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.") @@ -114,33 +118,33 @@ writehtml("

___ XCMS analysis summary using Workflow4Metabolomics ___

") # to pass the planemo shed_test if (user_email != "test@bx.psu.edu") { - if (!is.null(user_email)) writehtml("By: ", user_email, " - ") - writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S")) + if (!is.null(user_email)) writehtml("By: ", user_email, " - ") + writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S")) } writehtml("
") writehtml("

Samples used:

") writehtml("
") if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) { - sampleNameHeaderHtml <- paste0("") - sampleNameHtml <- paste0("") + sampleNameHeaderHtml <- paste0("") + sampleNameHtml <- paste0("") } else { - sampleNameHeaderHtml <- paste0("") - sampleNameHtml <- paste0("") + sampleNameHeaderHtml <- paste0("") + sampleNameHtml <- paste0("") } if (!exists("md5sumList")) { - md5sumHeaderHtml <- "" - md5sumHtml <- "" - md5sumLegend <- "" + md5sumHeaderHtml <- "" + md5sumHtml <- "" + md5sumLegend <- "" } else if (is.null(md5sumList$removalBadCharacters)) { - md5sumHeaderHtml <- paste0("") - md5sumHtml <- paste0("") - md5sumLegend <- "
*The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process." + md5sumHeaderHtml <- paste0("") + md5sumHtml <- paste0("") + md5sumLegend <- "
*The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process." } else { - md5sumHeaderHtml <- paste0("") - md5sumHtml <- paste0("") - md5sumLegend <- "
*The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process.
**Because some bad characters (eg: accent) were removed from your original file, the checksum have changed too.
" + md5sumHeaderHtml <- paste0("") + md5sumHtml <- paste0("") + md5sumLegend <- "
*The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process.
**Because some bad characters (eg: accent) were removed from your original file, the checksum have changed too.
" } writehtml("", sampleNameHeaderHtml, "", md5sumHeaderHtml, "") @@ -155,43 +159,44 @@ writehtml("") # XCMS 3.x if (class(xobject) == "XCMSnExp") { - xcmsFunction <- NULL - params <- NULL - for (processHistoryItem in processHistory(xobject)) { - if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem))) - next - timestamp <- processDate(processHistoryItem) - xcmsFunction <- processType(processHistoryItem) - params <- processParam(processHistoryItem) - writehtml("") - } + xcmsFunction <- NULL + params <- NULL + for (processHistoryItem in processHistory(xobject)) { + if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem))) { + next + } + timestamp <- processDate(processHistoryItem) + xcmsFunction <- processType(processHistoryItem) + params <- processParam(processHistoryItem) + writehtml("") + } } # CAMERA and retrocompatability XCMS 1.x if (exists("listOFlistArguments")) { - for (tool in names(listOFlistArguments)) { - listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)] + for (tool in names(listOFlistArguments)) { + listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)] - timestamp <- strsplit(tool, "_")[[1]][1] - xcmsFunction <- strsplit(tool, "_")[[1]][2] - writehtml("") - line_begin <- "" - for (arg in names(listOFlistArgumentsDisplay)) { - writehtml(line_begin, "") - line_begin <- "" + timestamp <- strsplit(tool, "_")[[1]][1] + xcmsFunction <- strsplit(tool, "_")[[1]][2] + writehtml("") + line_begin <- "" + for (arg in names(listOFlistArgumentsDisplay)) { + writehtml(line_begin, "") + line_begin <- "" + } } - } } writehtml("
sample", getSampleNames(xobject), "sample", getSampleNames(xobject), "samplesample renamed", getSampleNames(xobject), "", sampleNamesList$sampleNamesMakeNames, "samplesample renamed", getSampleNames(xobject), "", sampleNamesList$sampleNamesMakeNames, "md5sum*", md5sumList$origin, "md5sum*", md5sumList$origin, "md5sum*md5sum** after bad characters removal", md5sumList$origin, "", md5sumList$removalBadCharacters, "md5sum*md5sum** after bad characters removal", md5sumList$origin, "", md5sumList$removalBadCharacters, "
filename
timestamp***functionargumentvalue
", timestamp, "", xcmsFunction, "
")
-    writeraw(htmlOutput, params)
-    writehtml("
", timestamp, "", xcmsFunction, "
")
+        writeraw(htmlOutput, params)
+        writehtml("
", timestamp, "", xcmsFunction, "", arg, "", unlist(listOFlistArgumentsDisplay[arg][1]), "
", timestamp, "", xcmsFunction, "", arg, "", unlist(listOFlistArgumentsDisplay[arg][1]), "
") writehtml("
***timestamp format: DD MM dd hh:mm:ss YYYY or yymmdd-hh:mm:ss") writehtml("
") if (class(xobject) == "XCMSnExp") { - writehtml("

Informations about the XCMSnExp object:

") - writehtml("
")
-  writeraw(htmlOutput, xobject)
-  writehtml("
") + writehtml("

Informations about the XCMSnExp object:

") + writehtml("
")
+    writeraw(htmlOutput, xobject)
+    writehtml("
") } writehtml("

Informations about the xcmsSet object:

") @@ -204,10 +209,10 @@ # CAMERA if (exists("xa")) { - writehtml("

Informations about the CAMERA object:

") - writehtml("
") - writehtml("Number of pcgroup: ", length(xa@pspectra)) - writehtml("
") + writehtml("

Informations about the CAMERA object:

") + writehtml("
") + writehtml("Number of pcgroup: ", length(xa@pspectra)) + writehtml("
") } writehtml("

Citations:

")