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

all: Reorganise state init to fit with RMD workflow

parent 6c3d4ca8
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
NAMESPACE
+ 6
− 0
View file @ d8278b3e
......@@ -11,11 +11,17 @@ export(load_data_input)
export(load_inputs)
export(mk_comp_tab)
export(mk_tol_funcs)
export(mz_input)
export(new_rv_state)
export(new_state)
export(new_state_fn_conf)
export(prescreen)
export(report)
export(rt_input)
export(run)
export(run_in_dir)
export(save_plots)
export(setup_phase)
export(sort_spectra)
export(subset_summary)
import(data.table)
......
R/api.R
+ 30
− 5
View file @ d8278b3e
......@@ -13,11 +13,26 @@
## 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_state_fn_conf <- function(fn_conf) {
m <- new_state()
m$conf <- read_conf(fn_conf)
init_state(m)
}
##' @export
run <- function(fn_conf) {
conf <- read_conf(fn_conf)
m <- new_state(conf=conf,
GUI=F)
m <- new_state_fn_conf(fn_conf)
dir.create(m$conf$project,
showWarnings = F,
recursive = T)
......@@ -27,13 +42,22 @@ run <- function(fn_conf) {
##' @export
run_in_dir <- function(m) {
setup_phase <- function(m) {
m <- mk_tol_funcs(m)
m <- load_inputs(m)
m <- concurrency(m)
m
}
##' @export
run_in_dir <- function(m) {
m <- setup_phase(m)
m <- mk_comp_tab(m)
m <- extr_data(m)
m <- prescreen(m)
m <- sort_spectra(m)
m <- subset_summary(m)
m <- create_plots(m)
m <- save_plots(m)
invisible(m)
}
......@@ -335,6 +359,7 @@ conf_trans <- function(conf) {
prescreen <- function(m) {
## Top-level auto prescreening function.
confpres <- conf_trans_pres(m$conf$prescreen)
## TODO need to fix max spec intensity
gen_ms2_spec_tab <- function(ms) {data.table::rbindlist(lapply(1:nrow(ms), function (nr) {
......@@ -373,7 +398,7 @@ prescreen <- function(m) {
}
m$qa <- create_qa_table(m$extr$ms,m$conf$prescreen)
m$qa <- create_qa_table(m$extr$ms,confpres)
mms1 <- assess_ms1(m)
m <- assess_ms2(mms1)
fields <- c("Files","adduct","ID",QA_COLS)
......
R/mix.R
+ 42
− 12
View file @ d8278b3e
......@@ -710,24 +710,17 @@ read_conf <- function(fn) {
}
cf$compound$lists <- fnl
conf_trans(cf)
## conf_trans(cf)
cf
}
new_conf <- function() EMPTY_CONF
new_state <- function(conf=NULL,fn_conf="",GUI=F) {
assert(xor(!is.null(conf),nchar(fn_conf)!=0L),
msg="Provide either conf, or fn_conf, not both, not none.")
m <- list()
## Conf setup
m$conf <- if (!is.null(conf)) conf else read_conf(fn_conf)
init_state <- function(m) {
if (is.null(m$conf$debug)) m$conf$debug <- F
m$conf$fn_comp <- file.path(m$conf$project, FN_COMP_TAB)
m$conf$fn_summ <- file.path(m$conf$project, FN_SUMM)
m$extr$fn <- file.path(m$conf$project, "extracted.rds")
m$GUI <- GUI
m$out$tab <- list()
m$input$tab$mzml <- EMPTY_MZML
lab <- gen_uniq_lab(list(),pref="L")
......@@ -736,6 +729,41 @@ new_state <- function(conf=NULL,fn_conf="",GUI=F) {
m
}
base_conf <- function () {
m <- list()
m$conf <- list(project=getwd(),
compounds=list(lists=list(),
sets="",
data="",
fn_comp="",
fn_summ=""),
extr=list(fn=""))
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
}
presc_conf <- function(m) {
m$conf$prescreen <- list("ms1_int_thresh"=1e5,
"ms2_int_thresh"=2.5e3,
"s2n"=3,
"ret_time_shift_tol"=0.5)
m
}
new_conf <- function() presc_conf(
extr_conf(
base_conf()))
verify_cmpd_l <- function(dt,fn) {
fields <- colnames(EMPTY_CMPD_LIST)
dtflds <- colnames(dt)
......@@ -870,6 +898,8 @@ assess_ms1 <- function(m) {
assess_ms2 <- function(m) {
presconf <- conf_trans_pres(m$conf$prescreen)
## This function takes a spectral list, looks for the members
## inside the retention time window and returns either the indices
## of those that are, or NA.
......@@ -895,7 +925,7 @@ assess_ms2 <- function(m) {
## that the single entry in the sublist is not NA.
m$qa$ms[qa_ms1_exists==T,qa_ms2_exists := .(sapply(spec,function (sl) length(sl)>1 || !is.na(sl[[1]])))]
irows <- which(m$qa$ms$qa_ms1_exists & m$qa$ms$qa_ms2_exists)
rt_win <- 2 * m$conf$prescreen$ret_time_shift_tol
rt_win <- 2 * presconf$ret_time_shift_tol
## List of lists of spec indices where MS2 are within the rt
## window.
......@@ -911,7 +941,7 @@ assess_ms2 <- function(m) {
## intensity range.
okind_int_ms2 <- m$qa$ms[irows, ][, .(tmp=mapply(pick_ms2_int,
spec,
m$conf$prescreen$ms2_int_thresh,
presconf$ms2_int_thresh,
ms1_int,
SIMPLIFY=F))]$tmp
......
R/resources.R
+ 1
− 16
View file @ d8278b3e
......@@ -115,6 +115,7 @@ MS1_SN_FAC <- 3.0
## Shiny objects
NUM_INP_WIDTH="15%"
NUM_INP_HEIGHT="5%"
......@@ -148,22 +149,6 @@ FN_DATA_TAB <- "data-files.csv"
## Default number of concurrent workers
NO_WORKERS <- 2
EMPTY_CONF <- list(project="",
compounds=list(lists=list(),
sets=""),
data="",
fn_comp="",
fn_summ="",
tolerance=list("ms1 coarse"=MS1_ERR_COARSE,
"ms1 fine"=MS1_ERR_FINE,
"eic"=EIC_ERR,
"rt"=RT_EXTR_ERR),
prescreen=list("ms1_int_thresh"=1e5,
"ms2_int_thresh"=2.5e3,
"s2n"=3,
"ret_time_shift_tol"=0.5),
extr=list(fn=""))
## Input parameters for prescreening.
CONF_PRES_NUM <- c("ms1_int_thresh","ms2_int_thresh","s2n")
CONF_PRES_TU <- c("ret_time_shift_tol")
......
R/shiny-ui-base.R
+ 38
− 8
View file @ d8278b3e
......@@ -88,6 +88,44 @@ txt_file_input <- function(inputId,input,fileB,label,volumes,default = "") {
}
##' @export
mz_input <- function(input_mz,input_unit,width=NUM_INP_WIDTH,height=NUM_INP_HEIGHT,def_mz=0,def_unit="Da") {
style <- "display: inline-block; vertical-align:top; width: "
stylel <- "display: inline-block; vertical-align:top;"
style=paste0(style,width,"; ")
shiny::div(shiny::div(style=stylel,
shiny::tags$label("+/-",`for`=input_mz)),
shiny::div(style=style,
shiny::numericInput(input_mz,
label=NULL,
value = def_mz)),
shiny::div(style=style,
shiny::selectInput(input_unit,
label=NULL,
c("ppm","Da"),
selected=def_unit)))
}
##' @export
rt_input <- function(input_rt,input_unit,width=NUM_INP_WIDTH,height=NUM_INP_HEIGHT,def_rt=0,def_unit="min") {
style="display: inline-block; vertical-align:top; width: "
style=paste0(style,width,"; ")
stylel <- "display: inline-block; vertical-align:top;"
shiny::div(shiny::div(style=stylel,
shiny::tags$label("+/-",`for`=input_rt)),
shiny::div(style=style,
shiny::numericInput(input_rt,
label=NULL,
value = def_rt)),
shiny::div(style=style,
shiny::selectInput(input_unit,
label=NULL,
c("min","s"),
selected=def_unit)))
}
rev2list <- function(rv) {
## Take reactive values structure and convert them to nested
## lists.
......@@ -101,14 +139,6 @@ list2rev <- function(lst) {
lst else do.call(react_v,lapply(lst,list2rev))
}
new_rv_state <- function(project) {
p <- normalizePath(path=project,winslash = '/')
nc <- new_conf()
nc$project <- project
x <- react_v(m=list2rev(new_state(conf=nc,GUI=T)))
x
}
mk_roots <- function(wd) local({
addons <- c("project"=normalizePath(wd,winslash = '/'))
def_vol <- function() {
......
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