From 45699cf748539c663cc72f396b9667fc123055b1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Sun, 1 Jan 2023 16:52:25 +0100
Subject: [PATCH] Fix #97
Everything under Measurement Properties refreshes correctly now. The
reason why it did not was the overuse of req functions.
---
DESCRIPTION | 2 +-
R/shiny-state.R | 18 +++++++
R/shiny-ui-base.R | 133 ++++++++++++++++++----------------------------
3 files changed, 71 insertions(+), 82 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 3ed66f9..2e7e99c 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: shinyscreen
Title: Pre-screening of Mass Spectrometry Data
-Version: 1.2.2-0003
+Version: 1.2.3
Author: Todor Kondić
Maintainer: Todor Kondić <todor.kondic@uni.lu>
Authors@R:
diff --git a/R/shiny-state.R b/R/shiny-state.R
index b7b0570..8bb95a2 100644
--- a/R/shiny-state.R
+++ b/R/shiny-state.R
@@ -486,3 +486,21 @@ update_on_commit_chg <- function(summ,input,ptab,ltab) {
summ[the_row,qa_pass:=apply(.SD,1,all),.SDcols=qflg]
summ
}
+
+
+get_mprop_ms2_metadata <- function(ltab_entry) {
+ res <- list(rt=NA_real_,int=NA_real_,qa=character(0),ms2_sel=F)
+
+ if (NROW(ltab_entry)==0L) return(res)
+
+ res$rt = ltab_entry$ms1_rt
+ res$int = ltab_entry$ms1_int
+ z <- ltab_entry[.SD,.SDcols=patterns("qa_ms[12].*")]
+ lqa_vals <- as.list(ltab_entry[,.SD,.SDcols=patterns("qa_ms[12].*")])
+ qa_names <- names(lqa_vals)
+ res$qa <- qa_names[as.logical(lqa_vals)]
+ res$ms2_sel = ltab_entry$ms2_sel
+
+ res
+
+}
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index e3b4df5..ccafedf 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -786,10 +786,17 @@ mk_shinyscreen_server <- function(projects,init) {
})
rf_get_ltab <- reactive({
- tab <- req(rf_select_from_summ())
+ tab <- rf_select_from_summ()
if (NROW(tab)!=0) get_ltab(tab) else data.frame()
})
+ rf_get_ltab_entry <- reactive({
+ ltab <- rf_get_ltab()
+ if (NROW(ltab)>0L && isTruthy(input$sel_spec)) {
+ ltab[item==input$sel_spec]
+ } else data.frame()
+ })
+
## REACTIVE FUNCTIONS: PLOTS
@@ -901,34 +908,6 @@ mk_shinyscreen_server <- function(projects,init) {
})
- ## REACTIVE FUNCTIONS: MEASUREMENT PROPERTIES
-
- rf_msrprop_get_vals <- reactive({
- ptab <- rf_get_cindex_parents()
- stab <- rf_select_from_summ()
-
- res <- if (NROW(stab)==1L && is.na(stab[1,an])) {
- x1 <- list(rt=stab[1,ms1_rt],int=stab[1,ms1_int])
- x2 <- stab[1,.SD,.SDcols=patterns("qa_ms[12].*")]
- qa <- as.logical(x2)
- names(qa) <- names(x2)
- c(x1,list(qa=qa),ms2_sel=F)
-
- } else {
- selMS2 <- req(input$sel_spec)
- xx <- rf_get_ltab()
- x1 <- list(rt=xx[item==(selMS2),ms1_rt],
- int=xx[item==(selMS2),ms1_int])
- x2 <- xx[item==(selMS2),.SD,.SDcols=patterns("qa_ms[12].*")]
- qa <- as.logical(x2)
- names(qa) <- names(x2)
- x3 <- list(ms2_sel=xx[item==(selMS2),ms2_sel])
- c(x1,list(qa=qa),x3)
- }
-
- res
- })
-
## OBSERVERS
@@ -1326,22 +1305,14 @@ mk_shinyscreen_server <- function(projects,init) {
observe({
input$cmt_changes_b
- res <- rf_msrprop_get_vals()
- ## TODO: FIXME: Uncomment after debug.
- if (isTruthy(res)) {
- valrt = res$rt
- valint = res$int
- valms2sel = res$ms2_sel
- selqa <- res$qa[QABOX_VALS]
- selqa <- QABOX_VALS[selqa]
- message("valms2sel: ", valms2sel)
- message("selqa: ", paste(selqa,collapse=','))
- } else {
- valrt = NA_real_
- valint = NA_real_
- selqa <- character(0)
- valms2sel = F
- }
+ ltab_entry <- rf_get_ltab_entry()
+ ## res <- rf_msrprop_get_vals()
+ res <- get_mprop_ms2_metadata(ltab_entry)
+ valrt = res$rt
+ valint = res$int
+ valms2sel = res$ms2_sel
+ selqa <- res$qa
+
updateNumericInput(session = session,
inputId = "chg_ms1_rt",
value = valrt)
@@ -1360,18 +1331,18 @@ mk_shinyscreen_server <- function(projects,init) {
value = valms2sel)
})
- ## TODO: FIXME: Uncomment after debug?
- ## observeEvent(input$cmt_changes_b,{
- ## summ <- req(rvs$m$out$tab$summ)
- ## ptab <- req(rf_get_cindex_parents())
- ## ltab <- req(rf_get_ltab())
- ## rvs$m$out$tab$summ <- update_on_commit_chg(summ,
- ## input=input,
- ## ptab=ptab,
- ## ltab=ltab)
+ observeEvent(input$cmt_changes_b,{
+ summ <- req(rvs$m$out$tab$summ)
+
+ ptab <- req(rf_get_cindex_parents())
+ ltab <- req(rf_get_ltab())
+ rvs$m$out$tab$summ <- update_on_commit_chg(summ,
+ input=input,
+ ptab=ptab,
+ ltab=ltab)
- ## })
+ })
@@ -1600,33 +1571,33 @@ mk_shinyscreen_server <- function(projects,init) {
})
- ## FIXME: TODO: Uncomment after fixing.
- ## output$print_spec_tab <- renderPrint({
- ## notfound <- "No MS2 spectrum has been found for this entry."
- ## ms2tabsel <- req(rf_get_ltab())
- ## selMS2 <- req(input$sel_spec)
- ## if (NROW(ms2tabsel)!=0L) {
- ## lval <- lapply(ms2tabsel[item==(selMS2)],function(x) x)
- ## ms2 <- rvs$m$extr$ms2
- ## kval <- rf_get_cindex_kval()
- ## allval <- c(kval,lval)
- ## ## There can be some duplicates.
- ## common <- union(names(kval),names(lval))
- ## allval <- allval[common]
- ## #Because in current implementation, kval may contain
- ## #more than the names existing in extr$ms2. Also,
- ## #BASE_KEY_MS2 does not contain `an', so we need to readd
- ## #it.
- ## key <- unique(c(names(allval)[names(allval) %in% BASE_KEY_MS2],"an"))
- ## 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])))
- ## print(as.data.frame(spec),row.names=F)
+
+ output$print_spec_tab <- renderPrint({
+ notfound <- "No MS2 spectrum has been found for this entry."
+ ms2tabsel <- rf_get_ltab()
+ selMS2 <- req(input$sel_spec)
+ if (NROW(ms2tabsel)!=0L) {
+ lval <- lapply(ms2tabsel[item==(selMS2)],function(x) x)
+ ms2 <- rvs$m$extr$ms2
+ kval <- rf_get_cindex_kval()
+ allval <- c(kval,lval)
+ ## There can be some duplicates.
+ common <- union(names(kval),names(lval))
+ allval <- allval[common]
+ #Because in current implementation, kval may contain
+ #more than the names existing in extr$ms2. Also,
+ #BASE_KEY_MS2 does not contain `an', so we need to readd
+ #it.
+ key <- unique(c(names(allval)[names(allval) %in% BASE_KEY_MS2],"an"))
+ 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])))
+ print(as.data.frame(spec),row.names=F)
- ## } else {
- ## notfound
- ## }
- ## })
+ } else {
+ notfound
+ }
+ })
--
GitLab