From 2c1d9cffad8a7a140f03a99c56bfdd28749cefcd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Tue, 28 Feb 2023 00:29:38 +0100
Subject: [PATCH] Use datatab_update_tags and datatab_add_files to define
datatab creation.
---
R/shiny-state.R | 54 +++++++++---------------
R/shiny-ui-base.R | 61 ++++++++++++++++------------
inst/rmd/app_project.Rmd | 25 +++++-------
tests/testthat/_snaps/shiny-state.md | 36 ++++++++++++++++
tests/testthat/test-shiny-state.R | 23 +++++++++++
5 files changed, 122 insertions(+), 77 deletions(-)
diff --git a/R/shiny-state.R b/R/shiny-state.R
index 902665f..6759ecd 100644
--- a/R/shiny-state.R
+++ b/R/shiny-state.R
@@ -91,7 +91,7 @@ datatab_update_tags <- function(tab,tags,files) {
## Adapt existing tags.
- res = merge(nft,oldt,by=c("file","tag"),all.x=T)
+ res = merge(nft,oldt,by=c("file","tag"),all.y=T)
tab$tag = res$tag
tab$file= res$file
tab$set = res$set
@@ -100,46 +100,30 @@ datatab_update_tags <- function(tab,tags,files) {
}
datatab_add_files <- function(tab,sets,adducts,tags,files) {
+ check_len_zero(sets,"sets")
+ check_len_zero(adducts,"adducts")
+ check_len_zero(files,"files")
+ check_same_len(files,"files",tags,"tags")
- check_same_len(files,tags)
-
- nft = data.table(tag=tags,
- file=files,key="file")
+ nrows = prod(length(sets),length(adducts),length(tags))
+
+ nft = as.data.table(expand.grid(tag=tags,
+ set=sets,
+ adduct=adducts),key="tag")
+ ftt=data.table(tag=tags,file=files,key="tag")
+ nft[ftt,file:=i.file]
oldt = data.table(tag=tab$tag,
adduct=tab$adduct,
set=tab$set,
- file=tab$file,key=c("file"))
-
+ file=tab$file,key=c("tag","file"))
- ## Adapt existing tags.
- oldt[nft,tag:=i.tag]
+ res = merge(nft,oldt,by=c("tag","adduct","set","file"),all=T)
-
- if (length(files)>0 ||(length(sets)>0L || length(adducts)>0L)) {
- ## We are adding new set/adduct entries.
- check_len_zero(sets,"sets")
- check_len_zero(adducts,"adducts")
- check_len_zero(files,"files")
- rows = prod(length(files),length(sets),length(adducts))
- newt = data.table(tag=rep(tags,rows/length(tags)),
- adduct=rep(adducts,rows/length(adducts)),
- set=rep(sets,rows/length(sets)),
- file=rep(files,rows/length(files)))
-
- if (length(files)>0L) {
- ## Modifying files.
-
- ## Add new set and adduct entries to the old table.
- fullt = newt[oldt,on=c("set","adduct")]
-
- ## Now, add/remove files as needed.
- ## nft2 = newt[,..nft,by=c
- ## res = fullt[nft,on=c("tag","adduct","set","file")]
-
-
- }
-
- }
+ tab$tag=res$tag
+ tab$adduct=res$adduct
+ tab$set=res$set
+ tab$file=res$file
+ tab
}
#' @export
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index 932d2a9..fb719c6 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -1102,12 +1102,22 @@ mk_shinyscreen_server <- function(projects,init) {
rmv = input$datafiles_rows_selected
rvs$gui$filetag$file = rvs$gui$filetag$file[-rmv]
rvs$gui$filetag$tag = rvs$gui$filetag$tag[-rmv]
- ## rvs$gui$datatab$file = rvs$gui$datatab$file[-rmv]
- ## rvs$gui$datatab$set = rvs$gui$datatab$set[-rmv]
- ## rvs$gui$datatab$adduct = rvs$gui$datatab$adduct[-rmv]
- ## rvs$gui$datatab$tag = rvs$gui$datatab$tag[-rmv]
+
+ keep = rvs$gui$datatab$tag %in% rvs$gui$filetag$tag
+ rvs$gui$datatab$file = rvs$gui$datatab$file[keep]
+ rvs$gui$datatab$tag = rvs$gui$datatab$tag[keep]
+ rvs$gui$datatab$set = rvs$gui$datatab$set[keep]
+ rvs$gui$datatab$adduct = rvs$gui$datatab$adduct[keep]
+
}
})
+
+ observeEvent(input$rem_dtab_b,{
+ rvs$gui$datatab$file=character(0)
+ rvs$gui$datatab$tag=character(0)
+ rvs$gui$datatab$adduct=character(0)
+ rvs$gui$datatab$set=character(0)
+ })
observeEvent(input$datafiles_cell_edit,{
df = gen_dfiles_tab(rvs$gui)
@@ -1126,29 +1136,26 @@ mk_shinyscreen_server <- function(projects,init) {
files=files)
}, label = "datafiles-update-tags")
- observe({
- ## selected_adducts = input$tag_adducts_list
- ## ## selected_adducts[selected_adducts == "NA"] = NA_character_
- ## selected_sets = input$tag_sets_list
- ## ## selected_sets[selected_sets == "NA"] = NA_character_
- ## selected_rows = input$datafiles_rows_selected
- ## if (isTruthy(selected_rows)) {
- ## selected_tags = rvs$gui$datafiles$tag[selected_rows]
- ## dt_rows = which(rvs$gui$datatab$tag %in% selected_tags)
- ## if (isTruthy(selected_sets)) {
- ## rvs$gui$datatab$set[dt_rows] = selected_sets
- ## updateSelectInput(session=session,
- ## inputId="tag_adducts_list",
- ## selected=NULL)
- ## }
-
- ## if (isTruthy(selected_adducts)) {
- ## rvs$gui$datatab$adduct[dt_rows] = selected_adducts
- ## updateSelectInput(session=session,
- ## inputId="tag_sets_list",
- ## selected=NULL)
- ## }
- ## }
+ observeEvent(input$fill_datatab_b,{
+ selected_adducts = input$tag_adducts_list
+ selected_sets = input$tag_sets_list
+ selected_rows = input$datafiles_rows_selected
+ if (isTruthy(selected_rows)) {
+ selected_files = rvs$gui$filetag$file[selected_rows]
+ selected_tags = rvs$gui$filetag$tag[selected_rows]
+ if (!isTruthy(selected_sets)) selected_sets = rf_get_sets()
+ if (isTruthy(selected_adducts)) {
+ rvs$gui$datatab = datatab_add_files(rvs$gui$datatab,
+ sets = selected_sets,
+ tags = selected_tags,
+ adducts = selected_adducts,
+ files = selected_files)
+ } else {
+ shinymsg("You need to select some adducts.",type="warning")
+ }
+ } else {
+ shinymsg("You need to select some files.",type="warning")
+ }
}, label = "datatab-construct")
diff --git a/inst/rmd/app_project.Rmd b/inst/rmd/app_project.Rmd
index 241bf44..0cdbe75 100644
--- a/inst/rmd/app_project.Rmd
+++ b/inst/rmd/app_project.Rmd
@@ -214,16 +214,10 @@ htmlOutput('sets_report')
### Data files
<details><summary>Load data files</summary>
-Shinyscreen currently supports only the **mzML** file format. After
-loading the files, set file tags in the file table (column
-**tag**). Additionally, specify a set of compounds that is supposed
-to be extracted from the file using the **set** column. Finally,
-specify the **adduct** in the adduct column. In case of compounds
-with unknown structure and formula, the adduct is ignored for obvious
-reasons.
-Select datafiles of interest from the list and confirm the selection
-by clicking `Select`.
+Shinyscreen currently supports only the **mzML** file format. After
+loading the files, select the files, then associate them with
+appropriate sets and adducts .
</details>
```{r, echo=FALSE}
@@ -269,28 +263,29 @@ selectInput(inputId="tag_sets_list",
## multiple=T, #TODO
choices=NULL,
selected=NULL)
-```
-```{r, echo=F}
selectInput(inputId="tag_adducts_list",
label="Select adducts",
choices=shinyscreen:::DISP_ADDUCTS,
multiple=T,
selected=NULL)
+actionButton(inputId="fill_datatab_b",
+ label="Fill table")
```
+
<!-- tag/adduct/set associations -->
</div>
<div>
<!-- datafiles/adducts/tags -->
<details>
-<summary>Assign sets to tags.</summary>
+<summary>This is the data files table.</summary>
-For each tag, assign a set and an adduct (if the structure information
-exists, otherwise _adduct_ column is ignored).
+Establishes relationships between tags, sets and adducts.
</details>
```{r, echo=F}
-DT::DTOutput("datatab") ## DT::DTOutput("datatab",width="25%")
+DT::DTOutput("datatab")
+actionButton("rem_dtab_b",label="Reset table")
```
</div><!-- datafiles/adducts/tags -->
diff --git a/tests/testthat/_snaps/shiny-state.md b/tests/testthat/_snaps/shiny-state.md
index 1587227..a6818cd 100644
--- a/tests/testthat/_snaps/shiny-state.md
+++ b/tests/testthat/_snaps/shiny-state.md
@@ -106,3 +106,39 @@
[1] "fx.f" "fy.f"
+# datatab_add_files does what's intended
+
+ Code
+ out1
+ Output
+ $tag
+ [1] "t1" "t1" "t1" "t2" "t2" "t2"
+
+ $adduct
+ [1] "a1" "a2" "a3" "a1" "a2" "a3"
+
+ $set
+ [1] "set" "set" "set" "set" "set" "set"
+
+ $file
+ [1] "t1.x" "t1.x" "t1.x" "t2.x" "t2.x" "t2.x"
+
+
+---
+
+ Code
+ out2
+ Output
+ $tag
+ [1] "t1" "t1" "t1" "t2" "t2" "t2" "t3" "t3" "t3" "t3"
+
+ $adduct
+ [1] "a1" "a2" "a3" "a1" "a2" "a3" "a1" "a1" "a5" "a5"
+
+ $set
+ [1] "set" "set" "set" "set" "set" "set" "set2" "set3" "set2" "set3"
+
+ $file
+ [1] "t1.x" "t1.x" "t1.x" "t2.x" "t2.x" "t2.x" "t3.x" "t3.x" "t3.x" "t3.x"
+
+
diff --git a/tests/testthat/test-shiny-state.R b/tests/testthat/test-shiny-state.R
index a626254..32abccf 100644
--- a/tests/testthat/test-shiny-state.R
+++ b/tests/testthat/test-shiny-state.R
@@ -50,3 +50,26 @@ test_that("datatab_update_tags works properly",{
})
+
+
+test_that("datatab_add_files does what's intended",{
+ tab1=list(tag=character(0),
+ adduct=character(0),
+ set=character(0),
+ file=character(0))
+ out1 = datatab_add_files(tab=tab1,
+ sets="set",
+ tags=c("t1","t2"),
+ adducts=c("a1","a2","a3"),
+ files=c("t1.x","t2.x"))
+ expect_snapshot(out1)
+
+ tab2=out1
+ out2 = datatab_add_files(tab=tab2,
+ sets=c('set2','set3'),
+ tags=c('t3'),
+ adducts=c('a1','a5'),
+ files=c('t3.x'))
+ expect_snapshot(out2)
+
+})
--
GitLab