diff --git a/R/plotting.R b/R/plotting.R index 568f425f779a1f6bd8475d9efd967e2e462a26fd..93ababd30050b0011f205acd7fa934b07f88b345 100644 --- a/R/plotting.R +++ b/R/plotting.R @@ -194,7 +194,7 @@ mk_logic_exp <- function(rest,sofar=NULL) { } -get_data_from_key <- function(db,tab,kvals,outcols) { +get_data_from_key <- function(db,tab,kvals,outcols=NULL) { ## Ensure only names that exist in cat are used in selection. Or, ## should we not do this? @@ -209,7 +209,8 @@ get_data_from_key <- function(db,tab,kvals,outcols) { ## Get precids. mztab = db$precursors[cattab,on="catid"] outnames = union(valid_names,outcols) - tab[mztab,on="precid"][,..outnames] + res = tab[mztab,on="precid"] + if (!is.null(outcols)) res[,..outnames] else res } diff --git a/R/shiny-state.R b/R/shiny-state.R index c0b32f9db5244e50226c82cd79ef3ac519ac3fc9..e943b100f0aa6b128c47cb8de0ec4d1bf0f5dce3 100644 --- a/R/shiny-state.R +++ b/R/shiny-state.R @@ -495,11 +495,11 @@ gen_cindex <- function(summ,sorder,cols = CINDEX_COLS,by. = CINDEX_BY) { xsumm <- summ[,..allc] setnames(xsumm,old="ms1_rt",new="rt",skip_absent=T) res <- xsumm[,.SD[max(qlt_ms1)==qlt_ms1][max(qlt_ms2)==qlt_ms2],by=by.] - res <- res[,c("mz","rt","Name","qlt_ms1","qlt_ms2"):=.(first(mz), - first(mean(rt)), - first(Name), - first(qlt_ms1), - first(qlt_ms2)), + res <- res[,c("mz","rt","Name","qlt_ms1","qlt_ms2"):=.(mean(mz,na.rm=T), + mean(rt,na.rm=T), + first(Name), + max(qlt_ms1,na.rm=T), + max(qlt_ms2,na.rm=T)), by=by.] res <- res[,unique(.SD),by=by.] @@ -518,7 +518,11 @@ gen_cindex <- function(summ,sorder,cols = CINDEX_COLS,by. = CINDEX_BY) { ord[ind] <- -1L } if (length(sorder)>0) setorderv(res,cols=sorder,order=ord) - setnames(res,old="rt",new="rt(ms1)") + + ## Remove confusing columns. + res[,c("rt","mz"):=NULL] + res[,c("qlt_ms1","qlt_ms2"):=.(signif(100*qlt_ms1/10.,3),signif(100*qlt_ms2/10.,3))] + setnames(res,c("qlt_ms1","qlt_ms2"),c("best score (ms1)","best score (ms2)")) res } @@ -554,9 +558,9 @@ get_cindex_kval <- function(cindex,row,key) { res } -get_summ_subset <- function(summ,ptab,paritem,kvals) { +get_summ_subset <- function(db,summ,ptab,paritem,kvals) { select <- ptab[item==(paritem)] - tab <- get_data_from_key(summ,kvals)[select,nomatch=NULL,on=key(ptab)] + tab <- get_data_from_key(db=db,tab=summ,kvals=kvals)[select,nomatch=NULL,on=key(ptab)] if ("scan.1" %in% names(tab)) tab[,scan.1:=NULL] #TODO: This is #probably a lousy #hack. diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R index 2b50752875b25d6d3182fd8c29e58fbf6804ada0..a186eb408c6c83d72167cbeaa84794e117818ba5 100644 --- a/R/shiny-ui-base.R +++ b/R/shiny-ui-base.R @@ -760,7 +760,8 @@ mk_shinyscreen_server <- function(projects,init) { kvals = req(rf_get_cindex_kval()) ptab = rf_get_cindex_parents() if (isTruthy(parent)) { - get_summ_subset(summ=summ, + get_summ_subset(db=rvs$m$db, + summ=summ, ptab=ptab, paritem=parent, kvals=kvals) @@ -1774,8 +1775,9 @@ mk_shinyscreen_server <- function(projects,init) { #it. key = unique(c(names(allval)[names(allval) %in% BASE_KEY_MS2],"scan")) kval2 = allval[key] - spec = get_data_from_key(ms2,kval2)[,.(mz,intensity)] - ## as.character(lapply(1L:NROW(spec),function(nr) paste0(spec[nr,mz]," ",spec[nr,intensity]))) + ## Only precid and scan can be used for selection in spectra. + kval2 = as.data.table(kval2[c("precid","scan")]) + spec = rvs$m$db$extr$spectra[kval2,.(mz,intensity),on=.(precid,scan)] print(as.data.frame(spec),row.names=F) } else {