comparison lib.r @ 34:d8bac1291473 draft

planemo upload for repository https://github.com/workflow4metabolomics/xcms commit f01148783819c37e474790dbd56619862960448a

33:ea611367e1da

    cat(sessioninfo$R.version$version.string,"\n")
    cat("Main packages:\n")
    for (pkg in names(sessioninfo$otherPkgs)) { cat(paste(pkg,packageVersion(pkg)),"\t") }; cat("\n")
    cat("Other loaded packages:\n")
    for (pkg in names(sessioninfo$loadedOnly)) { cat(paste(pkg,packageVersion(pkg)),"\t") }; cat("\n")
}

#@author G. Le Corguille
# This function convert if it is required the Retention Time in minutes
RTSecondToMinute <- function(variableMetadata, convertRTMinute) {

    pdf(file="raw_vs_adjusted_rt.pdf", width=16, height=12)

    # Color by group
    group_colors <- brewer.pal(3, "Set1")[1:length(unique(xdata$sample_group))]
    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)

    write.table(dataMatrix, file=dataMatrixOutput,sep="\t",quote=F,row.names=F)

}

#@author G. Le Corguille
getPlotChromatogram <- function(xdata, pdfname="Chromatogram.pdf", aggregationFun = "max") {

    chrom <- chromatogram(xdata, aggregationFun = aggregationFun)
    if (aggregationFun == "sum")
        type="Total Ion Chromatograms"

    pdf(pdfname, width=16, height=10)

    # Color by group
    group_colors <- brewer.pal(3, "Set1")[1:length(unique(xdata$sample_group))]
    names(group_colors) <- unique(xdata$sample_group)
    plot(chrom, col = group_colors[chrom$sample_group], main=main)
    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)
    legend("topright", legend=xdata@phenoData@data$sample_name, col=rainbow(length(xdata@phenoData@data$sample_name)), cex=0.8, lty=1)

            singlefile_galaxyPath <- singlefile_galaxyPaths[singlefile_galaxyPath_i]
            singlefile_sampleName <- singlefile_sampleNames[singlefile_galaxyPath_i]
            singlefile[[singlefile_sampleName]] <- singlefile_galaxyPath
        }
    }
    for (argument in c("zipfile","zipfilePositive","zipfileNegative","singlefile_galaxyPath","singlefile_sampleName","singlefile_galaxyPathPositive","singlefile_sampleNamePositive","singlefile_galaxyPathNegative","singlefile_sampleNameNegative")) {
        args[[argument]] <- NULL
    }
    return(list(zipfile=zipfile, singlefile=singlefile, args=args))
}


# This function retrieve the raw file in the working directory
#   - if zipfile: unzip the file with its directory tree

#@TODO: remove this function as soon as we can use xcms 3.x.x from Bioconductor 3.7
# https://github.com/sneumann/xcms/issues/247
c.XCMSnExp <- function(...) {
    .concatenate_XCMSnExp(...)
}

34:d8bac1291473

    cat(sessioninfo$R.version$version.string,"\n")
    cat("Main packages:\n")
    for (pkg in names(sessioninfo$otherPkgs)) { cat(paste(pkg,packageVersion(pkg)),"\t") }; cat("\n")
    cat("Other loaded packages:\n")
    for (pkg in names(sessioninfo$loadedOnly)) { cat(paste(pkg,packageVersion(pkg)),"\t") }; cat("\n")
}

#@author G. Le Corguille
# This function merge several xdata into one.
mergeXData <- function(args) {
    for(image in args$images) {
        load(image)
        # Handle infiles
        if (!exists("singlefile")) singlefile <- NULL
        if (!exists("zipfile")) zipfile <- NULL
        rawFilePath <- getRawfilePathFromArguments(singlefile, zipfile, args)
        zipfile <- rawFilePath$zipfile
        singlefile <- rawFilePath$singlefile
        retrieveRawfileInTheWorkingDirectory(singlefile, zipfile)
        if (exists("raw_data")) xdata <- raw_data
        if (!exists("xdata")) stop("\n\nERROR: The RData doesn't contain any object called 'xdata'. This RData should have been created by an old version of XMCS 2.*")
        cat(sampleNamesList$sampleNamesOrigin,"\n")
        if (!exists("xdata_merged")) {
            xdata_merged <- xdata
            singlefile_merged <- singlefile
            md5sumList_merged <- md5sumList
            sampleNamesList_merged <- sampleNamesList
        } else {
            if (is(xdata, "XCMSnExp")) xdata_merged <- c(xdata_merged,xdata)
            else if (is(xdata, "OnDiskMSnExp")) xdata_merged <- .concatenate_OnDiskMSnExp(xdata_merged,xdata)
            else stop("\n\nERROR: The RData either a OnDiskMSnExp object called raw_data or a XCMSnExp object called xdata")
            singlefile_merged <- c(singlefile_merged,singlefile)
            md5sumList_merged$origin <- rbind(md5sumList_merged$origin,md5sumList$origin)
            sampleNamesList_merged$sampleNamesOrigin <- c(sampleNamesList_merged$sampleNamesOrigin,sampleNamesList$sampleNamesOrigin)
            sampleNamesList_merged$sampleNamesMakeNames <- c(sampleNamesList_merged$sampleNamesMakeNames,sampleNamesList$sampleNamesMakeNames)
        }
    }
    rm(image)
    xdata <- xdata_merged; rm(xdata_merged)
    singlefile <- singlefile_merged; rm(singlefile_merged)
    md5sumList <- md5sumList_merged; rm(md5sumList_merged)
    sampleNamesList <- sampleNamesList_merged; rm(sampleNamesList_merged)

    if (!is.null(args$sampleMetadata)) {
        cat("\tXSET PHENODATA SETTING...\n")
        sampleMetadataFile <- args$sampleMetadata
        sampleMetadata <- getDataFrameFromFile(sampleMetadataFile, header=F)
        xdata@phenoData@data$sample_group=sampleMetadata$V2[match(xdata@phenoData@data$sample_name,sampleMetadata$V1)]

        if (any(is.na(pData(xdata)$sample_group))) {
            sample_missing <- pData(xdata)$sample_name[is.na(pData(xdata)$sample_group)]
            error_message <- paste("Those samples are missing in your sampleMetadata:", paste(sample_missing, collapse=" "))
            print(error_message)
            stop(error_message)
        }
    }
    return(list("xdata"=xdata, "singlefile"=singlefile, "md5sumList"=md5sumList,"sampleNamesList"=sampleNamesList))
}

#@author G. Le Corguille
# This function convert if it is required the Retention Time in minutes
RTSecondToMinute <- function(variableMetadata, convertRTMinute) {

    pdf(file="raw_vs_adjusted_rt.pdf", width=16, height=12)

    # Color by group
    group_colors <- brewer.pal(3, "Set1")[1:length(unique(xdata$sample_group))]
    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)

    write.table(dataMatrix, file=dataMatrixOutput,sep="\t",quote=F,row.names=F)

}

#@author G. Le Corguille
# It allow different of field separators
getDataFrameFromFile <- function(filename, header=T) {
    myDataFrame <- read.table(filename, header=header, sep=";", stringsAsFactors=F)
    if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header=header, sep="\t", stringsAsFactors=F)
    if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header=header, sep=",", stringsAsFactors=F)
    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)
}

getPlotChromatogram <- function(xdata, pdfname="Chromatogram.pdf", aggregationFun = "max") {

    chrom <- chromatogram(xdata, aggregationFun = aggregationFun)
    if (aggregationFun == "sum")
        type="Total Ion Chromatograms"

    pdf(pdfname, width=16, height=10)

    # Color by group
    group_colors <- brewer.pal(3, "Set1")[1:length(unique(xdata$sample_group))]
    if (length(group_colors) > 1) {
        names(group_colors) <- unique(xdata$sample_group)
        plot(chrom, col = group_colors[chrom$sample_group], main=main)
        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)
    legend("topright", legend=xdata@phenoData@data$sample_name, col=rainbow(length(xdata@phenoData@data$sample_name)), cex=0.8, lty=1)

            singlefile_galaxyPath <- singlefile_galaxyPaths[singlefile_galaxyPath_i]
            singlefile_sampleName <- singlefile_sampleNames[singlefile_galaxyPath_i]
            singlefile[[singlefile_sampleName]] <- singlefile_galaxyPath
        }
    }
    return(list(zipfile=zipfile, singlefile=singlefile))
}


# This function retrieve the raw file in the working directory
#   - if zipfile: unzip the file with its directory tree

#@TODO: remove this function as soon as we can use xcms 3.x.x from Bioconductor 3.7
# https://github.com/sneumann/xcms/issues/247
c.XCMSnExp <- function(...) {
    .concatenate_XCMSnExp(...)
}

#@TODO: remove this function as soon as we can use xcms 3.x.x from Bioconductor 3.7
# https://github.com/sneumann/xcms/issues/247
c.MSnbase <- function(...) {
    .concatenate_OnDiskMSnExp(...)
}