From c0758e267385565b5d5e4c4d8798fd9691658efc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <todor.kondic@uni.lu>
Date: Tue, 23 Aug 2022 14:16:36 +0200
Subject: [PATCH] app: Replaced qa_ms1[2] with qlt_ms1[2], changed how state is
handled and fixed extract/prescreen stage in GUI.
---
R/api.R | 1 +
R/mix.R | 35 ++++++++++++-----------
R/resources.R | 2 +-
R/shiny-state.R | 28 ++++++++++--------
R/shiny-ui-base.R | 73 +++++++++++++++++++++++++----------------------
R/state.R | 17 +++++++++++
6 files changed, 92 insertions(+), 64 deletions(-)
diff --git a/R/api.R b/R/api.R
index 12e8c48..f9c1059 100644
--- a/R/api.R
+++ b/R/api.R
@@ -139,6 +139,7 @@ load_data_input <- function(m) {
m$input$tab$mzml <- as.data.table(m$input$tab$mzml)
assert(all(unique(m$input$tab$mzml[,.N,by=c("adduct","tag")]$N)<=1),msg="Some rows in the data table contain multiple entries with same tag and adduct fields.")
pref<-m$run$paths$data
+ message("load_data_input: ", pref)
for (fn in m$input$tab$mzml$file) {
if (!file.exists(file.path(pref,fn))) stop("File ",fn," does not exist.")
}
diff --git a/R/mix.R b/R/mix.R
index 5d8ce29..5b2ef97 100644
--- a/R/mix.R
+++ b/R/mix.R
@@ -196,17 +196,17 @@ gen_summ <- function(comp,qa_ms1,qa_ms2) {
data.table::setcolorder(summ,SUMM_COLS)
## Quality scores for ms1 and ms2.
- summ[,qa_ms1 := as.integer(Map(function(m1,m2,m3) { m1*5L + m2*3L + m3*2L},
- as.integer(qa_ms1_exists),
- as.integer(qa_ms1_above_noise),
- as.integer(qa_ms1_good_int)))]
- summ[,qa_ms2 := as.integer(Map(function(m1,m2,m3) { m1*5L + m2*3L + m3*2L},
- as.integer(qa_ms2_exists),
- as.integer(qa_ms2_near),
- as.integer(qa_ms2_good_int)))]
-
- summ[is.na(qa_ms1),qa_ms1:=0L]
- summ[is.na(qa_ms2),qa_ms2:=0L]
+ summ[,qlt_ms1 := as.integer(Map(function(m1,m2,m3) { m1*5L + m2*3L + m3*2L},
+ as.integer(qa_ms1_exists),
+ as.integer(qa_ms1_above_noise),
+ as.integer(qa_ms1_good_int)))]
+ summ[,qlt_ms2 := as.integer(Map(function(m1,m2,m3) { m1*5L + m2*3L + m3*2L},
+ as.integer(qa_ms2_exists),
+ as.integer(qa_ms2_near),
+ as.integer(qa_ms2_good_int)))]
+
+ summ[is.na(qlt_ms1),qlt_ms1:=0L]
+ summ[is.na(qlt_ms2),qlt_ms2:=0L]
summ
@@ -603,12 +603,13 @@ create_qa_table <- function(extr,conf_presc) {
qa <- list(prescreen=conf_presc)
- checks <- extr$ms2[,{
- z <-..QA_FLAGS
- z[1:length(z)]<-F
- names(z)<-..QA_FLAGS
- z
- },keyby=BASE_KEY_MS2]
+ ## checks <- extr$ms2[,{
+ ## },keyby=BASE_KEY_MS2]
+ checks <- extr$ms2
+ checks[,(QA_FLAGS):=F]
+ ## message("checks:")
+ ## print(checks)
+ ## message("done checks")
checks[,(QA_NUM_INT):=NA_integer_]
checks[,(QA_NUM_REAL):=NA_real_]
setkeyv(checks,BASE_KEY_MS2)
diff --git a/R/resources.R b/R/resources.R
index 4c3b5d3..ffef246 100644
--- a/R/resources.R
+++ b/R/resources.R
@@ -284,7 +284,7 @@ SET_LIST_PATT <- CMPD_LIST_PATT
DFILES_LIST_PATT <- ".*\\.mz[Mm][Ll]$"
CINDEX_BY <- c("set","ID","adduct","tag")
-CINDEX_COLS <- c("mz", "ms1_rt","Name","qa_ms1","qa_ms2")
+CINDEX_COLS <- c("mz", "ms1_rt","Name","qlt_ms1","qlt_ms2")
ARRANGE_CHOICES <- c(nothing="nothing",
quality="quality",
set="set",
diff --git a/R/shiny-state.R b/R/shiny-state.R
index c70cafd..16466b5 100644
--- a/R/shiny-state.R
+++ b/R/shiny-state.R
@@ -141,7 +141,7 @@ which_gui_radio_inputs <- function() {
GUI_RADIO_INPUTS
}
-unpack_app_state <- function(session,input,project_path,packed_state) {
+unpack_app_state <- function(session,input,top_data_dir,project_path,packed_state) {
shiny::isolate({
for (inp in which_gui_select_inputs()) {
shiny::updateSelectInput(session = session,
@@ -174,7 +174,9 @@ unpack_app_state <- function(session,input,project_path,packed_state) {
gui$datatab$adduct <- packed_state$datatab$adduct
gui$datatab$tag <- packed_state$datatab$tag
gui$datatab$set <- packed_state$datatab$set
- gui$paths$data <- packed_state$paths$data
+ x <- packed_state$paths$data
+ gui$paths$data <- if (length(x)>0 & nchar(x)>0) file.path(top_data_dir,basename(x))
+ if (!dir.exists(gui$paths$data)) {warning("Data directory ", gui$paths$data, " does not exist. You must select one.")}
gui
})
@@ -182,7 +184,6 @@ unpack_app_state <- function(session,input,project_path,packed_state) {
}
-
input2conf_setup <- function(input,gui,conf=list()) {
if (length(conf)==0L) {
conf$compounds <- list()
@@ -237,10 +238,13 @@ input2conf <- function(input,gui,conf=list()) {
conf
}
-app_state2state <- function(input,gui) {
- m <- new_project(gui$paths$project)
+app_state2state <- function(input,gui,m=NULL) {
+ if (is.null(m)) m <- new_project(gui$paths$project)
m$run$paths <- shiny::reactiveValuesToList(gui$paths)
m$conf <- input2conf_setup(input,gui=gui)
+ m$conf <- input2conf_prescreen(input=input,conf=m$conf)
+ m$conf <- input2conf_figures(input,conf=m$conf)
+ m$conf <- input2conf_report(input,conf=m$conf)
m$input$tab$mzml <- gui2datatab(gui)
m
}
@@ -357,12 +361,12 @@ gen_cindex <- function(summ,sorder,cols = CINDEX_COLS,by. = CINDEX_BY) {
allc <- c(by.,cols)
xsumm <- summ[,..allc]
setnames(xsumm,old="ms1_rt",new="rt",skip_absent=T)
- res <- xsumm[,.SD[max(qa_ms1)==qa_ms1][max(qa_ms2)==qa_ms2],by=by.]
- res <- res[,c("mz","rt","Name","qa_ms1","qa_ms2"):=.(first(mz),
+ 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(qa_ms1),
- first(qa_ms2)),
+ first(qlt_ms1),
+ first(qlt_ms2)),
by=by.]
res <- res[,unique(.SD),by=by.]
@@ -372,12 +376,12 @@ gen_cindex <- function(summ,sorder,cols = CINDEX_COLS,by. = CINDEX_BY) {
if (length(quality)>0L) {
pre <- head(sorder,quality-1L)
post <- tail(sorder,-quality)
- sorder <- c(pre,"qa_ms1","qa_ms2",post)
+ sorder <- c(pre,"qlt_ms1","qlt_ms2",post)
}
ord <- rep(1L,length(sorder))
- if ("qa_ms1" %in% sorder) {
- ind <- which(sorder %in% c("qa_ms1","qa_ms2"))
+ if ("qlt_ms1" %in% sorder) {
+ ind <- which(sorder %in% c("qlt_ms1","qlt_ms2"))
ord[ind] <- -1L
}
if (length(sorder)>0) setorderv(res,cols=sorder,order=ord)
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index 6f2d168..d7a2b4a 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -722,6 +722,8 @@ mk_shinyscreen_server <- function(projects,init) {
rvs$gui$datatab$tag
rvs$gui$datatab$adduct
rvs$gui$datatab$set
+ rvs$gui$paths$data
+ rvs$gui$paths$project
isolate({
req(pre_setup_val_block(rvs$gui))
q = app_state2state(input,rvs$gui)
@@ -730,16 +732,6 @@ mk_shinyscreen_server <- function(projects,init) {
run(m=q,phases=c("setup","comptab"))
})
- rf_get_cmpd_tab <- reactive({
- m <- rf_setup_state()
- m$input$tab$cmpds
- })
-
- rf_get_sets_tab <- reactive({
- m <- rf_setup_state()
- m$input$tab$setid
- })
-
rf_cindex_key <- reactive({
if (isTruthy(input$cindex_group)) setdiff(CINDEX_BY,input$cindex_group) else CINDEX_BY
})
@@ -921,10 +913,17 @@ mk_shinyscreen_server <- function(projects,init) {
pack <- readRDS(file=fn_packed_state)
rvs$gui <- unpack_app_state(session=session,
input=input,
+ top_data_dir=init$userdir,
project_path=fullwd,
packed_state=pack)
## Load computational state.
rvs$m <- readRDS(file=fn_state)
+ rvs$m$run <- reinit_run_data(init$userdir,
+ project=rvs$gui$project(),
+ run = rvs$m$run)
+
+ ## If prescreen config invalid, reinit.
+ if (length(rvs$m$conf$prescreen)==0) rvs$m$conf <- input2conf_prescreen(input=input,conf=rvs$m$conf)
## Update status variables.
m <- rvs$m
@@ -938,16 +937,20 @@ mk_shinyscreen_server <- function(projects,init) {
rvs$status$ret_time_shift_tol_stat = rvs$m$conf$prescreen[["ret_time_shift_tol"]]
if (NROW(m$extr$ms1)>0L) rvs$status$is_extracted_stat <- "Yes."
if (NROW(m$out$tab$summ)>0L) rvs$status$is_qa_stat <- "Yes."
+
} else {
message("Initialising project: ",wd)
rvs$gui <- create_gui(project_path=fullwd)
+
+
+
}
message("project: ",rvs$gui$project())
}, label = "project-b")
observeEvent(input$extract_b,{
- rvs$m <-req(rf_setup_state())
+ rvs$m <- app_state2state(input,rvs$gui,m=rvs$m) # Update params from GUI.
m <- rvs$m
shinymsg("Extraction has started. This may take a while.")
rvs$status$ms1_coarse_stat = m$conf$tolerance[["ms1 coarse"]]
@@ -966,7 +969,7 @@ mk_shinyscreen_server <- function(projects,init) {
rv_extr_flag(F)
m <-rvs$m
- promises::future_promise(run(m=m,phases="extract")) %...>% {
+ promises::future_promise(run(m=m,phases=c("setup","comptab","extract"))) %...>% {
rvs$m = .
rvs$status$is_extracted_stat = "Yes."
fn_c_state <- file.path(rvs$m$run$paths$project,
@@ -1002,7 +1005,7 @@ mk_shinyscreen_server <- function(projects,init) {
observeEvent(input$presc_b,{
if (NROW(rvs$m$extr$ms1)>0L) {
- rvs$m$conf <- input2conf_prescreen(input=input,conf=rvs$m$conf)
+ rvs$m <- app_state2state(input,rvs$gui,m=rvs$m) # Update params from GUI.
rvs$status$ms1_int_thresh_stat = rvs$m$conf$prescreen[["ms1_int_thresh"]]
rvs$status$ms2_int_thresh_stat = rvs$m$conf$prescreen[["ms2_int_thresh"]]
rvs$status$s2n_stat = rvs$m$conf$prescreen[["s2n"]]
@@ -1265,29 +1268,31 @@ mk_shinyscreen_server <- function(projects,init) {
})
output$comp_table <- DT::renderDataTable({
- cmpds <- rf_get_cmpd_tab()
- validate(need(NROW(cmpds)>0,"No compound list loaded yet."))
- DT::datatable(cmpds,
- ## style = 'bootstrap',
- ## class = 'table-condensed',
- extensions = 'Scroller',
- options = list(scrollX = T,
- scrollY = 300,
- deferRender = T,
- scroller = T))
+ ## TODO FIXME
+ ## cmpds <- rf_get_cmpd_tab()
+ ## validate(need(NROW(cmpds)>0,"No compound list loaded yet."))
+ ## DT::datatable(cmpds,
+ ## ## style = 'bootstrap',
+ ## ## class = 'table-condensed',
+ ## extensions = 'Scroller',
+ ## options = list(scrollX = T,
+ ## scrollY = 300,
+ ## deferRender = T,
+ ## scroller = T))
})
output$setid_table <- DT::renderDataTable({
- setid <- rf_get_sets_tab()
- validate(need(NROW(setid)>0,"No set id list loaded yet."))
- DT::datatable(setid,
- ## style = 'bootstrap',
- ## class = 'table-condensed',
- extensions = 'Scroller',
- options = list(scrollX = T,
- scrollY = 300,
- deferRender = T,
- scroller = T))
+ ## TODO FIXME
+ ## setid <- rf_get_sets_tab()
+ ## validate(need(NROW(setid)>0,"No set id list loaded yet."))
+ ## DT::datatable(setid,
+ ## ## style = 'bootstrap',
+ ## ## class = 'table-condensed',
+ ## extensions = 'Scroller',
+ ## options = list(scrollX = T,
+ ## scrollY = 300,
+ ## deferRender = T,
+ ## scroller = T))
})
## RENDER: STATUS
@@ -1875,7 +1880,7 @@ mk_shinyscreen_server <- function(projects,init) {
}
if (NROW(rv_tran$qa_ms2sel_tab)>0) {
- qa_names <- c("ms2_sel",colnames(flt_summ)[grepl("qa_ms2",colnames(flt_summ))])
+ qa_names <- c("ms2_sel",colnames(flt_summ)[grepl("qlt_ms2",colnames(flt_summ))])
qatab <- copy(rv_tran$qa_ms2sel_tab)
qatab[,(qa_names):=lapply(.SD,yesno2log),.SDcol=qa_names]
entries <- cbind(compsel[the_row][,.(adduct,tag,ID)],
diff --git a/R/state.R b/R/state.R
index e9b3231..aebe8f4 100644
--- a/R/state.R
+++ b/R/state.R
@@ -40,6 +40,19 @@ runtime_from_conf <- function(run,conf) {
run
}
+reinit_run_data <- function(userdir,project,run) {
+ olddata <- run$paths$data
+ oldproject <- basename(run$paths$project)
+ if (project != oldproject) {
+ message("Project has been renamed to: ",project)
+ message("Old project name was: ", oldproject)
+ }
+ if (isTruthy(olddata)) run$paths$data <- file.path(userdir,basename(olddata))
+ run$project <- project
+ run$paths$project <- file.path(userdir,project)
+ run
+}
+
## This helps decouple "cross-platform" configuration from the
## (file-)system dependent facts.
@@ -110,6 +123,10 @@ refresh_state <- function(m) {
new_rv_state <- function() react_v(m=list2rev(new_state()))
+
+
+
+
write_conf <- function(m,fn) {
m$conf$paths$data <- get_fn_ftab(m)
if (NROW(m$input$tab$mzml)>0) tab2file(tab=m$input$tab$mzml,file=file.path(m$run$paths$project,FN_DATA_TAB))
--
GitLab