Skip to content
Snippets Groups Projects
Unverified Commit 76b1d884 authored by Todor Kondic's avatar Todor Kondic
Browse files

all: Major cleanup

parent 36e4378e
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
+ 3
− 7
View file @ 76b1d884
......@@ -50,18 +50,12 @@ Collate:
'extraction.R'
'api.R'
'shiny-ui-base.R'
'shiny-ui-config.R'
'shiny-ui-cmpd.R'
'shiny-ui-sets.R'
'shiny-ui-gen.R'
'shiny-ui-top.R'
Depends:
RMassBank,
RChemMass
Imports:
tools,
scales,
parallel,
future,
yaml,
mzR,
......@@ -77,4 +71,6 @@ Imports:
shiny,
shinydashboard,
shinyFiles,
rhandsontable
rhandsontable,
DT,
tcltk
NAMESPACE
+ 0
− 1
View file @ 76b1d884
......@@ -12,7 +12,6 @@ export(get_fn_extr)
export(get_fn_ftab)
export(get_fn_summ)
export(grab_unit)
export(launch)
export(list2rev)
export(load_compound_input)
export(load_data_input)
......
R/shiny-ui-cmpd.R deleted 100644 → 0
+ 0
− 74
View file @ 36e4378e
## Copyright (C) 2020 by University of Luxembourg
## Licensed under the Apache License, Version 2.0 (the "License");
## you may not use this file except in compliance with the License.
## You may obtain a copy of the License at
## http://www.apache.org/licenses/LICENSE-2.0
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
## Commentary:
##
## Defines compound lists tab.
mk_ui_cmpd <- function() {
## ***** Compound List Tab *****
cmpdsListBox<-prim_box(title="Compounds List",
rhandsontable::rHandsontableOutput("cmpdsCtrl"),
width=NULL)
compFileList <- shiny::verbatimTextOutput("filelist")
## shiny::tags$style(type="text/css", "#filelist {white-space: pre-wrap;}")
cmpListLayout <- shiny::fluidRow(shiny::column(
compFileList,
cmpdsListBox,
width = 12))
cmpListTab <- shinydashboard::tabItem(tabName="compList",
cmpListLayout)
compListSideItem <- shinydashboard::menuItem(text="Compound list",
tabName="compList",
icon=shiny::icon("table"))
return(list(tab=cmpListTab,
side=compListSideItem))
}
server_cmpd <- function(input,output,session,rv,rf,roots) {
output$filelist <- shiny::renderText({
header <- "Compounds list generated from files:"
cmpds <- rv$m$input$tab$cmpds
files <- unique(cmpds$ORIG)
entries <- sapply(files,function(fn) paste0('- ',fn))
paste(c(header,entries),collapse = '\n')
})
output$cmpdsCtrl <- rhandsontable::renderRHandsontable({
df<-rv$m$input$tab$cmpds
out<-if (!is.null(df)) {
df
} else {
EMPTY_CMPD_LIST
}
rhandsontable::rhandsontable(out,stretchH="all")
})
rv
}
R/shiny-ui-config.R deleted 100644 → 0
+ 0
− 387
View file @ 36e4378e
## Copyright (C) 2020 by University of Luxembourg
## Licensed under the Apache License, Version 2.0 (the "License");
## you may not use this file except in compliance with the License.
## You may obtain a copy of the License at
## http://www.apache.org/licenses/LICENSE-2.0
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
## Commentary:
##
## Defines config tab.
mk_ui_config <- function() {
browseFile <- function(title,
buttonName,
txtName,
buttonTxt="Import compound list.",
txtTxt="",
icon="file",
description=NULL,
...) {
prim_box(title=title,
shiny::h5(description),
collapsible=F,...)}
confImport <- prim_box(title="Import",
shiny::includeMarkdown(system.file("ui/compounds-list-button.md",package="shinyscreen")),
shinyFiles::shinyFilesButton("impCmpdsListB",
label="Import compound lists.",
title="",
icon=shiny::icon("file"),
multiple=T),
shiny::includeMarkdown(system.file("ui/compound-sets-button.md",package="shinyscreen")),
shinyFiles::shinyFilesButton("impSetIdB",
label="Import set ID table.",
title="",
icon=shiny::icon("file"),
multiple=T),
shiny::uiOutput("fnDataFilesCtrl"),
shinyFiles::shinyFilesButton("impDataFilesB",
label="Import data files table.",
title="",
icon=shiny::icon("file"),
multiple=F),
width=NULL)
confmzMLTags <- prim_box(title="Tags",
shiny::textInput("tagPropInp",
"What is a tag? (optional)",
value=TAG_DEF_DESC),
shiny::textInput("tagsInp",
"Comma-delimited list of tag types.",
value=""),
shiny::actionButton("updTagsB",
label = "Update tags.",
icon=shiny::icon("bomb")),
width=NULL)
confState <- prim_box(title="Configuration State",
shinyFiles::shinySaveButton(id="saveConfB",
label="Save project configuration.",
title="Save",
filename = FN_CONF,
"yaml"),
shinyFiles::shinyFilesButton(id="restoreConfB",
label="Restore project configuration.",
multiple=F,
title="Restore"),
shinyFiles::shinyDirButton(id="switchProjB",
label="Switch project.",
title="Switch project.",
icon=shiny::icon("recycle")),
shiny::actionButton(inputId="resetConfB",
label="Reset config (CAUTION!)",
icon=shiny::icon("trash")),
width=NULL)
confmzMLtab <-prim_box(title="Raw Files in mzML Format",
shiny::h5("Use this file table to assign adduct modes and tags to the data files."),
shinyFiles::shinyFilesButton("mzMLB",
label="Select mzML files",
title="Select mzML files",
icon=shiny::icon("files-o"),
multiple=T),
rhandsontable::rHandsontableOutput("mzMLtabCtrl"),
width=NULL)
confLayout <- shiny::fluidRow(shiny::column(confImport,
confmzMLTags,
confState,
width=4),
shiny::column(width=8,
confmzMLtab))
consumm <- shinydashboard::tabItem(tabName="config",
shiny::h2(GUI_TAB_TITLE[["conf"]]),
confLayout)
confSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["conf"]],
tabName="config",
icon=shiny::icon("user-cog"))
return(list(tab=consumm,
side=confSideItem))
}
react_conf_f <- function(input,output,session,rv,rf) {
## Reactive functions.
rf$get_tags_from_txt <- react_f({
## Tags in the text box.
input$updTagsB
isol(if (isTruthy(input$tagsInp)) unique(txt2tags(input$tagsInp)) else TAG_DEF)
})
rf$ctrl2mzml_df <- react_f({
x <- tryCatch(rhandsontable::hot_to_r(input$mzMLtabCtrl),error=function(m) NULL)
shiny::req(x)
x
})
rf$ctrl2mzml <- react_f({
dtable(rf$ctrl2mzml_df())
})
rf$get_all_sets <- react_f({
m <- rf$m_input_cmpds()
unique(m$input$tab$setid$set)})
rf$m_conf <- react_f({
m <- list()
m$conf$project <- rv$project_path
m$conf$compounds$cmpds <- input$cmpds #TODO multi-lists.
m$conf$compounds$sets <- input$sets
m$conf$data <- input$datafiles
verify_compounds(m$conf)
m
})
rf$m_input_cmpds <- react_f({
m <- rf$m_conf()
load_compound_input(m)
})
rf$m_input <- react_f({
m <- rf$m_input_cmpds()
mzml <- rf$ctrl2mzml()
verify_data_df(mzml=mzml,all_sets=rf$get_all_sets())
m$input$tab$mzml <- mzml
m
})
rf$m <- react_f(rf$m_input())
rf
}
server_conf <- function(input,output,session,rv,rf,roots) {
## ***** shinyFiles observers *****
shinyFiles::shinyFileChoose(input, 'impCmpdsListB',defaultRoot=roots$def_vol(),
defaultPath=roots$def_path(),roots=roots$get)
shinyFiles::shinyFileChoose(input, 'impSetIdB',defaultRoot=roots$def_vol(),
defaultPath=roots$def_path(),roots=roots$get)
shinyFiles::shinyFileChoose(input, 'impDataFilesB',defaultRoot=roots$def_vol(),
defaultPath=roots$def_path(),roots=roots$get)
shinyFiles::shinyFileSave(input, 'saveConfB',defaultRoot=roots$def_vol(),
defaultPath=roots$def_path(),roots=roots$get)
shinyFiles::shinyFileChoose(input, 'restoreConfB',defaultRoot=roots$def_vol(),
defaultPath=roots$def_path(),roots=roots$get)
shinyFiles::shinyFileChoose(input, 'mzMLB',defaultRoot=roots$def_vol(),
defaultPath=roots$def_path(),roots=roots$get)
shinyFiles::shinyDirChoose(input, 'switchProjB',
roots=roots$get,
defaultRoot = "Computer",
defaultPath = "")
obsrv_e(input$switchProjB,{
## Update volumes function as needed.
spath<-shinyFiles::parseDirPath(roots=roots$get,
selection=input$switchProjB)
path<- if(length(spath)>0) spath[[1]] else NA
if (shiny::isTruthy(path)) {
rv$project_path <- path
}
})
obsrv_e(input$saveConfB, {
m <- rf$m()
fn <- shinyFiles::parseSavePath(roots=roots$get,input$saveConfB)[["datapath"]]
validate1(fn,msg="Invalid file to save config to.")
write_state(m,fn)
})
obsrv_e(input$restoreConfB,{
fn <- shinyFiles::parseFilePaths(roots=roots$get,input$restoreConfB)[["datapath"]]
assert(file.exists(fn), msg="The file is unreadable.")
conf <- read_conf(fn)
rv$project_path <- conf$project
for (nm in names(conf$compounds)) {
shiny::updateTextInput(session=session,
inputId=nm,
value=conf$compounds[[nm]])
}
shiny::updateTextInput(session = session,
inputId = "datafiles",
value = conf$data)
fn <- conf$data
assert(fn,msg = "Bad data file table path.")
rv$work_mzml_pre <- file2tab(fn)
})
obsrv({
## update-files-on-restore
message("update-files-on-restore")
rv$work_mzml_pre
m <- rf$m_input_cmpds()
if (shiny::isTruthy(m$input$tab$setid)) {
isol({
all_sets <- rf$get_all_sets()
dt <- rv$work_mzml_pre
txt_tags <- rf$get_tags_from_txt()
dt_tags <- unique(dt$tag)
tags <- combine_tags(dt_tags,txt_tags)
inp_tags <- setdiff(tags,TAG_DEF)
shiny::updateTextInput(session = session,
inputId = "tagsInp",
value = inp_tags)
rv$work_mzml <- mzml2disp(dt, sets = all_sets, tags = tags)
})
} else assert(m$input$tab$setid, msg = "Compounds set table not built yet.")
})
obsrv_e(input$mzMLB,{
## update-files-on-mzmlb
m <- rf$m_input()
df <- tryCatch(rhandsontable::hot_to_r(input$mzMLtabCtrl),error=function (e) NULL)
shiny::req(df)
fchoice<-shinyFiles::parseFilePaths(roots = roots$get,input$mzMLB)
paths<-fchoice[["datapath"]]
tags <- rf$get_tags_from_txt()
df <- add_mzML_files(df,paths)
rv$work_mzml <- df
})
obsrv_e(input$updTagsB,{
message("update-tags:",Sys.time())
df <- rf$ctrl2mzml_df()
tags <- rf$get_tags_from_txt()
z <- factor(as.character(df$tag), levels = tags)
df$tag <- factor(sapply(as.character(z),function(x) if (!is.na(x)) x else TAG_DEF),levels = tags)
rv$work_mzml <- df
})
obsrv_e(rv$project_path,{
## update-roots
message("update-roots:",Sys.time())
shiny::req(rv$project_path)
dir <- normalizePath(rv$project_path,winslash = '/')
if (roots$get()[["project"]] != dir) {
roots$set(c("start"= roots$get()[['project']] ,
"project" = dir))
} else {
roots$set(c("project" = dir))
}
})
## ***** Render *****
## txt_file_input(inputId = 'cmpds',
## input = input,
## label = html("The list of cmpds. Required columns: <i>ID</i>, <i>SMILES</i>, <i>Name</i> and <i>RT</i> (the last two can be empty). Remember to quote <i>SMILES</i> and <i>Name</i> entries!"),
## fileB = 'impCmpdsListB',
## volumes=roots$get) #TODO multi-lists
## })
output$fnSetIdCtrl <- shiny::renderUI({
txt_file_input(inputId = 'sets',
input = input,
label = html("Compounds set table. Required columns <i>ID</i> and <i>set</i>."),
fileB = 'impSetIdB',
volumes=roots$get)
})
output$fnDataFilesCtrl <- shiny::renderUI({
m <- rf$m_conf()
txt_file_input(inputId = 'datafiles',
input = input,
label = html("Data files table. Required columns <i>Files</i>, <i>tag</i>, <i>set</i> and <i>adduct</i>."),
fileB = 'impDataFilesB',
volumes=roots$get,
default = file.path(m$conf$project, FN_DATA_TAB))
})
output$mzMLtabCtrl <- rhandsontable::renderRHandsontable({
df <- rv$work_mzml
m <- rf$m_input_cmpds()
if (!shiny::isTruthy(df)) {
all_sets <- rf$get_all_sets()
txt_tags <- rf$get_tags_from_txt()
df <- mzml2disp(EMPTY_MZML, sets = all_sets, tags = txt_tags)
}
rhandsontable::rhandsontable(df,stretchH="all")
})
rv
}
mzml2disp <- function(mzml,sets, tags) {
## Add factors for nicer rhandsontable output.
df <- as.data.frame(mzml,stringsAsFactors=F)
df$set <- factor(as.character(df$set),levels=c(SET_NA,sets))
df$set <- factor(sapply(as.character(df$set),function (x) if (!is.na(x)) x else SET_NA),levels = c(SET_NA,sets))
df$tag <- factor(df$tag,levels=tags)
df$adduct <- factor(df$adduct,levels=names(DISP_ADDUCTMAP))
df
}
disp2mzml <- function(df) {
df$set <- as.character(df$set)
df$adduct <- as.character(df$adduct)
df$tag <- as.character(df$tag)
dtable(df)
}
txt2tags <- function(txt) {
## Turns a string into tags
x <- if (shiny::isTruthy(txt)) {
trimws(unlist(strsplit(txt, ",")))
} else list()
as.list(c(TAG_DEF,x))
}
combine_tags <- function(df_tags,txt_tags) {
unique(c(TAG_DEF,df_tags,txt_tags))
}
add_mzML_files<-function(df,paths) {
lSet<-levels(df$set)
if (length(lSet > 0) && !is.na(lSet)) {
nR<-length(paths)
if (nR > 0) {
st <- nrow(df)+1
fi <- nrow(df)+nR
df[st:fi,'tag'] <- levels(df$tag)[[1]]
df[st:fi,'set'] <- levels(df$set)[[1]]
df[st:fi,'adduct'] <- levels(df$adduct)[[1]]
df[st:fi,'Files'] <- paths
}
} else {
warning("Define sets using the compound set table before trying to add files!")
}
df
}
R/shiny-ui-gen.R deleted 100644 → 0
+ 0
− 98
View file @ 36e4378e
## Copyright (C) 2020 by University of Luxembourg
## Licensed under the Apache License, Version 2.0 (the "License");
## you may not use this file except in compliance with the License.
## You may obtain a copy of the License at
## http://www.apache.org/licenses/LICENSE-2.0
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
## Commentary:
##
## Defines gen tab.
mk_ui_gen <- function() {
genBoxExtract<-prim_box(title="Extract Spectra",
num_input(inputId="genNoProc",
label="Number of processes: ",
value=1),
num_input_unit(inputId="errCoarse",
l1="Precursor m/z error (coarse) (+/-): ",
l2="[Da]",
value=MS1_ERR_COARSE),
num_input_unit("errFinePPM",
l1="Precursor m/z error (fine) (+/-): ",
l2="[ppm]",
value=MS1_ERR_FINE),
num_input_unit("errEIC",
l1="EIC m/z error (+/-): ",
l2="[Da]",
value=EIC_ERR),
num_input_unit("errRTWin",
l1="Retention time tolerance (+/-): ",
l2="[min]",
value=RT_EXTR_ERR),
shiny::uiOutput("genSetSelInpCtrl"),
shiny::actionButton(inputId="genRunB",
label="Run!",
icon=shiny::icon("bomb")),
width=NULL)
genBoxAutoQA<-prim_box(title="Automatic Quality Control",
num_input("intThreshMS1",
label="Intensity threshold (MS1): ",
value=MS1_INT_THOLD),
num_input("intThreshMS2",
label="Intensity threshold (MS2): ",
value=MS2_INT_THOLD),
num_input("noiseFac",
label="Signal-to-noise ratio: ",
value=MS1_SN_FAC),
num_input_unit("errRT",
l1="Retention time shift tolerance (+/-): ",
value=RT_SHIFT_ERR,
l2="[min]"),
shiny::actionButton(inputId="qaAutoB",
label="Preprocess!",
icon=shiny::icon("bomb")),
width=NULL)
genBoxProcessed<-prim_box(title="Processed Sets",
rhandsontable::rHandsontableOutput("genTabProcCtrl"),
width=NULL)
genTab<-shinydashboard::tabItem(tabName = "gen",
shiny::h2(GUI_TAB_TITLE[["gen"]]),
shiny::fluidRow(shiny::column(genBoxExtract,
width=4),
shiny::column(genBoxProcessed,
genBoxAutoQA,width=4)))
genSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["gen"]],
tabName="gen",
icon=shiny::icon("cogs"))
return(list(tab=genTab,
side=genSideItem))
}
server_gen <- function(input,output,session,rv,rf,roots) {
## **** Observers ****
obsrv({
## Run
message("run!")
m <- rf$m()
m <- mk_comp_tab(m)
message("done!")
})
rv
}
R/shiny-ui-sets.R deleted 100644 → 0
+ 0
− 49
View file @ 36e4378e
## Copyright (C) 2020 by University of Luxembourg
## Licensed under the Apache License, Version 2.0 (the "License");
## you may not use this file except in compliance with the License.
## You may obtain a copy of the License at
## http://www.apache.org/licenses/LICENSE-2.0
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
## Commentary:
##
## Defines compounds sets tab.
mk_ui_sets <- function() {
## ***** Sets of compounds *****
setIdBox<-prim_box(title="Compound Sets",
rhandsontable::rHandsontableOutput("setIdCtrl"),
width = NULL)
setIdLayout<-shiny::fluidRow(shiny::column(setIdBox,
width = 12))
setIdTab<-shinydashboard::tabItem(tabName="setId",
setIdLayout)
setIdSideItem <- shinydashboard::menuItem(text="Compound sets",
tabName="setId",
icon=shiny::icon("table"))
return(list(tab=setIdTab,
side=setIdSideItem))
}
server_sets <- function(input,output,session,rv,rf,roots) {
output$setIdCtrl<- rhandsontable::renderRHandsontable({
df<-rv$m$input$tab$setid
rhandsontable::rhandsontable(df,stretchH="all")
})
rv
}
R/shiny-ui-top.R deleted 100644 → 0
+ 0
− 107
View file @ 36e4378e
## Copyright (C) 2020 by University of Luxembourg
## Licensed under the Apache License, Version 2.0 (the "License");
## you may not use this file except in compliance with the License.
## You may obtain a copy of the License at
## http://www.apache.org/licenses/LICENSE-2.0
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
## Commentary:
##
## This is a top-level Shiny file to bind them all.
mk_ui <- function (fn_style) {
## Top-level UI function.
headerText <- "Shinyscreen"
header <- shinydashboard::dashboardHeader(title=headerText,
shinydashboard::dropdownMenuOutput("notify"))
## plugin-ui
conf <- mk_ui_config()
cmpd <- mk_ui_cmpd()
sets <- mk_ui_sets()
gen <- mk_ui_gen()
sidebar <- shinydashboard::dashboardSidebar(shinydashboard::sidebarMenu(id='tabs',
conf$side,
gen$side,
shiny::hr(),
shiny::h5("Inputs"),
cmpd$side,
sets$side,
shiny::hr()))
body <- shinydashboard::dashboardBody(
shiny::tags$head(shiny::tags$style(shiny::includeHTML(fn_style))),
shinydashboard::tabItems(conf$tab,
cmpd$tab,
gen$tab,
sets$tab))
shinydashboard::dashboardPage(
header,
sidebar,
body)
}
mk_shinyscreen <- function(wd=getwd(),fn_style=system.file('www/custom.css',package = 'shinyscreen')) {
roots <- mk_roots(wd)
server <- function(input,output,session) {
## Top-level server function.
rf <- list() # Container for all
# reactive functions.
rv <- new_rv_state(project=wd) # Container for all
# reactive values.
rf <- react_conf_f(input,output,session,rv=rv,rf=rf) # Config related r. functions.
## plugin-servers
rv <- server_conf(input,output,session,rv=rv,rf=rf,roots=roots)
rv <- server_cmpd(input,output,session,rv=rv,rf=rf,roots=roots)
rv <- server_sets(input,output,session,rv=rv,rf=rf,roots=roots)
rv <- server_gen(input,output,session,rv=rv,rf=rf,roots=roots)
obsrv_e(rv,{
message(paste("rv changed at ",Sys.time()))
})
session$onSessionEnded(function () {
stopApp()
})
}
shiny::shinyApp(ui=mk_ui(fn_style=fn_style),server=server)
}
##' @export
launch <- function(GUI=T,fn_conf="",wd=getwd(),...) {
if (GUI) {
app<-mk_shinyscreen(wd=wd)
shiny::runApp(appDir = app,...)
} else {
if (nchar(fn_conf)==0) {
fn_conf <- commandArgs(trailingOnly=T)[[1]]
}
return(run(fn_conf))
}
}
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