stripext<-function(fn) { bits<-strsplit(fn,split="\\.")[[1]] if (length(bits)> 1) paste(head(bits,-1),collapse=".") else fn} ##' Create directories without drama. ##' ##' Create directories without drama. ##' ##' @title Create directories without drama ##' @param path Names of the directories. ##' @return The character string containing the input argument `path`. ##' @author Todor Kondić no_drama_mkdir<-function(path) { f <- Vectorize(function(path) { if (! dir.exists(path)) dir.create(path) path},vectorize.args="path") f(path) } ##' Produce the Rmb Settings file ##' ##' Produce the Rmb Settings file based on the customisation file in ##' YAML format. ##' ##' @title Generate RMassBank settings file. ##' @param sett_alist The named list of settings that are different ##' from the RMassBank defaults. ##' @param file The name of the YAML specification that will be merged ##' with the template Rmb settings file. ##' @return NULL mk_sett_file<-function(sett_alist,file) { tmp<-tempfile() RMassBank::RmbSettingsTemplate(tmp) sett<-yaml::yaml.load_file(tmp) for (nm in names(sett_alist)) { sett[[nm]]<-sett_alist[[nm]] } yaml::write_yaml(x=sett,file=file) NULL } ##' Combine the RMB settings files ##' ##' Combine RMB settings with different collisional energies into one ##' settings file with multiple collisional energy entries. ##' ##' @title Combine RMB Settings With Different Collisional Energies ##' @param sett_fns A list of settings files. ##' @param fname The name of the combined file. ##' @return fname ##' @author Todor Kondić mk_combine_file<-function(sett_fns,fname) { all_settings <- lapply(sett_fns,yaml::yaml.load_file) comb_settings <- all_settings[[1]] for (n in 1:length(all_settings)) { comb_settings$spectraList[[n]] <- all_settings[[n]]$spectraList[[1]] } yaml::write_yaml(x=comb_settings,fname) fname } fn_data2wd <- function(fn_data,dest) { f <- Vectorize(function(fn_data) { noext <- stripext(fn_data) file.path(dest,basename(noext)) },vectorize.args="fn_data") f(fn_data) } get_presc_d <- function(wd) {wd} gen_presc_d <- function(wd) { no_drama_mkdir(wd)} get_cmpd_l_fn <- function(wd) { f <- function(wd) file.path(wd,"compounds.csv") fv <- Vectorize(f,vectorize.args=c("wd")) fv(wd) } get_stgs_fn <- function(wd) { f <- function(wd) file.path(wd,"settings.ini") fv <- Vectorize(f,vectorize.args=c("wd")) fv(wd) } get_ftable_fn <- function(wd) { f <- function(wd) file.path(wd,"ftable.csv") fv <- Vectorize(f,vectorize.args=c("wd")) fv(wd) } get_inp_stgs_fn<- function(fn_data) { f <- Vectorize(function(fn_data) { bnm <- stripext(fn_data) fn <- paste(bnm,".ini",sep='')}, vectorize.args="fn_data") f(fn_data)} get_info_dir <- function(wd) { file.path(wd,"info") } get_info_fn <- function(wd) { file.path(get_info_dir(wd),"info.csv") } gen_info_dir <- function(wd) { nm <- get_info_dir(wd) no_drama_mkdir(nm) nm } ##' Generate the RMassBank compound list from the input compound list ##' in CSV file src_fn. The input compound list format is either a ##' Chemical Dashboard csv file with, at least, PREFERRED_ SMILES ##' columns _filled_ out, or just an ordinary CSV file with columns ##' SMILES and Names filled. Argument dest_fn is the destination ##' filename. Returns the number of compounds. ##' ##' @title Generate Compound List File ##' @param src_fn The input compound list CSV filename. ##' @param dest_fn The resulting compound list CSV filename. ##' @return Number of compounds. ##' @author Todor Kondić gen_cmpd_l<-function(src_fn,dest_fn) { df<-read.csv(src_fn) ## Names nms<-if ("PREFERRED_NAME" %in% names(df)) df$PREFERRED_NAME else df$Name if (is.null(nms)) stop("Unable to read compound names from the input compound list.") print(df) print(is.null(df$SMILES)) ## take Mass, else SMILES if (is.null(df$SMILES)){ # SMILES column in cpdList must be non-existent mass<- df$Mass haha<-rep("",length(mass)) level<-rep(5,length(mass)) }else{ haha <- df$SMILES level<- rep(5,length(haha)) } sz<-length(haha) ## CAS casvals<-if ("CASRN" %in% names(df)) df$CASRN else rep(NA,sz) if (is.null(haha)) stop("Unable to read SMILES from the input compound list.") outdf<-data.frame(ID=1:sz,Name=nms,SMILES=haha,CAS=casvals,RT=rep(NA,sz),mz=mass,Level=level) f <- Vectorize(function (dest_fn) { write.csv(outdf,file=dest_fn,row.names=F,na="") },vectorize.args="dest_fn",SIMPLIFY=F) f(dest_fn) length(nms) } ##' Generates settings file and loads it. ##' ##' @title Generate and Load the RMassBank Settings File ##' @param stgs Settings named list, or a settings filename. ##' @param wd Directory under which results are archived. ##' @return result of RMassBank::loadRmbSettings ##' @author Todor Kondić gen_stgs_and_load <- function(stgs,wd) { stgs<-if (is.character(stgs)) yaml::yaml.load_file(stgs) else stgs sfn<-get_stgs_fn(wd) mk_sett_file(stgs,sfn) RMassBank::loadRmbSettings(sfn) } ##' Generates the RMassBank compound list and loads it. ##' ##' @title Generate and Load the RMassBank Compound List ##' @param wd Directory under which results are archived. ##' @param fn_cmpdl The input compound list filename. ##' @return Named list. The key `fn_cmpdl` is the path of the ##' generated compound list and the key `n` the number of ##' compounds. ##' @author Todor Kondić gen_cmpdl_and_load <- function(wd,fn_cmpdl) { fn_comp<-get_cmpd_l_fn(wd) n_cmpd<-gen_cmpd_l(fn_cmpdl,fn_comp) RMassBank::loadList(fn_comp,check=F) #reduce universality of this statement!!! list(fn_cmpdl=fn_comp,n=n_cmpd) } ##' Generates file table. ##' ##' ##' @title Generate and Load the RMassBank Settings File ##' @param fn_data The mzML filename. ##' @param wd Directory under which results are archived. ##' @param n_cmpd Number of compounds. ##' @return File path of the file table. ##' @author Todor Kondić gen_ftable <- function(fn_data,wd,n_cmpd) { f <- Vectorize(function(fn_data,wd) { df_table<-data.frame(Files=rep(fn_data,n_cmpd),ID=1:n_cmpd) fn_table<-get_ftable_fn(wd) write.csv(x=df_table,file=fn_table,row.names=F) fn_table }, vectorize.args=c("fn_data","wd")) f(fn_data,wd) } gen_fn_stgs <- function(fn_inp,fn) { f <- Vectorize(function(fn_inp,fn) { stgs <- yaml::yaml.load_file(fn_inp) mk_sett_file(stgs,fn) fn}, vectorize.args=c("fn_inp","fn")) f(fn_inp,fn) } conf <- function(fn_data,fn_cmpd_l,dest) { no_drama_mkdir(dest) wd <- fn_data2wd(fn_data,dest) no_drama_mkdir(wd) fn_inp_stgs <- get_inp_stgs_fn(fn_data) fn_stgs <- get_stgs_fn(wd) fn_out_cmpd_l <- get_cmpd_l_fn(wd) gen_fn_stgs(fn_inp_stgs,fn_stgs) n_cmpd <- gen_cmpd_l(fn_cmpd_l,fn_out_cmpd_l) gen_ftable(fn_data,wd,n_cmpd) } reconf <- function(wd) {## Load the settings. fn_stgs <- get_stgs_fn(wd) RMassBank::loadRmbSettings(fn_stgs) ## Load the compound list. fn_cmpd_l <- get_cmpd_l_fn(wd) RMassBank::loadList(fn_cmpd_l) } ##' Prescreens. Writes data out. Adapted from ReSOLUTION ##' ##' ##' @title Prescreen ##' @param wd Absolute path to the directory that will contain the ##' resulting data frame. ##' @param RMB_mode ... ##' @param FileList ... ##' @param cmpd_list ... ##' @param ppm_limit_fine ... ##' @param EIC_limit ... ##' @author Emma Schymanski, Todor Kondić RMB_EIC_prescreen_df <- function (wd, RMB_mode, FileList, cmpd_list, ppm_limit_fine = 10, EIC_limit = 0.001) { n_spec <- 0 cmpd_RT_maxI <- "" msms_found <- "" rts <- 0 max_I_prec <- "" cmpd_RT_maxI_min <- "" file_list <- read.csv(FileList, stringsAsFactors = FALSE) cmpd_info <- read.csv(cmpd_list, stringsAsFactors = FALSE) ncmpd <- nrow(cmpd_info) odir=wd get_width <- function(maxid) {log10(maxid)+1} id_field_width <- get_width(ncmpd) fn_out<- function(id,suff) {file.path(odir,paste(formatC(id,width=id_field_width,flag=0),suff,".csv",sep=''))} f <- mzR::openMSfile(file_list$Files[1]) for (i in 1:length(file_list$ID)) { cpdID <- file_list$ID[i] n_spec <- n_spec + 1 smiles <- tryCatch(RMassBank::findSmiles(cpdID), error = function(e) NA) if (!is.na(smiles)) { mz <- as.numeric(RMassBank::findMz(cpdID, RMB_mode)[3]) } else { mz <- as.numeric(RMassBank::findMz(cpdID, RMB_mode, retrieval = "unknown")[3]) } eic <- RMassBank::findEIC(f, mz, limit = EIC_limit) msms_found[n_spec] <- FALSE msms <- RMassBank::findMsMsHR.mass(f, mz, 0.5, RMassBank::ppm(mz, ppm_limit_fine, p = TRUE)) max_I_prec_index <- which.max(eic$intensity) cmpd_RT_maxI[n_spec] <- eic[max_I_prec_index, 1] max_I_prec[n_spec] <- eic[max_I_prec_index, 2] cmpd_RT_maxI_min[n_spec] <- as.numeric(cmpd_RT_maxI[n_spec])/60 ## plot.new() ## plot.window(range(eic$rt), range(eic$intensity)) ## box() ## lines(eic$intensity ~ eic$rt) write.csv(x=eic[c("rt","intensity")],file=fn_out(cpdID,".eic"),row.names=F) cpd_df <- data.frame("rt"=c(),"intensity"=c()) for (specs in msms) { if (specs@found == TRUE) { df <- do.call(rbind, lapply(specs@children, function(sp) c(sp@rt, intensity = max(sp@intensity)))) cpd_df <- rbind(cpd_df,df,make.row.names = F) ## lines(intensity ~ retentionTime, data = df, type = "h", ## col = "blue") msms_found[n_spec] <- TRUE } } if (nrow(cpd_df)>0) write.csv(x=cpd_df,file=fn_out(cpdID,".kids"),row.names=F) ## title(main = cpdID, xlab = "RT (sec)", ylab = "Intensity") ## text(as.numeric(cmpd_RT_maxI[n_spec]), as.numeric(max_I_prec[n_spec]), ## labels = as.numeric(cmpd_RT_maxI_min[n_spec]), pos = 4) ## axis(1) ## axis(2) ## gc() rts[i] <- (cmpd_RT_maxI[n_spec]) } # dev.off() write.csv(cbind(file_list$ID, cmpd_info$mz, cmpd_info$Name, cmpd_RT_maxI, cmpd_RT_maxI_min, max_I_prec, msms_found), file = file.path(odir,"RTs_wI.csv"), row.names = F) } preProc <- function (fnFileTab,fnDest=paste(stripext(fnFileTab),"_candidate.csv",sep=''),noiseFac=3,rtDelta=0.5,ms1_intTresh=1e5,ms2_intTresh=1e4,MS1peakWi=0.3) { ## read in .csv file as file ftable <- read.csv(file = fnFileTab, header = T, sep=",", stringsAsFactors = F) getWidth <- function(maxid) {log10(maxid)+1} ids <- as.numeric(levels(factor(ftable$ID)) ##is MS1 intensity high enough?) id_field_width <- getWidth(max(ids)) fn_out<- function(id,suff) {paste(formatC(id,width=id_field_width,flag=0),suff,".csv",sep='')} ## for loop through dataframe called file to set tresholds ftable[c("MS1","MS2","Alignment","MS1Intensity","AboveNoise","MS2Intensity","MS1peakWidth")] <- T ftable$Comments <- "" for (ind in 1:nrow(ftable)) { wd <- ftable$wd[ind] id <- ftable$ID[ind] odir=file.path(wd) fn_eic <- file.path(wd,fn_out(id,".eic")) eic <- NULL maxInt <- NULL eicExists <- T ##does MS1 exist? if(!file.exists(fn_eic)) { ftable[ind,"MS1"] = FALSE eicExists <- F } else { eic <- read.csv(fn_eic, sep = ",", stringsAsFactors = F) maxInt <- max(eic$intensity) ##is MS1 intensity high enough? if (maxInt < ms1_intTresh) { ftable[ind,"MS1Intensity"] = FALSE } ##Detect noisy signal. This is a naive implementation, so careful. mInt <- mean(eic$intensity) if (maxInt < noiseFac*mInt) ftable[ind,"AboveNoise"] <- F ##Is MS1 peak a proper peak, or just a spike? Check peakwidth. MS1peakWi } #####MS2 checks fn_kids <- file.path(wd,fn_out(id,".kids")) ##does MS2 exist? Regardless of quality/alignment. if(!file.exists(fn_kids)) { ftable[ind,"MS2"] = FALSE ftable[ind,"MS2Intensity"] = NA #moot ftable[ind,"Alignment"] = NA #moot } else { ## Detect RT shifts. Naive implementation, so careful. if (eicExists) { ################WHY THIS IF CONDITIONAL?? If MS2 exists, then eic MUST exist, no? Seems redundant. ##Is MS2 intensity high enough? ms2maxInt <- max(msms@intensity) if (ms2maxInt > ms2_intTresh){ rtInd <- match(maxInt,eic$intensity) #returns position of first match in eic$intensity rtMax <- eic$rt[rtInd] #fetch the rtmax value (RT with highest int;seconds) using above index msms <- read.csv(fn_kids, sep = ",", stringsAsFactors = F) whc <- msms$rt > rtMax - rtDelta #T/F vector: are RT vals of ms2 above rtMax within Delta? Good peaks=TRUE;rt must be retentionTime!!! whc <- whc < rtMax + rtDelta #T/F vector: are RT vals of ms2 above rtMax within Delta? #Overwrites whc! In any case, cannot use this as both must be T to give final whc of T (i.e. fall within the window). ints <- msms$intensity[whc] #builds ints vector with intensities which fall in window if (! any(ints>0)) ftable[ind,"Alignment"] = FALSE #if none of ints larger than 0, Alignment <-F } else { ftable[ind,"MS2Intensity"] = FALSE ftable[ind,"Alignment"] = NA #neither T or F, the MS2 was not of decent intensity in first place, alignment moot. } } } } ## get a csv outfile write.csv(ftable, file = fnDest,row.names=F) } ##' Helper function for rendersmiles2 ##' ##' @title Render Compound from an Online Resource ##' @param depictURL The URL of the object to plot. ##' @param coords The positioning of the image (in data coords). ##' @param filename Temp filename. ##' @return Nothing useful. ##' @author Todor Kondić renderurl <- function(depictURL,coords=c(0,0,100,100), filename=tempfile(fileext=".svg")) { h <- new_handle() curl::handle_setopt(h, ssl_verifyhost = 0, ssl_verifypeer=0) curl::curl_download(url=depictURL,filename,handle=h) img <- rsvg(filename) if (length(img)>2) { rasterImage(img,xleft=coords[1],ybottom=coords[2],xright=coords[3],ytop=coords[4]) } } ## rendersmiles <- function(smiles, kekulise=TRUE, coords=c(0,0,100,100), width=200, height=200, ## zoom=1.3,style="cow", annotate="off", abbr="on",suppressh=TRUE, ## showTitle=FALSE, smaLimit=100, sma=NULL) { ## dep <- get.depictor(width = width, height = height, zoom = zoom, style = style, annotate = annotate, ## abbr = abbr, suppressh = suppressh, showTitle = showTitle, smaLimit = smaLimit, ## sma = NULL) ## library(rcdk) ## library(RChemMass) ## mol <- getMolecule(smiles) ## img <- view.image.2d(mol, depictor=dep) ## rasterImage(img, coords[1],coords[2], coords[3],coords[4]) ## } ##' Render smiles from an online resource. ##' ##' @title Turn SMILES to an Image Using Online Resource ##' @param smiles The SMILES string. ##' @param style Structure style. ##' @param ... Hand over to renderurl. ##' @return Nothing useful. ##' @author Todor Kondić rendersmiles2 <- function(smiles,style="cow",...) { dpurl <- buildCDKdepictURL(smiles,style=style) renderurl(dpurl,filename=tempfile(fileext=".svg"),...) } calcLogTics <- function(lims,powUnit=1,linDiv=1,howMany=NULL) { ## Find integer power limits. llim <- log10(lims) llim[is.infinite(llim)] <- 0 nlim <- llim/powUnit ilim <- round(nlim)*powUnit all <- if (linDiv>1) { z <- sapply(seq(ilim[1],(ilim[2]-1),by=powUnit), function(i) { a <- 10.**i b <- 10.**(i+1) st <- b/linDiv s <- seq(0,b,by=st) s[2:length(s)] }) dim(z) <- prod(dim(z)) z } else 10**seq(ilim[1],ilim[2],by=powUnit) res <- if (!is.null(howMany)) { if (howMany<length(all)) { step <- length(all) %/% howMany ind <- seq(1,howMany*step,by=step) rev(rev(all)[ind]) } else return(NULL) } else all res } calcLabels <- function(ticVals) { pw <- as.integer(log10(abs(ticVals))) mags <- 10**pw mags[is.na(mags)] <- 0 pw[is.na(mags)] <- 0 mant <- signif(ticVals/mags,3) zz <- Map(function (m,p) c(m=m,p=p),mant,pw) sapply(zz,function (z) {as.expression(bquote(.(z['m']) %*% 10^.(z['p'])))},USE.NAMES = F) } arrPlot <- function(xlim,ylim,ytics,xaxis=F,log=NULL,cex=0.2) { ylim[is.na(ylim)] <- 1 ylim[ylim == 0] <- 1 if (is.null(ylim)) ylim <- c(1,10) if (xaxis) xaxt="s" else xaxt="n" if (! is.null(log) && ! any(is.na(ytics)) ) { plot(1,1,xlab="",ylab="",xlim = xlim,ylim = ylim,type="n",log=log,xaxt=xaxt,yaxt = "n") message("ytics:",ytics) ltics <- calcLabels(ytics) axis(side=2,at=ytics,labels=ltics,las=2,cex=cex,gap.axis = -1) } else { plot(1,1,xlab="",ylab="",xlim = xlim,ylim = ylim,type="n",xaxt = xaxt) axis(side=2,las=2,cex=cex) } } arrPlotStd <- function(xlim,ylim,xaxis=F,log=log,cex=1.5,mar,intTresh) { if (ylim[1]<intTresh) ylim[1] <- intTresh if (is.na(ylim[2])) ylim[2] <- 10 if (xaxis) xaxt="s" else xaxt="n" par(mar=mar) plot(1,1,xlab="",ylab="",xlim = xlim,ylim = ylim,type="n",log=log,xaxt=xaxt,yaxt = "n",cex.axis=cex) ytics <- if (log=="y") axTicks(side=2, nintLog = 3) else axTicks(side=2) message("YTICS:",do.call(paste,as.list(ytics))) ltics <- calcLabels(ytics) axis(side=2,at=ytics,labels=ltics,las=2,cex.axis=cex,gap.axis = -1) } plot_id_aux <- function(i,wd,eics,maybekids,masses,osmesi,tags,logYAxis,pal="Dark2",cex=0.75,rt_digits=2,m_digits=4,rtrange=NULL) { clean_rtrange <- function(def) { x1 <- rtrange[1] x2 <- rtrange[2] if (is.na(x1) || x1 == 0) x1 <- def[1] if (is.na(x2) || x2 == 0) x2 <- def[2] c(x1,x2) } if (logYAxis == "linear") log = "" if (logYAxis == "log") log = "y" LEFT_MARGIN=9 eic <- eics[[i]] maybekid <- maybekids[[i]] dfs <- lapply(file.path(wd,eic),function(fn) { tryCatch(read.csv(fn,stringsAsFactors = F), error=function(e) {message(paste(e,"; offending file:",fn))}) }) dfs <- lapply(dfs,function(x) data.frame(rt=x$rt/60.,intensity=x$intensity)) ## Find existing children. maybes <- file.path(wd,maybekid) indkids <- which(file.exists(maybes)) kids <- maybes[indkids] dfs_kids <- lapply(kids,read.csv,stringsAsFactors=F) dfs_kids <- lapply(dfs_kids,function(x) data.frame(rt=x$retentionTime/60.,intensity= x$intensity)) ## Find max intensities. w_max <- sapply(dfs,function (x) which.max(x$intensity)) rt_max <- Map(function(df,w) df$rt[[w]],dfs,w_max) i_max<- Map(function(df,w) df$intensity[[w]],dfs,w_max) symbs <- LETTERS[1:length(w_max)] ## Find max intensities in children w_max_kids <- sapply(dfs_kids,function (x) which.max(abs(x$intensity))) rt_max_kids <- Map(function(df,w) df$rt[[w]],dfs_kids,w_max_kids) i_max_kids <- Map(function(df,w) df$intensity[[w]],dfs_kids,w_max_kids) symbs_kids<- letters[indkids] def_rt_rng <- range(sapply(dfs,function(x) x$rt)) rt_rng <- if (is.null(rtrange)) def_rt_rng else clean_rtrange(def_rt_rng) int_rng<- range(sapply(dfs,function(x) x$intensity)) int_rng_kids<- if (! is.null(dfs_kids)) range(sapply(dfs_kids,function(x) x$intensity)) else c(0,1) cols <- RColorBrewer::brewer.pal(n=length(dfs),name=pal) lgnd <- Map(function(k,v) paste(k,"= ",formatC(v,format="f",digits=rt_digits),sep=''),symbs,rt_max) layout(matrix(c(3,3,4,4,1,2), 3, 2, byrow = TRUE)) ## par(mar=c(1,2,1,4)) struc_xr <- c(0,100) struc_yr <- c(0,100) par(mar=c(1,LEFT_MARGIN,3,4)) plot(1,1,type="n",xlab="",ylab="",xlim=struc_xr,ylim=struc_yr,xaxt="n",yaxt="n",asp=1,axes = FALSE) #rendersmiles2(osmesi[i],coords=c(struc_xr[1],struc_yr[1],struc_xr[2],struc_yr[2])) col_eng <- c(0,100) peak_int <- c(0,100) par(mar=c(1,6,3,1)) plot(1,1,type="n",xlab="",ylab="",xlim=col_eng,ylim=peak_int,xaxt="n",yaxt="n",axes = FALSE) linfo <- legend("topleft",horiz=T,legend=tags,col=cols,fill=cols,bty="n",cex=1.5) legend(x=linfo$rect$left,y=linfo$rect$top-1*linfo$rect$h,horiz=F,legend=lgnd,fill=cols,bty='n',cex=1.5) cols_kids <- cols[indkids] lgnd_kids <- Map(function(k,v) paste(k,"= ",formatC(v,digits=rt_digits,format="f"),sep=''),symbs_kids,rt_max_kids) if (length(lgnd_kids)>0) legend(x=linfo$rect$left-14*linfo$rect$left,y=linfo$rect$top-1*linfo$rect$h,horiz=F,legend=lgnd_kids,fill=cols[indkids],bty="n",cex=1.5) arrPlotStd(xlim=rt_rng,ylim=int_rng,mar=c(0,LEFT_MARGIN,3,0),log=log,intTresh=1e4) title(main=paste("ID:",i,"Ion m:",formatC(masses[[i]],digits=m_digits,format="f"))) for (k in seq(length(w_max))) text(rt_max[[k]],i_max[[k]],labels=symbs[[k]],pos=4,offset=0.5*k) mtext("intensity",side = 2,adj=0.2,cex=1.3,line=7) ## Plot eic across the directory set. for (n in 1:length(dfs)) { df <- dfs[[n]] col <- cols[[n]] lines(intensity ~ rt,data=df,col=col) } if (length(dfs_kids) >0) { arrPlotStd(xlim=rt_rng,ylim=int_rng_kids,xaxis=T,log=log,mar=c(4,LEFT_MARGIN,0,0),intTresh=1) for (k in 1:length(indkids)) { lines(intensity ~ rt,data=dfs_kids[[k]],type="h",col=cols_kids[[k]]) } } else { arrPlotStd(xlim=rt_rng,ylim=c(1,10),xaxis=T,log=log,mar=c(4,9,0,0),intTresh=1) } mtext("retention time [min]",side = 1,adj=0.5,cex=1.3,line = 3) if (length(dfs_kids)>0) for (k in seq(length(w_max_kids))) text(rt_max_kids[[k]],i_max_kids[[k]],labels=symbs_kids[[k]],pos=4,offset=0.5*k) ## RChemMass::renderSMILES.rcdk(smiles[[i]],coords=c(x1,y1,x2,y2)) gc() } ##' Plot the output of prescreen. ##' ##' @title Plot the Output of Prescreen ##' @param prescdf File table data-frame. See presc.shiny for details. ##' @param mode RMB mode. ##' @param out The name of the output file. ##' @param fn_cmpd_l The compound list name. ##' @param pal ColorBrewer palette name. ##' @param cex As in legend. ##' @param rt_digits Number of digits after the point for the retention time. ##' @param m_digits Number of digits after the point for the mass. ##' @param wd Sequence of data dirs containing the prescreen subdir. ##' @param digits Number of significant digits for peak ret times. ##' @return Nothing useful. ##' @author Todor Kondić ##' @author Mira Narayanan ##' @author Anjana Elapavalore ##' @export presc.plot <- function(prescdf,mode,out="prescreen.pdf",fn_cmpd_l,pal="Dark2",cex=0.75,rt_digits=2,m_digits=4) { modemap=list(pH="MpHp_mass", mH="MmHm_mass", blahnh4="MpNH4_mass", blahna="MpNa_mass") tags <- levels(factor(prescdf$tag)) wd <- prescdf$wd[match(tags,prescdf$tag)] wd1 <- wd[[1]] df <- read.csv(file=fn_cmpd_l,stringsAsFactors = F) osmesi <- df$SMILES no_cmpds <- length(osmesi) # reconf(wd1) masses <- lapply(osmesi,function (smile) { #osmesi <- tryCatch(RMassBank::findSmiles(i), error = function(e) NA) zz <- RChemMass::getSuspectFormulaMass(smile) zz[[modemap[[mode]]]] }) #message("Masses:",masses) # return(osmesi) ## Get the basenames of eic files. eics <- list.files(path=wd[[1]],patt=".*eic.csv") maybekids <- sapply(strsplit(eics,split="\\."),function(x) {paste(x[[1]][1],'.kids.csv',sep='')}) pdf(out) for (i in 1:length(osmesi)) plot_id_aux(i=i,wd=wd,eics=eics,maybekids=maybekids,masses=masses,osmesi=osmesi,log="y",tags=tags,rtrange=rtrange,cex=cex,pal=pal,rt_digits=rt_digits,m_digits=m_digits) dev.off() } mkUI <- function(idSliderRange,setName,rtRange,tags) { tabPanelList <- lapply(tags, function(tag) { shiny::tabPanel(tag, shiny::checkboxGroupInput(paste("spectProps",tag,sep=""), "Quality Control", c(MS1 = "MS1", MS2 = "MS2", Alignment = "Alignment", Intensity = "Intensity", AboveNoise = "AboveNoise")), shiny::textAreaInput(paste("caption",tag,sep=""), "Comments:", "Insert your comment here..."), shiny::verbatimTextOutput(paste("value",tag,sep="")) )}) nvPanel <- do.call(shiny::navlistPanel, tabPanelList) ui <- shinydashboard::dashboardPage(skin="black", shinydashboard::dashboardHeader(title = "Prescreening"), shinydashboard::dashboardSidebar( width = 350, shinydashboard::sidebarMenu( shinydashboard::menuItem(text = "The Prescreening", tabName = "Prescreen", icon = shiny::icon("dashboard")), shinydashboard::menuItem(text = "Adduct Calculator", tabName = "Adducts", icon = shiny::icon("th")))), shinydashboard::dashboardBody( shinydashboard::tabItems( shinydashboard::tabItem(tabName = "Adducts", shiny::h2("Calculate the adducts"), shiny::fluidRow( shinydashboard::box( title = "INPUT", width = 4, solidHeader = TRUE, status = "primary", shiny::textAreaInput("IdSmiles","Enter Smiles",value="",width="100%"), shiny::fileInput("smileslist", "Upload SMILES List", multiple = FALSE,accept=(".csv")) ), shinydashboard::box( title = "Adduct Masses",width = 8,status="primary", shiny::tableOutput("masses"), shiny::textInput("adduct-table", "Adduct Masses",value="adductable.csv"), shiny::actionButton("downloadtable", "Download", icon = shiny::icon("download")) ) )), shinydashboard::tabItem(tabName = "Prescreen", shiny::h2("The Prescreen plot"), shiny::fluidRow( shinydashboard::box( title = "MS Prescreening", width = 7, height = "80px", background = "blue", "" ), shinydashboard::box( title = "Compound ID N°",width = 5, height = "80px", background = "olive", shiny::textOutput("compoundID") ) ), shiny::fluidRow( shinydashboard::box( title = "Plot", width = 7, color = "olive", solidHeader = FALSE, collapsible = TRUE, shiny::plotOutput("plot1", width = "100%", height = "750px", click = NULL, dblclick = NULL, hover = NULL, hoverDelay = NULL, hoverDelayType = NULL, brush = NULL, clickId = NULL, hoverId = NULL), shiny::textInput("plotname", "Insert plot name: (e.g. plotname_%i.pdf)",value="plotCpdID_%i.pdf"), shiny::actionButton("saveplot", "Save", icon = shiny::icon("save")), shiny::actionButton("saveallplots", "Save All Plots", icon = shiny::icon("save")) ), shinydashboard::box( title = "Compounds", width=5, solidHeader = FALSE, color = "olive", collapsible = TRUE, "", shiny::br(), shiny::sliderInput("idslider", "Compound number:", idSliderRange[1], idSliderRange[2], value=1,step=1) ), shinydashboard::box( title = "Prescreening analysis", width = 5, solidHeader = FALSE, collapsible = TRUE, shiny::titlePanel(setName), nvPanel, shiny::actionButton("submitQA", "Submit", icon = shiny::icon("save")), shiny::textInput("fn_ftable", "File table Name",value="ftable.csv"), shiny::actionButton("savefiletable", "Save File Table", icon = shiny::icon("save")) ), shinydashboard::box( title = "Plot Parameters", width=7, solidHeader = FALSE, collapsible = TRUE, "", shiny::br(), shiny::numericInput("min_val", "Minimum x Axis Value", rtRange[1]), shiny::numericInput("max_val", "Maximum x Axis Value", rtRange[2]), shiny::radioButtons("yaxis", "Parameters for y Axis", c(linear = "linear", log = "log")), shiny::numericInput("nice", "Nice", rtRange[1]), shiny::numericInput("steps", "Steps", rtRange[2]) ) ) ) )))} ##' Prescreening using shiny interface. ##' ##' @title Prescreening with Shiny ##' @return Nothing useful. ##' @author Jessy Krier ##' @author Mira Narayanan ##' @author Hiba Mohammed Taha ##' @author Anjana Elapavalore ##' @author Todor Kondić ##' @param prescdf File table data-frame. Columns: Files,ID,wd,tag,set_name ... ##' @param mode RMassBank mode. ##' @param fn_cmpd_l Compound list file name. ##' @param pal ColorBrewer palette. ##' @param cex Size of fonts. ##' @param rt_digits Number of decimal places for the retention time. ##' @param m_digits Number of decimal places for the mass. ##' @export presc.shiny <-function(prescdf,mode,fn_cmpd_l,pal="Dark2",cex=0.75,rt_digits=2,m_digits=4){ ## Helper functions queryFileTable <- function(df,id) { df[df$ID %in% id,] } updateFileTable <- function(df,id,linput) { for (tag in names(linput)) { entries <- names(linput[[tag]]) cond <- (df$ID %in% id) & (df$tag == tag) df[cond,entries] <- linput[[tag]] } df } ## Constants MODEMAP=list(pH="MpHp_mass", mH="MmHm_mass", blahnh4="MpNH4_mass", blahna="MpNa_mass") DEFAULT_RT_RANGE=c(NA,NA) QANAMES <- c("MS1","MS2","Alignment","Intensity","AboveNoise") prescdf$tag <- as.character(prescdf$tag) tags <- levels(factor(prescdf$tag)) wd <- prescdf$wd[match(tags,prescdf$tag)] wd1 <- wd[[1]] cmpd_l_df <- read.csv(file=fn_cmpd_l,stringsAsFactors = F) osmesi <- cmpd_l_df$SMILES no_cmpds <- length(osmesi) # reconf(wd1) masses <- lapply(osmesi,function (smile) { #osmesi <- tryCatch(RMassBank::findSmiles(i), error = function(e) NA) zz <- RChemMass::getSuspectFormulaMass(smile) zz[[MODEMAP[[mode]]]] }) for (col in c("MS1","MS2","Alignment","Intensity","AboveNoise","Comments")) { if (is.null(prescdf[[col]])) prescdf[[col]] <- T } ## Get the basenames of eic files. eics <- list.files(path=wd[[1]],patt=".*eic.csv") maybekids <- sapply(strsplit(eics,split="\\."),function(x) {paste(x[[1]][1],'.kids.csv',sep='')}) plot_id <- function (i,rtrange=NULL,log=rv$yaxis) plot_id_aux(i=i,wd=wd,eics=eics,maybekids=maybekids,masses=masses,osmesi=osmesi,tags=tags,log=log,rtrange=rtrange,cex=cex,pal=pal,rt_digits=rt_digits,m_digits=m_digits) spectProps <- sapply(tags,function (tag) paste("spectProps",tag,sep="")) idSliderRange <- range(cmpd_l_df$ID) ui <- mkUI(idSliderRange=idSliderRange,setName=prescdf$set_name,rtRange=DEFAULT_RT_RANGE,tags=tags) getCheckboxValues <- function(tag,input) { chkbox <- input[[spectProps[[tag]]]] q <- sapply(QANAMES,function (qn) if (qn %in% chkbox) T else F) names(q) <- QANAMES q } server <- function(input, output, session) { rv_adduc<- shiny::reactiveValues(smiles=1, resTable=1) rv <- shiny::reactiveValues(prescList=list(), prescdf=prescdf, spectProps=spectProps, tags=tags, default_range=DEFAULT_RT_RANGE, no_cmpds=no_cmpds) output$plot1 <- renderPlot( { i=input$idslider rtrange <- c(input$min_val,input$max_val) plot_id(i,rtrange=rtrange, log=input$yaxis) # intParameter <- c(input$nice, input$steps) }) output$value <- renderText( { input$caption }) output$compoundID <- renderText( { i=input$idslider }) shiny::observeEvent(input$smileslist, { rv_adduc$smiles <- read.csv(input$smileslist$datapath, header=FALSE,sep=',',stringsAsFactors=FALSE)[[1]] }) shiny::observeEvent(input$IdSmiles, { rv_adduc$smiles <- trimws(strsplit(input$IdSmiles,split="\n")[[1]],which="both") }) output$masses <- renderTable( { message("LEN:",length(rv_adduc$smiles)) expr =lapply(rv_adduc$smiles,RChemMass::getSuspectFormulaMass) if (! length(expr) == 0) { df <- do.call(rbind,expr) df <- as.data.frame(df) names(df) <- c("SMILES", "Monoisotopicmass", "[M+H]+", "[M+NH4]+", "[M+Na]+", "[M-H]-") rv$resTable <- df df } else NULL },digits=4) shiny::observeEvent(input$downloadtable, { write.csv(file=input[["adduct-table"]],x=rv$resTable,row.names = F) }) shiny::observeEvent(input$saveplot, { i=input$idslider pfn <-input$plotname if (is.na(pfn)) pfn <- "plotCpdID_%i.pdf" fn <- sprintf(pfn,i) rtrange <- c(input$min_val,input$max_val) pdf(file=fn, width=12, height=8) plot_id(i,rtrange=rtrange, log=input$yaxis) dev.off() }) shiny::observeEvent(input$saveallplots, { i=input$idslider pfn <-input$plotname if (is.na(pfn)) pfn <- "plotall.pdf" fn <- sprintf(pfn,i) pdf(file=fn, width=12, height=8) for (i in 1:rv$no_cmpds) { plot_id(i,log=input$yaxis) message("Compound ID ",i," done.") } dev.off() }) shiny::observeEvent(input$submitQA,{ res <- lapply(rv$tags,getCheckboxValues,input) names(res) <- rv$tags rv$prescdf <- updateFileTable(df=rv$prescdf,id=input$idslider,linput=res) }) ## shiny::observeEvent(input$yaxis,{ ## rv$yaxis <- input$yaxis ## }) shiny::observe({ i <- input$idslider sdf <- queryFileTable(df=rv$prescdf,id=i) for (t in sdf$tag) { sprop <- rv$spectProps[[t]] sel <- as.logical(sdf[sdf$tag %in% t,QANAMES]) choices <- QANAMES[sel] names(choices) <- QANAMES[sel] shiny::updateCheckboxGroupInput(session = session,inputId = sprop,selected=choices) } }) shiny::observeEvent(input$savefiletable, { write.csv(file=input$fn_ftable,x=rv$prescdf,row.names = F) }) session$onSessionEnded(function() { stopApp() }) } shiny::shinyApp(ui = ui, server = server) }