From 7489da09adffe59dbba59f8245fb19f8103f541b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <todor.kondic@uni.lu>
Date: Sat, 2 Jul 2022 13:35:37 +0200
Subject: [PATCH] app: shiny-state, shiny-ui-base: datafiles tab fixed.
---
R/shiny-state.R | 14 ++++++--
R/shiny-ui-base.R | 92 ++++++++++++++++++++++++-----------------------
2 files changed, 60 insertions(+), 46 deletions(-)
diff --git a/R/shiny-state.R b/R/shiny-state.R
index b84ca71..e2c1630 100644
--- a/R/shiny-state.R
+++ b/R/shiny-state.R
@@ -74,7 +74,7 @@ r2datatab <- function(rdatatab) {
data.table(tag=tag,adduct=adduct,set=set,file=file)
}
-r2taadse <- function(tablist,sets) {
+gen_dtab <- function(tablist,sets) {
data.table(tag=factor(tablist$tag,levels=unique(tablist$tag)),
adduct=factor(tablist$adduct,levels=ADDUCTMAP),
set=factor(tablist$set,levels=sets))
@@ -226,7 +226,17 @@ gen_comp_state <- function(input,gui) {
get_sets <- function(gui) {
- fn_set <- file.path(gui$paths$project,gui$compounds$sets)
+ fn_sets <- file.path(gui$paths$project,gui$compounds$sets)
df <- fread(file=fn_sets)
df[,unique(set)]
}
+
+
+gen_dfiles_tab <- function(gui) {
+ curr_file <- gui$datatab$file
+ curr_tag <- gui$datatab$tag
+
+ res <- data.table(file=curr_file,tag=curr_tag)
+ res[,tag:=as.factor(tag)]
+
+}
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index c716ac2..c7dab14 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -654,25 +654,32 @@ mk_shinyscreen_server <- function(projects,init) {
## REACTIVE FUNCTIONS
- ## rf_compound_input_state <- reactive({
- ## sets <- rvs$m$run$paths$compounds$sets
- ## lst <- as.list(rvs$m$run$paths$compounds$lists)
- ## ## TODO XXX
- ## validate(need(length(lst)>0,
- ## message = "Load the compound lists(s) first."))
- ## validate(need(length(sets)>0 && nchar(sets)>0,
- ## message = "Load the setid table first."))
- ## isolate({
- ## state <- rev2list(rvs$m)
- ## m <- load_compound_input(state)
-
- ## ## Side effect! This is because my pipeline logic does not
- ## ## work nicely with reactive stuff.
- ## rvs$m$input$tab$cmpds <- list2rev(m$input$tab$cmpds)
- ## rvs$m$input$tab$setid <- m$input$tab$setid
- ## m
- ## })
- ## })
+ rf_compound_set <- reactive({
+ req(rvs$gui$compounds$sets,
+ rvs$gui$paths$project)
+
+ get_sets(rvs$gui)
+ })
+
+ rf_compound_input_state <- reactive({
+ sets <- rvs$m$run$paths$compounds$sets
+ lst <- as.list(rvs$m$run$paths$compounds$lists)
+ ## TODO XXX
+ validate(need(length(lst)>0,
+ message = "Load the compound lists(s) first."))
+ validate(need(length(sets)>0 && nchar(sets)>0,
+ message = "Load the setid table first."))
+ isolate({
+ state <- rev2list(rvs$m)
+ m <- load_compound_input(state)
+
+ ## Side effect! This is because my pipeline logic does not
+ ## work nicely with reactive stuff.
+ rvs$m$input$tab$cmpds <- list2rev(m$input$tab$cmpds)
+ rvs$m$input$tab$setid <- m$input$tab$setid
+ m
+ })
+ })
rf_comp_state <- reactive({
app_state2state(input=input,
@@ -680,10 +687,10 @@ mk_shinyscreen_server <- function(projects,init) {
})
rf_get_sets <- reactive({
- req(rvs$gui$paths$project)
- req(rvs$gui$paths$sets)
+ req(rvs$gui$paths$project,
+ rvs$gui$compounds$sets)
- get_sets(gui)
+ get_sets(rvs$gui)
})
@@ -1085,8 +1092,6 @@ mk_shinyscreen_server <- function(projects,init) {
res_adduct <- c(curr_adduct,rep(NA_character_,nd))
res_set <- c(curr_set,rep(NA_character_,nd))
-
-
rvs$gui$datatab$file <- res_file
rvs$gui$datatab$tag <- res_tag
rvs$gui$datatab$adduct <- res_adduct
@@ -1111,15 +1116,16 @@ mk_shinyscreen_server <- function(projects,init) {
})
observeEvent(input$datafiles_cell_edit,{
- z <- DT::editData(rv_dfile(),
- input$datafiles_cell_edit,
- rownames = F)
- rv_dfile(z)
-
-
+ df <- gen_dfiles_tab(rvs$gui)
+ df <- DT::editData(df,
+ input$datafiles_cell_edit,
+ rownames = F)
+ rvs$gui$datatab$file <- df$file
+ rvs$gui$datatab$tag <- df$tag
}, label = "datafiles-edit")
+
observeEvent(input$summ_subset_cell_edit,{
the_summ_subset <<- DT::editData(the_summ_subset,
input$summ_subset_cell_edit,
@@ -1607,24 +1613,22 @@ mk_shinyscreen_server <- function(projects,init) {
output$datafiles <- DT::renderDT(
{
- curr_file <- rvs$gui$datatab$file
- curr_tag <- rvs$gui$datatab$tag
-
- res <- data.table(file=curr_file,tag=curr_tag)
- res[,tag:=as.factor(tag)]
-
+ rvs$gui$datatab$file
+ rvs$gui$datatab$tag
+ res <- gen_dfiles_tab(rvs$gui)
simple_style_dt(res,editable=list(target="cell",disable=list(columns=0)))
})
output$datatab <- DT::renderDT({
-
- rv_flag_datatab()
- setid <- rvs$m$input$tab$setid
- req(NROW(setid)>0)
- res <- rv_datatab()
-
-
- tab <- dropdown_dt(res, callback = dt_drop_callback('1','2',setid[,unique(set)]))
+ rvs$gui$datatab$tag
+ rvs$gui$datatab$set
+ rvs$gui$datatab$adduct
+ sets <- rf_get_subset()
+ dtab <- gen_dtab(rvs$gui$datatab,
+ sets=sets)
+ message("Hey")
+ print(dtab)
+ tab <- dropdown_dt(dtab, callback = dt_drop_callback('1','2',sets))
tab
})
--
GitLab