From b167abee8d0a9afd0fac0856b56fdcd99c4cb22d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <todor.kondic@uni.lu>
Date: Wed, 15 Jun 2022 10:19:56 +0200
Subject: [PATCH] api, mix, shiny-ui-base: Introduce the concept of "project"
and "data"directories for script-based workflow.
---
DESCRIPTION | 2 +-
NAMESPACE | 3 +-
R/api.R | 128 +++++++++++++++++++++-------------------------
R/mix.R | 20 ++++----
R/shiny-ui-base.R | 10 ++--
5 files changed, 76 insertions(+), 87 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index a7bc2bc..832e125 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: shinyscreen
Title: Pre-screening of Mass Spectrometry Data
-Version: 1.0.13
+Version: 1.1.0
Author: Todor Kondić
Maintainer: Todor Kondić <todor.kondic@uni.lu>
Authors@R:
diff --git a/NAMESPACE b/NAMESPACE
index 75bc9d3..915ee97 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -23,15 +23,14 @@ export(merge2rev)
export(mk_comp_tab)
export(mk_tol_funcs)
export(mz_input)
+export(new_project)
export(new_rv_state)
export(new_state)
-export(new_state_fn_conf)
export(plot_struct)
export(plot_struct_nowrap)
export(prescreen)
export(read_rt)
export(report)
-export(report_old)
export(rev2list)
export(rt_input)
export(run)
diff --git a/R/api.R b/R/api.R
index 44d4308..a3f7260 100644
--- a/R/api.R
+++ b/R/api.R
@@ -23,14 +23,52 @@ new_state <- function() {
new_rv_state <- function() react_v(m=list2rev(new_state()))
##' @export
-new_state_fn_conf <- function(fn_conf) {
+new_project <- function(project) {
m <- new_state()
+ if (!is.character(project)) stop("Argument `project' must be a character string.")
+ if (!dir.exists(project)) stop('Project directory either does not exist, or is unreadable.')
+ project_path <- normalizePath(project)
+ project <- basename(project)
+ fn_conf <- file.path(project_path,FN_CONF)
m$conf <- read_conf(fn_conf)
- init_state(m)
+ m$conf$project <- project
+ m$conf$paths$project <- project_path
+ if (is.null(m$conf$paths$data)) {
+ m$conf$paths$data <- m$conf$paths$project
+ }
+ if (!dir.exists(m$conf$paths$data)) stop("Path to data directory either does not exist, or is inaccesible.")
+ lst_cmpl <- m$conf$compounds$lists
+ lst_fn_cmpl <- lapply(names(lst_cmpl),function (nm) {
+ bfn_cmpl <- lst_cmpl[[nm]]
+ fn <- file.path(m$conf$paths$project,bfn_cmpl)
+ if (!file.exists(fn)) stop("File ", fn, " does not exist in ", m$conf$paths$project," .")
+ fn
+ })
+ names(lst_fn_cmpl) <- names(lst_cmpl)
+ m$conf$paths$compounds$lists <- lst_fn_cmpl
+
+ fn_sets <- m$conf$compounds$sets[[1]] #It's always only one.
+ if (!file.exists(fn_sets)) stop("File ", fn_sets, " does not exist in ", m$conf$paths$project," .")
+ m$conf$paths$compounds$sets <- fn_sets
+
+ tmp <- m$conf$paths$datatab
+ datatab <- if (!is.null(tmp)) {
+ if (file.exists(tmp)) {
+ tmp
+ } else {
+ file.path(m$conf$paths$project,tmp)
+ }
+ } else {
+ file.path(m$conf$paths$project,FN_DATA_TAB)
+ }
+ if (!file.exists(datatab)) stop("A CSV file with data file entries does not exist (`paths$datatab' in config).")
+ datatab <- normalizePath(datatab)
+ m$conf$paths$datatab <-datatab
+ m
}
##' @export
-run <- function(fn_conf="",m=NULL,phases=NULL,help=F) {
+run <- function(project="",m=NULL,phases=NULL,help=F) {
all_phases=list(setup=setup_phase,
comptab=mk_comp_tab,
extract=extr_data,
@@ -54,14 +92,11 @@ run <- function(fn_conf="",m=NULL,phases=NULL,help=F) {
all_phases[phases]
}
- m <- if (nchar(fn_conf)!=0) new_state_fn_conf(fn_conf) else if (!is.null(m)) m else stop("(run): Either the YAML config file (fn_conf),\n or the starting state (m) must be provided\n as the argument to the run function.")
-
- dir.create(m$conf$project,
- showWarnings = F,
- recursive = T)
- m <- withr::with_dir(new=m$conf$project,code = Reduce(function (prev,f) f(prev),
- x = the_phases,
- init = m))
+ m <- if (nchar(project)!=0) new_project(project) else if (!is.null(m)) m else stop("(run): Either the YAML config file (project),\n or the starting state (m) must be provided\n as the argument to the run function.")
+ ## m$conf$project <- normalizePath(m$conf$project) #FIXME: Test in all workflows!
+ m <- withr::with_dir(new=m$conf$paths$project,code = Reduce(function (prev,f) f(prev),
+ x = the_phases,
+ init = m))
return(invisible(m))
}
@@ -95,7 +130,7 @@ run_in_dir <- function(m) {
load_compound_input <- function(m) {
coll <- list()
fields <- colnames(EMPTY_CMPD_LIST)
- fns <- m$conf$compounds$lists
+ fns <- m$conf$paths$compounds$lists
coltypes <- c(ID="character",
SMILES="character",
Formula="character",
@@ -138,15 +173,18 @@ load_compound_input <- function(m) {
cmpds[,("known"):=.(the_ifelse(!is.na(SMILES),"structure",the_ifelse(!is.na(Formula),"formula","mz")))]
m$input$tab$cmpds <- cmpds
- m$input$tab$setid <- read_setid(m$conf$compounds$sets,
+ m$input$tab$setid <- read_setid(m$conf$paths$compounds$sets,
m$input$tab$cmpds)
m
}
##' @export
load_data_input <- function(m) {
- m$input$tab$mzml <- file2tab(m$conf$data)
+ m$input$tab$mzml <- file2tab(m$conf$paths$datatab)
assert(all(unique(m$input$tab$mzml[,.N,by=c("adduct","tag")]$N)<=1),msg="Some rows in the data table contain multiple entries with same tag and adduct fields.")
+ pref<-m$conf$paths$data
+ m$input$tab$mzml[,file:=fifelse(file.exists(file),file,file.path(..pref,file))]
+ m$input$tab$mzml[,file:=normalizePath(file)]
m
}
@@ -168,8 +206,9 @@ mk_comp_tab <- function(m) {
setkey(cmpds,ID)
## mzml[,`:=`(wd=sapply(file,add_wd_to_mzml,m$conf$project))]
assert(nrow(cmpds)>0,msg="No compound lists have been provided.")
+ assert(all(mzml[,unique(set)] %in% setid[,unique(set)]),msg="Not all set names in the `datatab' data file table match those in the provided set list.")
message("Begin generation of the comprehensive table.")
-
+
comp <- cmpds[setid,on="ID"][mzml,.(tag,adduct,ID,RT,set,Name,file,SMILES,Formula,mz,known),on="set",allow.cartesian=T]
tab2file(tab=comp,file=paste0("setidmerge",".csv"))
setkey(comp,known,set,ID)
@@ -272,7 +311,7 @@ verify_data_df <- function(mzml,all_sets) {
verify_data <- function(conf,all_sets) {
## * Existence of input files
- fn_data <- conf$data
+ fn_data <- conf$paths$data
assert(isThingFile(fn_data),msg=paste("Data table does not exist:",fn_data))
mzml <- file2tab(fn_data)
verify_data_df(mzml=mzml,all_sets)
@@ -439,7 +478,7 @@ extr_data_future <- function(m) {
fn_ex <- get_fn_extr(m)
timetag <- format(Sys.time(), "%Y%m%d_%H%M%S")
- saveRDS(object = m, file = file.path(m$conf$project,
+ saveRDS(object = m, file = file.path(m$conf$paths$project,
paste0(timetag,"_",FN_EXTR_STATE)))
m
@@ -514,7 +553,7 @@ extr_data_serial <- function(m) {
fn_ex <- get_fn_extr(m)
timetag <- format(Sys.time(), "%Y%m%d_%H%M%S")
- saveRDS(object = m, file = file.path(m$conf$project,
+ saveRDS(object = m, file = file.path(m$conf$paths$project,
paste0(timetag,"_",FN_EXTR_STATE)))
m
@@ -689,55 +728,6 @@ create_plots <- function(m) {
m
}
-#' @export
-report_old <- function(m) {
- figtopdir <- FIG_TOPDIR #file.path(m$conf$project,FIG_TOPDIR)
- pander::evalsOptions("graph.output","pdf")
- author <- if (!is.null(m$conf$report$author)) m$conf$report$author else REPORT_AUTHOR
- title <- if (!is.null(m$conf$report$title)) m$conf$report$title else REPORT_TITLE
- doc <- pander::Pandoc$new(author,title)
- doc$add(pander::pandoc.header.return("Plots",level = 1))
- sets <- m$out$tab$flt_summ[,unique(set)]
- rep_theme <- ggplot2::labs(title = NULL)
- for (s in sets) {
- doc$add(pander::pandoc.header.return(paste('Set', s), level = 2))
- sdf <- m$out$tab$flt_summ[set==s,]
- group <- sdf[,unique(adduct)]
- for (g in group) {
- asdf <- sdf[adduct==g,]
- ids <- asdf[,unique(ID)]
- for (id in ids) {
- message("Image ","set: ",s," group: ", g, " id: ",id)
- doc$add(pander::pandoc.header.return(paste('ID',id),level = 3))
- tab <- asdf[ID==id,.(tag,ms1_int,ms1_rt,adduct,mz,file)]
- ms2info <- m$out$tab$ms2_spec[adduct==g & ID==id,.(tag,ID,rt,ms2_max_int,file)]
- tab2 <- tab[ms2info,on="file"][,.(tag,mz,adduct,"$RT_{ms1}$[min]"=ms1_rt,"$RT_{ms2}$[min]"=rt,"$I{ms1}$"=formatC(ms1_int, format="e",digits = 2), "$I(ms2)$"= formatC(ms2_max_int, format="e",digits = 2))]
- data.table::setorderv(tab2,c("$I{ms1}$","$I(ms2)$"),c(-1,-1))
- doc$add.paragraph("")
- figpath <- fig_path(top=figtopdir,set=s,group=g,id=id,suff="all",ext="pdf")
- doc$add(pander::pandoc.image.return(img=paste0("file:",figpath)))
- doc$add.paragraph("")
- message("Adding table.")
- doc$add.paragraph(pander::pandoc.table.return(tab2))
- message("Done adding table.")
- ## doc$add(print(tab))
- doc$add.paragraph("")
-
- }
-
- }
- }
- doc$add(pander::pandoc.header.return("Appendix", level = 1))
- doc$add(pander::pandoc.header.return("Configuration",level = 2))
- doc$add(m$conf)
- doc$add(pander::pandoc.header.return("R Session Info",level = 2))
- doc$add(sessionInfo())
- m$out$report <- doc
- m$out$report$export('report.pdf')
- m
-}
-
-
#' @export
#' @title app
#' @param shiny_args `list`, optional list of arguments conveyed to
@@ -870,12 +860,12 @@ report <- function(m) {
message("(report) Knitting of chunk ",n," out of ",NROW(keytab)," has been completed.")
}
- fn_rep <- file.path(m$conf$project,"report.Rmd")
+ fn_rep <- file.path(m$conf$paths$project,"report.Rmd")
message("(report) Writing Rmd...")
cat(repdoc,file=fn_rep,sep = "\n")
message("(report) ...done.")
message("(report) Render start ...")
- rmarkdown::render(fn_rep,output_dir = m$conf$project)
+ rmarkdown::render(fn_rep,output_dir = m$conf$paths$project)
message("(report) ...done.")
m
}
diff --git a/R/mix.R b/R/mix.R
index 223972b..361bee9 100644
--- a/R/mix.R
+++ b/R/mix.R
@@ -497,8 +497,8 @@ read_setid <- function(fn,cmpds) {
write_conf <- function(m,fn) {
- m$conf$data <- get_fn_ftab(m)
- if (NROW(m$input$tab$mzml)>0) tab2file(tab=m$input$tab$mzml,file=file.path(m$conf$project,FN_DATA_TAB))
+ m$conf$paths$data <- get_fn_ftab(m)
+ if (NROW(m$input$tab$mzml)>0) tab2file(tab=m$input$tab$mzml,file=file.path(m$conf$paths$project,FN_DATA_TAB))
yaml::write_yaml(x=m$conf,file=fn)
@@ -506,12 +506,12 @@ write_conf <- function(m,fn) {
}
write_state <- function(m,fn_conf) {
write_conf(m,fn_conf)
- tab2file(tab=m$input$tab$mzml,file=file.path(m$conf$project,FN_DATA_TAB))
+ tab2file(tab=m$input$tab$mzml,file=file.path(m$conf$paths$project,FN_DATA_TAB))
}
read_conf <- function(fn) {
cf <- yaml::yaml.load_file(fn)
- fnl <- cf$compound$lists
+ fnl <- cf$compounds$lists
if (length(fnl)>0) {
nms <- character(0)
for (i in 1:length(fnl)) {
@@ -520,7 +520,7 @@ read_conf <- function(fn) {
names(fnl) <- nms
}
- cf$compound$lists <- fnl
+ cf$compounds$lists <- fnl
## conf_trans(cf)
cf
}
@@ -529,28 +529,28 @@ read_conf <- function(fn) {
##' @export
get_fn_comp <- function(m) {
- file.path(m$conf$project,FN_COMP_TAB)
+ file.path(m$conf$paths$project,FN_COMP_TAB)
}
##' @export
get_fn_summ <- function(m) {
- file.path(m$conf$project, FN_SUMM)
+ file.path(m$conf$paths$project, FN_SUMM)
}
##' @export
get_fn_extr <- function(m) {
- file.path(m$conf$project, "extracted.rds")
+ file.path(m$conf$paths$project, "extracted.rds")
}
##' @export
get_fn_conf <- function(m) {
- file.path(m$conf$project, FN_CONF)
+ file.path(m$conf$paths$project, FN_CONF)
}
##' @export
get_fn_ftab <- function(m) {
- file.path(m$conf$project, FN_DATA_TAB)
+ file.path(m$conf$paths$project, FN_DATA_TAB)
}
init_state <- function(m) {
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index 993910e..ffad906 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -658,7 +658,7 @@ mk_shinyscreen_server <- function(projects,init) {
isolate({
rvs$m$conf$project <- in_conf$project
- rvs$m$conf$data <- in_conf$data
+ rvs$m$conf$paths <- in_conf$paths
## Lists
rvs$m$conf$compounds$lists <- in_conf$compounds$lists
rvs$m$conf$compounds$sets <- in_conf$compounds$sets
@@ -696,8 +696,8 @@ mk_shinyscreen_server <- function(projects,init) {
choices=c("min","s"))
## Files
- if (isTruthy(in_conf$data)) {
- df <- shinyscreen:::file2tab(in_conf$data)
+ if (isTruthy(in_conf$paths$data)) {
+ df <- shinyscreen:::file2tab(in_conf$paths$data)
dfile <- data.table::copy(df[,tag:=as.character(tag),with=T])
dfile <- dfile[,unique(.SD),.SDcol=c("file","tag")]
## rv_dfile(df[,.(file,tag),by=c("file","tag"),mult="first"][,file:=NULL])
@@ -827,7 +827,7 @@ mk_shinyscreen_server <- function(projects,init) {
rf_conf_state <- reactive({
state <- rf_conf_proj()
ftab <- get_fn_ftab(state)
- state$conf$data <- ftab
+ state$conf$paths$data <- ftab
state$conf[["summary table"]]$filter <- rf_get_subset()
state$conf[["summary table"]]$order <- rf_get_order()
state
@@ -1170,7 +1170,7 @@ mk_shinyscreen_server <- function(projects,init) {
yaml::write_yaml(m$conf,
file = fconf)
shinyscreen:::tab2file(tab=m$input$tab$mzml,file=ftab)
- m$conf$data <- ftab
+ m$conf$paths$data <- ftab
saveRDS(object=m,file=fn)
}
shinymsg("Saving state completed.")
--
GitLab