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) {
## 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
......
R/shiny-ui-base.R
+ 34
− 27
View file @ 2c1d9cff
......@@ -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")
......
inst/rmd/app_project.Rmd
+ 10
− 15
View file @ 2c1d9cff
......@@ -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 -->
......
tests/testthat/_snaps/shiny-state.md
+ 36
− 0
View file @ 2c1d9cff
......@@ -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"
tests/testthat/test-shiny-state.R
+ 23
− 0
View file @ 2c1d9cff
......@@ -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