# HG changeset patch # User tomnl # Date 1527780189 14400 # Node ID f428f3fb82ad39e2775740935aff44536e582c14 # Parent 6c8c4452b8ea4602e75aa41132ed7ee19cf39bdb planemo upload for repository https://github.com/computational-metabolomics/mspurity-galaxy commit 04023134d8f28e85927ca293373c506484149ead-dirty diff -r 6c8c4452b8ea -r f428f3fb82ad backup_sqlite.R --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/backup_sqlite.R Thu May 31 11:23:09 2018 -0400 @@ -0,0 +1,280 @@ +library(msPurity) +library(optparse) +library(xcms) +library(CAMERA) +print(sessionInfo()) +print('CREATING DATABASE') + + +xset_pa_filename_fix <- function(opt, pa, xset){ + + + if (!is.null(opt$mzML_files) && !is.null(opt$galaxy_names)){ + # NOTE: Relies on the pa@fileList having the names of files given as 'names' of the variables + # needs to be done due to Galaxy moving the files around and screwing up any links to files + + filepaths <- trimws(strsplit(opt$mzML_files, ',')[[1]]) + filepaths <- filepaths[filepaths != ""] + new_names <- basename(filepaths) + + galaxy_names <- trimws(strsplit(opt$galaxy_names, ',')[[1]]) + galaxy_names <- galaxy_names[galaxy_names != ""] + + nsave <- names(pa@fileList) + old_filenames <- basename(pa@fileList) + pa@fileList <- filepaths[match(names(pa@fileList), galaxy_names)] + names(pa@fileList) <- nsave + + pa@puritydf$filename <- basename(pa@fileList[match(pa@puritydf$filename, old_filenames)]) + pa@grped_df$filename <- basename(pa@fileList[match(pa@grped_df$filename, old_filenames)]) + } + + + if(!all(basename(pa@fileList)==basename(xset@filepaths))){ + if(!all(names(pa@fileList)==basename(xset@filepaths))){ + print('FILELISTS DO NOT MATCH') + message('FILELISTS DO NOT MATCH') + quit(status = 1) + }else{ + xset@filepaths <- unname(pa@fileList) + } + } + + + return(list(pa, xset)) +} + + + + +option_list <- list( + make_option(c("-o", "--out_dir"), type="character"), + make_option("--pa", type="character"), + make_option("--xset_xa", type="character"), + make_option("--xcms_camera_option", type="character"), + make_option("--eic", action="store_true"), + make_option("--cores", default=4), + make_option("--mzML_files", type="character"), + make_option("--galaxy_names", type="character"), + make_option("--grp_peaklist", type="character"), + make_option("--db_name", type="character", default='lcms_data.sqlite'), + make_option("--raw_rt_columns", action="store_true"), + make_option("--metfrag_result", type="character"), + make_option("--sirius_csifingerid_result", type="character"), + make_option("--probmetab_result", type="character") +) + + +# store options +opt<- parse_args(OptionParser(option_list=option_list)) + +loadRData <- function(rdata_path, name){ + #loads an RData file, and returns the named xset object if it is there + load(rdata_path) + return(get(ls()[ls() == name])) +} + +print(paste('pa', opt$pa)) +print(opt$xset) +print(opt$xcms_camera_option) +# Requires +pa <- loadRData(opt$pa, 'pa') + + +print(pa@fileList) + + +if (opt$xcms_camera_option=='xcms'){ + xset <- loadRData(opt$xset, 'xset') + fix <- xset_pa_filename_fix(opt, pa, xset) + pa <- fix[[1]] + xset <- fix[[2]] + xa <- NULL +}else{ + + xa <- loadRData(opt$xset, 'xa') + fix <- xset_pa_filename_fix(opt, pa, xa@xcmsSet) + pa <- fix[[1]] + xa@xcmsSet <- fix[[2]] + xset <- NULL +} + + + + + +if(is.null(opt$grp_peaklist)){ + grp_peaklist = NA +}else{ + grp_peaklist = opt$grp_peaklist +} + + + + + +db_pth <- msPurity::create_database(pa, xset=xset, xsa=xa, out_dir=opt$out_dir, + grp_peaklist=grp_peaklist, db_name=opt$db_name) + +print(db_pth) + +if (!is.null(opt$eic)){ + if (is.null(opt$raw_rt_columns)){ + rtrawColumns <- FALSE + }else{ + rtrawColumns <- TRUE + } + if (is.null(xset)){ + xset <- xa@xcmsSet + } + # previous check should have matched filelists together + xset@filepaths <- unname(pa@fileList) + + # Saves the EICS into the previously created database + px <- msPurity::purityX(xset, saveEIC = TRUE, + cores=1, sqlitePth=db_pth, + rtrawColumns = rtrawColumns) +} + +con <- DBI::dbConnect(RSQLite::SQLite(), db_pth) + +add_extra_table_elucidation <- function(name, pth, db_con, filter_Score=NA, filter_Rank=NA){ + if (is.null(pth)){ + return(0) + } + chunk=50 + c = 1 + header_s = FALSE + con = file(pth, "r") + while ( TRUE ) { + line = readLines(con, n = 1) + print(line) + if ( length(line) == 0 ) { + break + } + line_v <- unlist(strsplit(line, split="\t")) + if (!header_s){ + header = line_v + header_s = TRUE + df <- data.frame(ncol=length(header), nrow=0) + print(header) + colnames(df) <- header + df_blank <- df + print('CHECK') + write_to_table(df, db_con, name, FALSE, NA, NA) + } + print(line_v) + + if (!is.na(filter_Score)){ + if (line_v[header=='Score']filter_Rank){ + next + } + } + + df <- rbind(df, line_v) + + + + if (c>chunk){ + write_to_table(df, db_con, name, TRUE, filter_Score, filter_Rank) + c=0 + df <- df_blanks + + } + c = c+1 + + print(line) + } + + + + close(con) + + +} + +write_to_table <- function(df, db_con, name, append){ + + df <- df[!df$UID=='UID',] + print(filter_Score) + print(filter_Rank) + print('filter rank and score') + + + # get peakid, an scan id + df_ids <- stringr::str_split_fixed(df$UID, '-', 3) + colnames(df_ids) <- c('grp_id', 'file_id', 'pid') + df <- cbind(df_ids, df) + DBI::dbWriteTable(db_con, name=name, value=df, row.names=FALSE, append=append) +} + +add_probmetab <- function(pth, con){ + if (!is.null(pth)){ + + df <- read.table(pth, header = TRUE, sep='\t', stringsAsFactors = FALSE, comment.char = "") + df$grp_id <- 1:nrow(df) + start <- T + for (i in 1:nrow(df)){ + + x <- df[i,] + + + if(is.na(x$proba) | x$proba =='NA'){ + + next + } + + mpc <- stringr::str_split(x$mpc, ';') + proba <- stringr::str_split(x$proba, ';') + + for (j in 1:length(mpc[[1]])){ + + row <- c(x$grp_id, x$propmz, mpc[[1]][j], proba[[1]][j]) + + if (start){ + df_out <- data.frame(t(row), stringsAsFactors=F) + start <- F + }else{ + df_out <- data.frame(rbind(df_out, row), stringsAsFactors=F) + } + print(df_out) + + } + + } + + colnames(df_out) <- c('grp_id', 'propmz', 'mpc', 'proba') + DBI::dbWriteTable(con, name='probmetab_results', value=df_out, row.names=FALSE) + + } + + +} + +add_extra_table_elucidation('metfrag_results', opt$metfrag_result, con, filter_Score=0.6, filter_Rank=NA) +add_extra_table_elucidation('sirius_csifingerid_results', opt$sirius_csifingerid_result, con, filter_Score=NA, filter_Rank=5) +add_probmetab(opt$probmetab_result, con) + + + + +cmd <- paste('SELECT cpg.grpid, cpg.mz, cpg.mzmin, cpg.mzmax, cpg.rt, cpg.rtmin, cpg.rtmax, c_peaks.cid, ', + 'c_peaks.mzmin AS c_peak_mzmin, c_peaks.mzmax AS c_peak_mzmax, ', + 'c_peaks.rtmin AS c_peak_rtmin, c_peaks.rtmax AS c_peak_rtmax, s_peak_meta.*, fileinfo.filename, fileinfo.nm_save ', + 'FROM c_peak_groups AS cpg ', + 'LEFT JOIN c_peak_X_c_peak_group AS cXg ON cXg.grpid=cpg.grpid ', + 'LEFT JOIN c_peaks on c_peaks.cid=cXg.cid ', + 'LEFT JOIN c_peak_X_s_peak_meta AS cXs ON cXs.cid=c_peaks.cid ', + 'LEFT JOIN s_peak_meta ON cXs.pid=s_peak_meta.pid ', + 'LEFT JOIN fileinfo ON s_peak_meta.fileid=fileinfo.fileid') + +print(cmd) +cpeakgroup_msms <- DBI::dbGetQuery(con, cmd) + +write.table(cpeakgroup_msms, file.path(opt$out_dir, 'cpeakgroup_msms.tsv'), row.names=FALSE, sep='\t') diff -r 6c8c4452b8ea -r f428f3fb82ad create_sqlite_db.R --- a/create_sqlite_db.R Thu May 31 09:08:55 2018 -0400 +++ b/create_sqlite_db.R Thu May 31 11:23:09 2018 -0400 @@ -142,52 +142,18 @@ if (is.null(pth)){ return(0) } - index <- 0 - chunkSize <- 5000 - print(pth) - con <- file(description=pth,open="r") - df <- read.table(con, nrows=chunkSize, header = TRUE, sep='\t', stringsAsFactors = FALSE, comment.char = "") - headers = colnames(df) - print(head(df)) - write_to_table(df, db_con, name, FALSE, filter_Score, filter_Rank) + DBI::dbWriteTable(conn=db_con, name=name, value=pth, sep='\t', header=T) - repeat { - index <- index + 1 - print(paste('Processing rows:', index * chunkSize)) - - if (nrow(df) != chunkSize){ - print('Processed all files!') - break - } - - df <- read.table(con, nrows=chunkSize, skip=0, header = FALSE, sep='\t', stringsAsFactors = FALSE, comment.char = "") - colnames(df) <- headers - - - write_to_table(df, db_con, name, TRUE, filter_Score, filter_Rank) - - - break - } - close(con) } -write_to_table <- function(df, db_con, name, append, filter_Score, filter_Rank){ +write_to_table <- function(df, db_con, name, append){ df <- df[!df$UID=='UID',] print(filter_Score) print(filter_Rank) print('filter rank and score') - if (!is.na(filter_Score)){ - df <- df[df$Score>=filter_Score,] - } - - if (!is.na(filter_Rank)){ - - df <- df[df$Rank<=filter_Rank,] - } # get peakid, an scan id df_ids <- stringr::str_split_fixed(df$UID, '-', 3) @@ -243,8 +209,13 @@ add_extra_table_elucidation('sirius_csifingerid_results', opt$sirius_csifingerid_result, con, filter_Score=NA, filter_Rank=5) add_probmetab(opt$probmetab_result, con) +if (is.null(xset)){ + DBI::dbWriteTable(con, name='xset_classes', value=xa@xcmsSet@phenoData, row.names=TRUE) +}else{ + DBI::dbWriteTable(con, name='xset_classes', value=xset@phenoData, row.names=TRUE) +} cmd <- paste('SELECT cpg.grpid, cpg.mz, cpg.mzmin, cpg.mzmax, cpg.rt, cpg.rtmin, cpg.rtmax, c_peaks.cid, ', 'c_peaks.mzmin AS c_peak_mzmin, c_peaks.mzmax AS c_peak_mzmax, ',