Skip to content
Snippets Groups Projects
Commit 2c1d9cff authored by Todor Kondić's avatar Todor Kondić
Browse files

Use datatab_update_tags and datatab_add_files to define datatab creation.

parent 5633ea36
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
R/shiny-state.R
+ 19
− 35
View file @ 2c1d9cff
...@@ -91,7 +91,7 @@ datatab_update_tags <- function(tab,tags,files) { ...@@ -91,7 +91,7 @@ datatab_update_tags <- function(tab,tags,files) {
## Adapt existing tags. ## 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$tag = res$tag
tab$file= res$file tab$file= res$file
tab$set = res$set tab$set = res$set
...@@ -100,46 +100,30 @@ datatab_update_tags <- function(tab,tags,files) { ...@@ -100,46 +100,30 @@ datatab_update_tags <- function(tab,tags,files) {
} }
datatab_add_files <- function(tab,sets,adducts,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) nrows = prod(length(sets),length(adducts),length(tags))
nft = data.table(tag=tags, nft = as.data.table(expand.grid(tag=tags,
file=files,key="file") 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, oldt = data.table(tag=tab$tag,
adduct=tab$adduct, adduct=tab$adduct,
set=tab$set, set=tab$set,
file=tab$file,key=c("file")) file=tab$file,key=c("tag","file"))
## Adapt existing tags. res = merge(nft,oldt,by=c("tag","adduct","set","file"),all=T)
oldt[nft,tag:=i.tag]
tab$tag=res$tag
if (length(files)>0 ||(length(sets)>0L || length(adducts)>0L)) { tab$adduct=res$adduct
## We are adding new set/adduct entries. tab$set=res$set
check_len_zero(sets,"sets") tab$file=res$file
check_len_zero(adducts,"adducts") tab
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")]
}
}
} }
#' @export #' @export
......
R/shiny-ui-base.R
+ 34
− 27
View file @ 2c1d9cff
...@@ -1102,12 +1102,22 @@ mk_shinyscreen_server <- function(projects,init) { ...@@ -1102,12 +1102,22 @@ mk_shinyscreen_server <- function(projects,init) {
rmv = input$datafiles_rows_selected rmv = input$datafiles_rows_selected
rvs$gui$filetag$file = rvs$gui$filetag$file[-rmv] rvs$gui$filetag$file = rvs$gui$filetag$file[-rmv]
rvs$gui$filetag$tag = rvs$gui$filetag$tag[-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] keep = rvs$gui$datatab$tag %in% rvs$gui$filetag$tag
## rvs$gui$datatab$adduct = rvs$gui$datatab$adduct[-rmv] rvs$gui$datatab$file = rvs$gui$datatab$file[keep]
## rvs$gui$datatab$tag = rvs$gui$datatab$tag[-rmv] 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,{ observeEvent(input$datafiles_cell_edit,{
df = gen_dfiles_tab(rvs$gui) df = gen_dfiles_tab(rvs$gui)
...@@ -1126,29 +1136,26 @@ mk_shinyscreen_server <- function(projects,init) { ...@@ -1126,29 +1136,26 @@ mk_shinyscreen_server <- function(projects,init) {
files=files) files=files)
}, label = "datafiles-update-tags") }, label = "datafiles-update-tags")
observe({ observeEvent(input$fill_datatab_b,{
## selected_adducts = input$tag_adducts_list selected_adducts = input$tag_adducts_list
## ## selected_adducts[selected_adducts == "NA"] = NA_character_ selected_sets = input$tag_sets_list
## selected_sets = input$tag_sets_list selected_rows = input$datafiles_rows_selected
## ## selected_sets[selected_sets == "NA"] = NA_character_ if (isTruthy(selected_rows)) {
## selected_rows = input$datafiles_rows_selected selected_files = rvs$gui$filetag$file[selected_rows]
## if (isTruthy(selected_rows)) { selected_tags = rvs$gui$filetag$tag[selected_rows]
## selected_tags = rvs$gui$datafiles$tag[selected_rows] if (!isTruthy(selected_sets)) selected_sets = rf_get_sets()
## dt_rows = which(rvs$gui$datatab$tag %in% selected_tags) if (isTruthy(selected_adducts)) {
## if (isTruthy(selected_sets)) { rvs$gui$datatab = datatab_add_files(rvs$gui$datatab,
## rvs$gui$datatab$set[dt_rows] = selected_sets sets = selected_sets,
## updateSelectInput(session=session, tags = selected_tags,
## inputId="tag_adducts_list", adducts = selected_adducts,
## selected=NULL) files = selected_files)
## } } else {
shinymsg("You need to select some adducts.",type="warning")
## if (isTruthy(selected_adducts)) { }
## rvs$gui$datatab$adduct[dt_rows] = selected_adducts } else {
## updateSelectInput(session=session, shinymsg("You need to select some files.",type="warning")
## inputId="tag_sets_list", }
## selected=NULL)
## }
## }
}, label = "datatab-construct") }, label = "datatab-construct")
......
inst/rmd/app_project.Rmd
+ 10
− 15
View file @ 2c1d9cff
...@@ -214,16 +214,10 @@ htmlOutput('sets_report') ...@@ -214,16 +214,10 @@ htmlOutput('sets_report')
### Data files ### Data files
<details><summary>Load data files</summary> <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 Shinyscreen currently supports only the **mzML** file format. After
by clicking `Select`. loading the files, select the files, then associate them with
appropriate sets and adducts .
</details> </details>
```{r, echo=FALSE} ```{r, echo=FALSE}
...@@ -269,28 +263,29 @@ selectInput(inputId="tag_sets_list", ...@@ -269,28 +263,29 @@ selectInput(inputId="tag_sets_list",
## multiple=T, #TODO ## multiple=T, #TODO
choices=NULL, choices=NULL,
selected=NULL) selected=NULL)
```
```{r, echo=F}
selectInput(inputId="tag_adducts_list", selectInput(inputId="tag_adducts_list",
label="Select adducts", label="Select adducts",
choices=shinyscreen:::DISP_ADDUCTS, choices=shinyscreen:::DISP_ADDUCTS,
multiple=T, multiple=T,
selected=NULL) selected=NULL)
actionButton(inputId="fill_datatab_b",
label="Fill table")
``` ```
<!-- tag/adduct/set associations --> <!-- tag/adduct/set associations -->
</div> </div>
<div> <div>
<!-- datafiles/adducts/tags --> <!-- datafiles/adducts/tags -->
<details> <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 Establishes relationships between tags, sets and adducts.
exists, otherwise _adduct_ column is ignored).
</details> </details>
```{r, echo=F} ```{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 --> </div><!-- datafiles/adducts/tags -->
......
tests/testthat/_snaps/shiny-state.md
+ 36
− 0
View file @ 2c1d9cff
...@@ -106,3 +106,39 @@ ...@@ -106,3 +106,39 @@
[1] "fx.f" "fy.f" [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"
tests/testthat/test-shiny-state.R
+ 23
− 0
View file @ 2c1d9cff
...@@ -50,3 +50,26 @@ test_that("datatab_update_tags works properly",{ ...@@ -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)
})
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment