diff --git a/DESCRIPTION b/DESCRIPTION
index 5e10d69353ddfcbf2087494543de7eab89c0901b..07e50c18526873fd1451653f4c21640e1ef0f2e2 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -47,6 +47,7 @@ Collate:
'base.R'
'resources.R'
'mix.R'
+ 'state.R'
'plotting.R'
'extraction.R'
'api.R'
diff --git a/NAMESPACE b/NAMESPACE
index b57cbd2925fbdd77df54773bbade1de32b72f121..82cb8f7cc7e5ffbc92ad35986ef3af201469ede5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -25,6 +25,7 @@ export(mk_tol_funcs)
export(mz_input)
export(new_empty_project)
export(new_project)
+export(new_runtime_state)
export(new_rv_state)
export(new_state)
export(plot_struct)
diff --git a/R/api.R b/R/api.R
index a03cfa751c48f0a27d325313a849aa239f9631ba..c0a988147b9a23b51b53e537d50759f1c8d8a31a 100644
--- a/R/api.R
+++ b/R/api.R
@@ -12,76 +12,6 @@
## See the License for the specific language governing permissions and
## limitations under the License.
-
-##' @export
-new_state <- function() {
- m <- new_conf()
- init_state(m)
-}
-
-##' @export
-new_rv_state <- function() react_v(m=list2rev(new_state()))
-
-
-
-##' @export
-new_empty_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)
- m$conf <- list()
- m$conf$project <- project
- m$conf$paths$project <- project_path
- m$conf$paths$data <- m$conf$paths$project
- m
-}
-##' @export
-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)
- 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(project="",m=NULL,phases=NULL,help=F) {
all_phases=list(setup=setup_phase,
@@ -198,7 +128,7 @@ load_compound_input <- function(m) {
load_data_input <- function(m) {
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
+ pref<-m$run$paths$data
m$input$tab$mzml[,file:=fifelse(file.exists(file),file,file.path(..pref,file))]
m$input$tab$mzml[,file:=normalizePath(file)]
m
@@ -331,7 +261,7 @@ verify_data_df <- function(mzml,all_sets) {
verify_data <- function(conf,all_sets) {
## * Existence of input files
- fn_data <- conf$paths$data
+ fn_data <- run$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)
@@ -499,7 +429,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$paths$project,
+ saveRDS(object = m, file = file.path(m$run$paths$project,
paste0(timetag,"_",FN_EXTR_STATE)))
m
@@ -574,7 +504,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$paths$project,
+ saveRDS(object = m, file = file.path(m$run$paths$project,
paste0(timetag,"_",FN_EXTR_STATE)))
m
@@ -881,12 +811,12 @@ report <- function(m) {
message("(report) Knitting of chunk ",n," out of ",NROW(keytab)," has been completed.")
}
- fn_rep <- file.path(m$conf$paths$project,"report.Rmd")
+ fn_rep <- file.path(m$run$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$paths$project)
+ rmarkdown::render(fn_rep,output_dir = m$run$paths$project)
message("(report) ...done.")
m
}
diff --git a/R/mix.R b/R/mix.R
index fbf05494476c61010dea0d12e6462a66ef7e3ed7..2d25089f4d8a2acd70b63a1c519cf86942f3d56e 100644
--- a/R/mix.R
+++ b/R/mix.R
@@ -496,112 +496,6 @@ read_setid <- function(fn,cmpds) {
}
-write_conf <- function(m,fn) {
- 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)
-
-
-
-}
-write_state <- function(m,fn_conf) {
- write_conf(m,fn_conf)
- 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$compounds$lists
- if (length(fnl)>0) {
- nms <- character(0)
- for (i in 1:length(fnl)) {
- nms <- gen_uniq_lab(nms,pref = 'L')
- }
- names(fnl) <- nms
-
- }
- cf$compounds$lists <- fnl
- ## conf_trans(cf)
- cf
-}
-
-
-
-##' @export
-get_fn_comp <- function(m) {
- file.path(m$conf$paths$project,FN_COMP_TAB)
-}
-
-##' @export
-get_fn_summ <- function(m) {
- file.path(m$conf$paths$project, FN_SUMM)
-}
-
-##' @export
-get_fn_extr <- function(m) {
- file.path(m$conf$paths$project, "extracted.rds")
-}
-
-##' @export
-get_fn_conf <- function(m) {
- file.path(m$conf$paths$project, FN_CONF)
-}
-
-
-##' @export
-get_fn_ftab <- function(m) {
- file.path(m$conf$paths$project, FN_DATA_TAB)
-}
-
-init_state <- function(m) {
- m$out$tab <- list()
- m$input$datafiles <- NULL
- m$input$tab$mzml <- EMPTY_MZML
- lab <- gen_uniq_lab(list(),pref="L")
- m$input$tab$lists <- list()
- m$input$tab[[lab[[1]]]] <- EMPTY_CMPD_LIST
- m$out$tab$comp <- EMPTY_COMP_TAB
- m
-}
-
-base_conf <- function () {
- m <- list()
- m$conf <- list(project=NA_character_,
- compounds=list(lists=list(),
- sets=""),
- debug = F)
- m
-}
-
-extr_conf <- function(m) {
- m$conf$tolerance <- list("ms1 coarse"=MS1_ERR_COARSE,
- "ms1 fine"=MS1_ERR_FINE,
- "eic"=EIC_ERR,
- "rt"=RT_EXTR_ERR)
- m$conf$extract <- list(missing_precursor_info=DEF_CONF_MISSING_PCS)
-
- m
-}
-
-presc_conf <- function(m) {
- m$conf$prescreen <- list("ms1_int_thresh"=MS1_INT_THOLD,
- "ms2_int_thresh"=MS2_INT_THOLD,
- "s2n"=MS1_SN_FAC,
- "ret_time_shift_tol"=RT_SHIFT_ERR)
- m
-}
-
-fig_conf <- function(m) {
- m$conf$figures$rt_min <- "NA_real_ min"
- m$conf$figures$rt_max <- "NA_real_ min"
- m$conf$figures$ext <- "pdf"
- m
-}
-
-new_conf <- function() fig_conf(
- presc_conf(
- extr_conf(
- base_conf())))
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index 96a9cdf9a1f3943ba89c1cc7fc825d484454143e..dc64bdeba82fbce27fab122985ca77f65bae7eb0 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -696,8 +696,8 @@ mk_shinyscreen_server <- function(projects,init) {
choices=c("min","s"))
## Files
- if (isTruthy(rvs$m$conf$paths$datatab)) {
- df <- shinyscreen:::file2tab(rvs$m$conf$paths$datatab)
+ if (isTruthy(rvs$m$run$paths$datatab)) {
+ df <- shinyscreen:::file2tab(rvs$m$run$paths$datatab)
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])
@@ -799,8 +799,8 @@ mk_shinyscreen_server <- function(projects,init) {
## REACTIVE FUNCTIONS
rf_compound_input_state <- reactive({
- sets <- rvs$m$conf$paths$compounds$sets
- lst <- as.list(rvs$m$conf$paths$compounds$lists)
+ sets <- rvs$m$run$paths$compounds$sets
+ lst <- as.list(rvs$m$run$paths$compounds$lists)
## TODO XXX
validate(need(length(lst)>0,
message = "Load the compound lists(s) first."))
@@ -821,7 +821,7 @@ mk_shinyscreen_server <- function(projects,init) {
rf_conf_proj <- reactive({
state <- rev2list(rvs$m)
- if (!is.null(state$conf$paths$project)) dir.create(state$conf$paths$project,showWarnings = F)
+ if (!is.null(state$run$paths$project)) dir.create(state$run$paths$project,showWarnings = F)
state
})
@@ -829,7 +829,7 @@ mk_shinyscreen_server <- function(projects,init) {
rf_conf_state <- reactive({
state <- rf_conf_proj()
ftab <- get_fn_ftab(state)
- state$conf$paths$datatab <- ftab
+ state$run$paths$datatab <- ftab
state$conf[["summary table"]]$filter <- rf_get_subset()
state$conf[["summary table"]]$order <- rf_get_order()
state
@@ -1143,7 +1143,7 @@ mk_shinyscreen_server <- function(projects,init) {
## rv_projects = rv_projects)
## rvs$m <- list2rev(readRDS(fn_state))
## rvs$m$conf$project <- input$proj_list
- ## rvs$m$conf$paths$project <- fullwd
+ ## rvs$m$run$paths$project <- fullwd
## update_gui(session = session,
## rv_dfile = rv_dfile,
## rv_datatab = rv_datatab,
@@ -1169,7 +1169,7 @@ mk_shinyscreen_server <- function(projects,init) {
observeEvent(input$save_proj_b,{
- fn <- file.path(rvs$m$conf$paths$project,FN_STATE)
+ fn <- file.path(rvs$m$run$paths$project,FN_STATE)
shinymsg(paste("Saving state to: ",fn,"Please wait.",sep="\n"))
message("(config) Saving state to: ", paste(fn,collapse = ","))
fn <- if (length(fn)>0 && nchar(fn[[1]])>0) fn else ""
@@ -1182,11 +1182,11 @@ mk_shinyscreen_server <- function(projects,init) {
yaml::write_yaml(m$conf,
file = fconf)
shinyscreen:::tab2file(tab=m$input$tab$mzml,file=ftab)
- m$conf$paths$datatab <- ftab
+ m$run$paths$datatab <- ftab
gui_inputs <- list()
gui_input_names <- which_gui_inputs()
gui_inputs <- shiny::reactiveValuesToList(input)[gui_input_names]
- fn_gui <- file.path(m$conf$paths$project,"gui.rds")
+ fn_gui <- file.path(m$run$paths$project,"gui.rds")
saveRDS(object=gui_inputs,file=fn_gui)
saveRDS(object=m,file=fn)
}
@@ -1196,13 +1196,13 @@ mk_shinyscreen_server <- function(projects,init) {
observeEvent(input$sel_indir_b,{
indir <- input$indir_list
req(isTruthy(indir))
- rvs$m$conf$paths$data <- file.path(init$indir, indir)
- message("Selected data dir:",rvs$m$conf$paths$data)
+ rvs$m$run$paths$data <- file.path(init$indir, indir)
+ message("Selected data dir:",rvs$m$run$paths$data)
})
- observeEvent(rvs$m$conf$paths$project,{
- indir <- rvs$m$conf$paths$project
+ observeEvent(rvs$m$run$paths$project,{
+ indir <- rvs$m$run$paths$project
req(isTruthy(indir) && dir.exists(indir))
updateSelectInput(session = session,
inputId = "comp_list",
@@ -1227,8 +1227,8 @@ mk_shinyscreen_server <- function(projects,init) {
recursive = F))
})
- observeEvent(rvs$m$conf$paths$data,{
- indir <- rvs$m$conf$paths$data
+ observeEvent(rvs$m$run$paths$data,{
+ indir <- rvs$m$run$paths$data
req(isTruthy(indir) && dir.exists(indir))
updateSelectInput(session = session,
@@ -1240,20 +1240,20 @@ mk_shinyscreen_server <- function(projects,init) {
observeEvent(input$comp_list_b, {
sels <- input$comp_list
req(isTruthy(sels))
- compfiles <- file.path(rvs$m$conf$paths$project,sels)
+ compfiles <- file.path(rvs$m$run$paths$project,sels)
message("(config) Selected compound lists: ", paste(sels,collapse = ","))
rvs$m$conf$compounds$lists <- sels
- rvs$m$conf$paths$compounds$lists <- if (length(compfiles)>0 && nchar(compfiles[[1]])>0) compfiles else "Nothing selected."
+ rvs$m$run$paths$compounds$lists <- if (length(compfiles)>0 && nchar(compfiles[[1]])>0) compfiles else "Nothing selected."
})
observeEvent(input$set_list_b, {
sels <- input$set_list
req(isTruthy(sels))
- setfiles <- file.path(rvs$m$conf$paths$project,sels)
+ setfiles <- file.path(rvs$m$run$paths$project,sels)
message("(config) Selected set lists: ", paste(sels,collapse = ","))
rvs$m$conf$compounds$sets <- sels
- rvs$m$conf$paths$compounds$sets <- if (length(setfiles)>0 && nchar(setfiles[[1]])>0) setfiles else "Nothing selected."
+ rvs$m$run$paths$compounds$sets <- if (length(setfiles)>0 && nchar(setfiles[[1]])>0) setfiles else "Nothing selected."
})
@@ -1307,7 +1307,7 @@ mk_shinyscreen_server <- function(projects,init) {
observeEvent(input$datafiles_b,{
sels <- input$dfile_list
req(isTruthy(sels))
- dfiles <- file.path(rvs$m$conf$paths$data,sels)
+ dfiles <- file.path(rvs$m$run$paths$data,sels)
message("(config) Selected mzMl files: ", paste(sels,collapse = ","))
if (length(dfiles) > 0) {
oldtab <- rv_dfile()
@@ -1376,7 +1376,7 @@ mk_shinyscreen_server <- function(projects,init) {
observeEvent(input$extract_b,{
shinymsg("Extraction has started. This may take a while.")
m <- rf_conf_state()
- fn_c_state <- file.path(m$conf$paths$project,
+ fn_c_state <- file.path(m$run$paths$project,
paste0("extract.",shinyscreen:::FN_CONF))
yaml::write_yaml(x=m$conf,file=fn_c_state)
message("(extract) Config written to ", fn_c_state)
@@ -1395,7 +1395,7 @@ mk_shinyscreen_server <- function(projects,init) {
message = "Perform extraction first."))
m <- rev2list(rvs$m)
- fn_c_state <- file.path(m$conf$paths$project,
+ fn_c_state <- file.path(m$run$paths$project,
paste0("presc.",shinyscreen:::FN_CONF))
yaml::write_yaml(x=m$conf,file=fn_c_state)
message("(prescreen) Config written to ", fn_c_state)
@@ -1432,7 +1432,7 @@ mk_shinyscreen_server <- function(projects,init) {
tabl = rf_tab4plot_spec(),
figtag = spec,
extension = ext)
- message("Plots saved to ",file.path(rvs$m$conf$paths$project,
+ message("Plots saved to ",file.path(rvs$m$run$paths$project,
FIG_TOPDIR))
} else message("Nothing to save.")
@@ -1535,7 +1535,7 @@ mk_shinyscreen_server <- function(projects,init) {
tab <- add_msms_peaks(rvs$m$out$tab$flt_summ,
rvs$m$extr$ms2)
tab2file(tab=tab,
- file=file.path(rvs$m$conf$paths$project,
+ file=file.path(rvs$m$run$paths$project,
"summary.csv"))
shinymsg("Summary file export has been completed.")
},label = "exportsumm_b")
@@ -1720,7 +1720,7 @@ mk_shinyscreen_server <- function(projects,init) {
paste0("Current project: ", txt)})
output$curr_data_dir <- renderText({
- txt <- basename(rvs$m$conf$paths$data)
+ txt <- basename(rvs$m$run$paths$data)
if (is.null(txt)) txt <- "Nothing selected"
paste0("Current data directory: ", txt)
})
@@ -1901,7 +1901,7 @@ mk_shinyscreen_server <- function(projects,init) {
format(Sys.time(), "project_%Y%m%d_%H_%M_%S.tar.gz")
},
content=function(file) {
- pdir <- rvs$m$conf$paths$project
+ pdir <- rvs$m$run$paths$project
shiny::req(!is.null(pdir) &&
!is.na(pdir) &&
(nchar(pdir) > 0))