Mercurial > repos > tomnl > msp_split
diff create_sqlite_db.R @ 5:f2683ec717fe draft default tip
planemo upload for repository https://github.com/computational-metabolomics/mspurity-galaxy commit a164f06c09dc1614c2909c247ebf390aab433527-dirty
| author | tomnl |
|---|---|
| date | Wed, 18 Sep 2019 05:46:09 -0400 |
| parents | 769ec2496d14 |
| children |
line wrap: on
line diff
--- a/create_sqlite_db.R Wed Jul 18 06:04:14 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,239 +0,0 @@ -library(msPurity) -library(optparse) -library(xcms) -library(CAMERA) -print(sessionInfo()) -print('CREATING DATABASE') - - -xset_pa_filename_fix <- function(opt, pa, xset){ - print(xset@filepaths) - - 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) - } - } - - -print(xset@phenoData) -print(xset@filepaths) - - 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){ - if (is.null(pth)){ - return(0) - } - - - DBI::dbWriteTable(conn=db_con, name=name, value=pth, sep='\t', header=T) - - -} - -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, xset, con){ - if (!is.null(pth)){ - - df <- read.table(pth, header = TRUE, sep='\t', stringsAsFactors = FALSE, comment.char = "") - df$grp_id <- match(df$name, xcms::groupnames(xset)) - 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) -add_extra_table_elucidation('sirius_csifingerid_results', opt$sirius_csifingerid_result, con) - - -if (is.null(xset)){ - DBI::dbWriteTable(con, name='xset_classes', value=xa@xcmsSet@phenoData, row.names=TRUE) - add_probmetab(opt$probmetab_result, xa@xcmsSet, con) -}else{ - - DBI::dbWriteTable(con, name='xset_classes', value=xset@phenoData, row.names=TRUE) - add_probmetab(opt$probmetab_result, xset, 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')
