diff --git a/R/shiny-state.R b/R/shiny-state.R
index e943b100f0aa6b128c47cb8de0ec4d1bf0f5dce3..93336497638d0ccb7180634d08e2d8ee44a82fce 100644
--- a/R/shiny-state.R
+++ b/R/shiny-state.R
@@ -22,7 +22,7 @@
#' @importFrom shiny selectInput numericInput textInput HTML
-GUI_SELECT_INPUTS <- c("proj_list",
+GUI_SELECT_INPUTS = c("proj_list",
"indir_list",
"ms1_coarse_unit",
"ms1_fine_unit",
@@ -30,7 +30,7 @@ GUI_SELECT_INPUTS <- c("proj_list",
"ret_time_shift_tol_unit",
"dfile_list")
-GUI_NUMERIC_INPUTS <- c("ms1_coarse",
+GUI_NUMERIC_INPUTS = c("ms1_coarse",
"ms1_fine",
"ms1_eic",
"ms1_rt_win",
@@ -39,14 +39,14 @@ GUI_NUMERIC_INPUTS <- c("ms1_coarse",
"s2n",
"ret_time_shift_tol")
-GUI_TEXT_INPUTS <- c("rep_aut",
+GUI_TEXT_INPUTS = c("rep_aut",
"rep_tit")
-GUI_RADIO_INPUTS <- c("missingprec")
+GUI_RADIO_INPUTS = c("missingprec")
-GUI_ALL_INPUTS <- c(GUI_SELECT_INPUTS,
+GUI_ALL_INPUTS = c(GUI_SELECT_INPUTS,
GUI_NUMERIC_INPUTS,
GUI_TEXT_INPUTS,
GUI_RADIO_INPUTS)
@@ -55,8 +55,8 @@ GUI_ALL_INPUTS <- c(GUI_SELECT_INPUTS,
add_new_def_tag <- function(old_tags,how_many) {
ind = which(grepl(r"(^F\d+$)",old_tags))
st_num = if (length(ind)>0L) {
- old_def_tags <- old_tags[ind]
- tag_nums <- gsub(r"(^F(\d+)$)",r"(\1)",old_def_tags)
+ old_def_tags = old_tags[ind]
+ tag_nums = gsub(r"(^F(\d+)$)",r"(\1)",old_def_tags)
max(as.integer(tag_nums))
@@ -162,26 +162,26 @@ create_gui <- function(project_path=NA_character_) {
#'@export
r2datatab <- function(rdatatab) {
shiny::isolate({
- file <- rdatatab$file
- adduct <- rdatatab$adduct
- tag <- rdatatab$tag
- set <- rdatatab$set
+ file = rdatatab$file
+ adduct = rdatatab$adduct
+ tag = rdatatab$tag
+ set = rdatatab$set
})
- if (length(file)==0L) file <- character(0)
- if (length(adduct)==0L) adduct <- rep(NA_character_,length(file))
- if (length(tag)==0L) tag <- rep(NA_character_,length(file))
- if (length(set)==0L) tag <- rep(NA_character_,length(file))
+ if (length(file)==0L) file = character(0)
+ if (length(adduct)==0L) adduct = rep(NA_character_,length(file))
+ if (length(tag)==0L) tag = rep(NA_character_,length(file))
+ if (length(set)==0L) tag = rep(NA_character_,length(file))
data.table(tag=tag,adduct=adduct,set=set,file=file)
}
r2filetag <- function(rfiletag) {
shiny::isolate({
- file <- rfiletag$file
- tag <- rfiletag$tag
+ file = rfiletag$file
+ tag = rfiletag$tag
})
- if (length(file)==0L) file <- character(0)
- if (length(tag)==0L) tag <- rep(NA_character_,length(file))
+ if (length(file)==0L) file = character(0)
+ if (length(tag)==0L) tag = rep(NA_character_,length(file))
data.table(tag=tag,file=file)
}
@@ -193,7 +193,7 @@ gen_dtab <- function(tablist,sets) {
r2compounds <- function(rcompounds) {
shiny::isolate({
- cmpd_lists <- rcompounds$lists
+ cmpd_lists = rcompounds$lists
})
list(lists=cmpd_lists)
@@ -202,17 +202,17 @@ r2compounds <- function(rcompounds) {
#' @export
pack_app_state <- function(input, gui) {
- pack <- list()
+ pack = list()
shiny::isolate({
- pack_inputs <- list()
- pack_input_names <- which_gui_inputs(inputs)
- pack_inputs <- shiny::reactiveValuesToList(input)[pack_input_names]
- pack$input <- pack_inputs
- pack$datatab <- r2datatab(gui$datatab)
- pack$filetag <- r2filetag(gui$filetag)
- pack$compounds <- r2compounds(gui$compounds)
- pack$paths <- list()
- pack$paths$data <- gui$paths$data
+ pack_inputs = list()
+ pack_input_names = which_gui_inputs(inputs)
+ pack_inputs = shiny::reactiveValuesToList(input)[pack_input_names]
+ pack$input = pack_inputs
+ pack$datatab = r2datatab(gui$datatab)
+ pack$filetag = r2filetag(gui$filetag)
+ pack$compounds = r2compounds(gui$compounds)
+ pack$paths = list()
+ pack$paths$data = gui$paths$data
})
pack
@@ -318,17 +318,17 @@ unpack_app_state <- function(session,envopts,input,top_data_dir,project_path,pac
input=input,
packed_state=packed_state)
- gui <- create_gui(project_path=project_path)
- gui$compounds$lists <- packed_state$compounds$lists
- gui$datatab$file <- packed_state$datatab$file
- gui$datatab$adduct <- packed_state$datatab$adduct
- gui$datatab$tag <- packed_state$datatab$tag
- gui$datatab$set <- packed_state$datatab$set
+ gui = create_gui(project_path=project_path)
+ gui$compounds$lists = packed_state$compounds$lists
+ gui$datatab$file = packed_state$datatab$file
+ gui$datatab$adduct = packed_state$datatab$adduct
+ gui$datatab$tag = packed_state$datatab$tag
+ gui$datatab$set = packed_state$datatab$set
- gui$filetag$file <- packed_state$filetag$file
- gui$filetag$tag <- packed_state$filetag$tag
+ gui$filetag$file = packed_state$filetag$file
+ gui$filetag$tag = packed_state$filetag$tag
- x <- packed_state$paths$data
+ x = packed_state$paths$data
gui$paths$data = if (length(x)>0 && nchar(x)>0) {
file.path(top_data_dir,basename(x))
} else ""
@@ -342,12 +342,12 @@ unpack_app_state <- function(session,envopts,input,top_data_dir,project_path,pac
input2conf_setup <- function(input,gui,conf=list()) {
if (length(conf)==0L) {
- conf$compounds <- list()
- conf$summary_table <- list()
- conf$debug <- F
+ conf$compounds = list()
+ conf$summary_table = list()
+ conf$debug = F
}
- conf$compounds$lists <- gui$compounds$lists
+ conf$compounds$lists = gui$compounds$lists
conf$paths$data = basename(gui$paths$data)
conf
}
@@ -355,11 +355,11 @@ input2conf_setup <- function(input,gui,conf=list()) {
input2conf_extract <- function(input,conf) {
conf$tolerance = list()
conf$extract = list()
- conf$tolerance[["ms1 fine"]] <- paste(input$ms1_fine,input$ms1_fine_unit)
- conf$tolerance[["ms1 coarse"]] <- paste(input$ms1_coarse,input$ms1_coarse_unit)
- conf$tolerance[["eic"]] <- paste(input$ms1_eic,input$ms1_eic_unit)
- conf$tolerance[["rt"]] <- paste(input$ms1_rt_win,input$ms1_rt_win_unit)
- conf$extract$missing_precursor_info <- input$missingprec
+ conf$tolerance[["ms1 fine"]] = paste(input$ms1_fine,input$ms1_fine_unit)
+ conf$tolerance[["ms1 coarse"]] = paste(input$ms1_coarse,input$ms1_coarse_unit)
+ conf$tolerance[["eic"]] = paste(input$ms1_eic,input$ms1_eic_unit)
+ conf$tolerance[["rt"]] = paste(input$ms1_rt_win,input$ms1_rt_win_unit)
+ conf$extract$missing_precursor_info = input$missingprec
conf
}
@@ -367,26 +367,26 @@ input2conf_extract <- function(input,conf) {
input2conf_prescreen <- function(input,conf) {
conf$prescreen = list()
- conf$prescreen[["ms1_int_thresh"]] <- input$ms1_int_thresh
- conf$prescreen[["ms2_int_thresh"]] <- input$ms2_int_thresh
- conf$prescreen[["s2n"]] <- input$s2n
- conf$prescreen[["ret_time_shift_tol"]] <- paste(input$ret_time_shift_tol,input$ret_time_shift_tol_unit)
+ conf$prescreen[["ms1_int_thresh"]] = input$ms1_int_thresh
+ conf$prescreen[["ms2_int_thresh"]] = input$ms2_int_thresh
+ conf$prescreen[["s2n"]] = input$s2n
+ conf$prescreen[["ret_time_shift_tol"]] = paste(input$ret_time_shift_tol,input$ret_time_shift_tol_unit)
conf
}
input2conf_figures <- function(input,conf) {
conf$figures = list()
- conf$figures$rt_min <- paste(input$plot_rt_min,input$plot_rt_min_unit)
- conf$figures$rt_max <- paste(input$plot_rt_max,input$plot_rt_max_unit)
- conf$figures$ext <- input$plot_ext
+ conf$figures$rt_min = paste(input$plot_rt_min,input$plot_rt_min_unit)
+ conf$figures$rt_max = paste(input$plot_rt_max,input$plot_rt_max_unit)
+ conf$figures$ext = input$plot_ext
conf
}
input2conf_report <- function(input,conf) {
conf$report = list()
- conf$report$author <- input$rep_aut
- conf$report$title <- input$rep_tit
+ conf$report$author = input$rep_aut
+ conf$report$title = input$rep_tit
conf
}
@@ -427,7 +427,7 @@ app_update_conf <- function(input,gui,envopts,fconf,m) {
fstr = paste0("input2conf_",fstrp)
m$conf = do.call(fstr,list(input,conf=m$conf))
}
- m$run <- new_runtime_state(project=gui$paths$project,
+ m$run = new_runtime_state(project=gui$paths$project,
envopts = envopts,
conf=m$conf)
m
@@ -455,7 +455,7 @@ app_state2state <- function(input,gui,envopts,m=NULL) {
}
get_sets <- function(gui) {
- fn_lists <- file.path(gui$paths$project,gui$compounds$lists)
+ fn_lists = file.path(gui$paths$project,gui$compounds$lists)
cmpds = join_compound_lists(fn_lists)
cmpds = process_cmpd_sets(cmpds)
cmpds[,unique(set)]
@@ -463,16 +463,16 @@ get_sets <- function(gui) {
gen_dfiles_tab <- function(gui) {
- curr_file <- gui$filetag$file
- curr_tag <- gui$filetag$tag
+ curr_file = gui$filetag$file
+ curr_tag = gui$filetag$tag
- res <- data.table(file=curr_file,tag=curr_tag)
+ res = data.table(file=curr_file,tag=curr_tag)
res
}
gui2datatab <- function(gui) {
- df <- data.table(tag=as.character(gui$datatab$tag),
+ df = data.table(tag=as.character(gui$datatab$tag),
adduct=as.character(gui$datatab$adduct),
set=as.character(gui$datatab$set),
file=as.character(gui$datatab$file))
@@ -491,31 +491,31 @@ gui2datatab <- function(gui) {
## (of tags, CEs) in the index.
gen_cindex <- function(summ,sorder,cols = CINDEX_COLS,by. = CINDEX_BY) {
if (NROW(summ) == 0L) return(NULL)
- allc <- c(by.,cols)
- xsumm <- summ[,..allc]
+ allc = c(by.,cols)
+ xsumm = summ[,..allc]
setnames(xsumm,old="ms1_rt",new="rt",skip_absent=T)
- res <- xsumm[,.SD[max(qlt_ms1)==qlt_ms1][max(qlt_ms2)==qlt_ms2],by=by.]
- res <- res[,c("mz","rt","Name","qlt_ms1","qlt_ms2"):=.(mean(mz,na.rm=T),
+ res = xsumm[,.SD[max(qlt_ms1)==qlt_ms1][max(qlt_ms2)==qlt_ms2],by=by.]
+ res = res[,c("mz","rt","Name","qlt_ms1","qlt_ms2"):=.(mean(mz,na.rm=T),
mean(rt,na.rm=T),
first(Name),
max(qlt_ms1,na.rm=T),
max(qlt_ms2,na.rm=T)),
by=by.]
- res <- res[,unique(.SD),by=by.]
+ res = res[,unique(.SD),by=by.]
- sorder <- unique(sorder)
- wna <- which(sorder=="nothing"); if (length(wna)>0L) sorder <- sorder[-wna]
- quality <- which("quality"==sorder)
+ sorder = unique(sorder)
+ wna = which(sorder=="nothing"); if (length(wna)>0L) sorder = sorder[-wna]
+ quality = which("quality"==sorder)
if (length(quality)>0L) {
- pre <- head(sorder,quality-1L)
- post <- tail(sorder,-quality)
- sorder <- c(pre,"qlt_ms1","qlt_ms2",post)
+ pre = head(sorder,quality-1L)
+ post = tail(sorder,-quality)
+ sorder = c(pre,"qlt_ms1","qlt_ms2",post)
}
- ord <- rep(1L,length(sorder))
+ ord = rep(1L,length(sorder))
if ("qlt_ms1" %in% sorder) {
- ind <- which(sorder %in% c("qlt_ms1","qlt_ms2"))
- ord[ind] <- -1L
+ ind = which(sorder %in% c("qlt_ms1","qlt_ms2"))
+ ord[ind] = -1L
}
if (length(sorder)>0) setorderv(res,cols=sorder,order=ord)
@@ -528,22 +528,22 @@ gen_cindex <- function(summ,sorder,cols = CINDEX_COLS,by. = CINDEX_BY) {
cindex_from_input <- function(clabs,sort_catg=character(4),summ) {
- grp <- if (isTruthy(clabs)) setdiff(CINDEX_BY,clabs) else CINDEX_BY
- sorder <- setdiff(sort_catg,clabs)
+ grp = if (isTruthy(clabs)) setdiff(CINDEX_BY,clabs) else CINDEX_BY
+ sorder = setdiff(sort_catg,clabs)
gen_cindex(summ,sorder=sorder,by=grp)
}
get_cindex_key <- function(cindex) {
## Select only valid category names.
- x <- which(CINDEX_BY %in% names(cindex))
+ x = which(CINDEX_BY %in% names(cindex))
CINDEX_BY[x]
}
get_cindex_parents <- function(summ,ckey,kvals,labs) {
## Get kvals part of summ.
- tab <- summ[(kvals),on=names(kvals)][,unique(.SD),.SDcols=labs,by=ckey] #get_data_from_key(summ,kvals)
+ tab = summ[(kvals),on=names(kvals)][,unique(.SD),.SDcols=labs,by=ckey] #get_data_from_key(summ,kvals)
tab[,item:=do.call(paste,c(.SD,list(sep=";"))),.SDcol=labs]
- keys <- names(tab)[names(tab)!="item"]
+ keys = names(tab)[names(tab)!="item"]
data.table::setkeyv(tab,keys)
tab
}
@@ -552,15 +552,15 @@ get_cindex_kval <- function(cindex,row,key) {
## Accounting for not fully initialised state.
if (!is.numeric(row) || is.na(row) || length(key)==0L || is.na(key) || NROW(cindex)==0L) return(NULL)
- rowtab <- cindex[(row),..key]
- res <- lapply(rowtab,function (x) x[[1]])
- names(res) <- key
+ rowtab = cindex[(row),..key]
+ res = lapply(rowtab,function (x) x[[1]])
+ names(res) = key
res
}
get_summ_subset <- function(db,summ,ptab,paritem,kvals) {
- select <- ptab[item==(paritem)]
- tab <- get_data_from_key(db=db,tab=summ,kvals=kvals)[select,nomatch=NULL,on=key(ptab)]
+ select = ptab[item==(paritem)]
+ tab = get_data_from_key(db=db,tab=summ,kvals=kvals)[select,nomatch=NULL,on=key(ptab)]
if ("scan.1" %in% names(tab)) tab[,scan.1:=NULL] #TODO: This is
#probably a lousy
#hack.
@@ -568,12 +568,12 @@ get_summ_subset <- function(db,summ,ptab,paritem,kvals) {
}
get_ltab <- function(summ_subs,cols=c("scan","ms2_rt")) {
- tab <- summ_subs
+ tab = summ_subs
if (NROW(tab)==1L && is.na(tab$an)) return(data.table::data.table(item=character()))
tab[is.na(ms2_sel),ms2_sel:=F] #TODO FIXME: Check why NAs exist at all?
tab[,passval:=fifelse(qa_pass==T,"OK","BAD")]
tab[ms2_sel==T,passval:="SELECTED"]
- res <- tab[,item:=do.call(paste,c(.SD,list(sep=";"))),.SDcols=c(cols,"passval")]
+ res = tab[,item:=do.call(paste,c(.SD,list(sep=";"))),.SDcols=c(cols,"passval")]
data.table::setkey(res,"ms2_rt")
res
}
@@ -587,18 +587,18 @@ update_on_commit_chg <- function(summ,input,ptab,ltab) {
n_ms2_sel = input$chg_ms2sel
- sel_par <- input$sel_parent_trace
- sel_spec <- input$sel_spec
+ sel_par = input$sel_parent_trace
+ sel_spec = input$sel_spec
- pkvals <- ptab[item==(sel_par),.SD,.SDcols=intersect(SUMM_KEY,names(ptab))]
- lkvals <- ltab[item==(sel_spec),.SD,.SDcols=intersect(SUMM_KEY,names(ltab))]
- kvals <- c(as.list(pkvals),as.list(lkvals))
- kvals <- kvals[unique(names(kvals))]
+ pkvals = ptab[item==(sel_par),.SD,.SDcols=intersect(SUMM_KEY,names(ptab))]
+ lkvals = ltab[item==(sel_spec),.SD,.SDcols=intersect(SUMM_KEY,names(ltab))]
+ kvals = c(as.list(pkvals),as.list(lkvals))
+ kvals = kvals[unique(names(kvals))]
if ('an' %in% names(kvals) && n_ms2_sel) {
- rkvals <- kvals[!(names(kvals) %in% 'an')]
- rktab <- tabkey(summ,kvals=rkvals)
- tabsel <- summ[rktab,.(scan,ms2_sel)]
- ansel <- tabsel[ms2_sel == T,scan]
+ rkvals = kvals[!(names(kvals) %in% 'an')]
+ rktab = tabkey(summ,kvals=rkvals)
+ tabsel = summ[rktab,.(scan,ms2_sel)]
+ ansel = tabsel[ms2_sel == T,scan]
print('ansel')
print(ansel)
if (length(ansel)!=0) {
@@ -609,29 +609,29 @@ update_on_commit_chg <- function(summ,input,ptab,ltab) {
}
- tgts <- c("ms1_rt","ms1_int",names(n_qa),"ms2_sel")
- srcs <- c(list(n_ms1_rt,n_ms1_int),as.list(n_qa),as.list(n_ms2_sel))
+ tgts = c("ms1_rt","ms1_int",names(n_qa),"ms2_sel")
+ srcs = c(list(n_ms1_rt,n_ms1_int),as.list(n_qa),as.list(n_ms2_sel))
- the_row <- tabkey(summ,kvals=kvals)
+ the_row = tabkey(summ,kvals=kvals)
summ[the_row,(tgts):=..srcs]
summ[,scan.1:=NULL] #FIXME: an.1 pops up somewhere.
- qflg <- QA_FLAGS[!(QA_FLAGS %in% "qa_pass")]
+ qflg = QA_FLAGS[!(QA_FLAGS %in% "qa_pass")]
summ[the_row,qa_pass:=apply(.SD,1,all),.SDcols=qflg]
summ
}
get_mprop_ms2_metadata <- function(ltab_entry) {
- res <- list(rt=NA_real_,int=NA_real_,qa=character(0),ms2_sel=F)
+ res = list(rt=NA_real_,int=NA_real_,qa=character(0),ms2_sel=F)
if (NROW(ltab_entry)==0L) return(res)
res$rt = ltab_entry$ms1_rt
res$int = ltab_entry$ms1_int
- z <- ltab_entry[.SD,.SDcols=patterns("qa_ms[12].*")]
- lqa_vals <- as.list(ltab_entry[,.SD,.SDcols=patterns("qa_ms[12].*")])
- qa_names <- names(lqa_vals)
- res$qa <- qa_names[as.logical(lqa_vals)]
+ z = ltab_entry[.SD,.SDcols=patterns("qa_ms[12].*")]
+ lqa_vals = as.list(ltab_entry[,.SD,.SDcols=patterns("qa_ms[12].*")])
+ qa_names = names(lqa_vals)
+ res$qa = qa_names[as.logical(lqa_vals)]
res$ms2_sel = ltab_entry$ms2_sel
res