diff --git a/R/plotting.R b/R/plotting.R index 7ca4654025b74e0145b7f07e1f40f5362fcad565..f6dd4efa267abd7d76ffcc9133ef50c2d785b284 100644 --- a/R/plotting.R +++ b/R/plotting.R @@ -338,3 +338,48 @@ plot_save_single <- function(plot,decotab,extension,proj_path,subdir=FIG_TOPDIR, } + + + +## NEW BEGINNINGS + + +theme_eic_ms1 <- theme_light +mk_logic_exp <- function(rest,sofar=NULL) { + if (length(rest)==0L) { + return(sofar) + } else { + nm = names(rest)[[1]] + val = rest[[1]] + ex <- bquote(.(as.symbol(nm)) %in% .(val)) + zz <- if (is.null(sofar)) ex else bquote(.(ex) & .(sofar)) + mk_logic_exp(tail(rest,-1L), zz) + } +} + +get_data_from_key <- function(tab,key) { + skey <- mk_logic_exp(key) + eval(bquote(tab[.(skey)])) +} +get_data_4_eic_ms1 <- function(extr_ms1,adduct,id) { + key <- list(adduct=adduct,ID=id) + get_data_from_key(tab=extr_ms1,key=key) +} + +make_line_label <- function(...) { + paste(...,sep="; ") +} +make_eic_ms1_plot <- function(extr_ms1,summ,set,adduct,id,splitby) { + key <- list(set=set, + adduct=adduct, + ID=id) + extr_data <- get_data_4_eic_ms1(extr_ms1, + adduct=adduct, + id=id) + summ_row <- get_data_from_key(summ,key=key) + pdata <- extr_data[,.(rt,intensity),by=c('ID',splitby)] + pdata <- eval(bquote(pdata[,label:=make_line_label(..(lapply(splitby,as.symbol))),by=.(splitby)],splice=T)) + + setkeyv(pdata,cols=c("ID",splitby,"rt")) + ggplot2::ggplot(pdata,aes(x=rt,y=intensity,colour=label))+labs(tag=id)+xlab("retention time")+geom_line() +} diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R index f387308eb36af6f55217101eacda38b71dc371c4..963a0fd156aa450a6124781f71d9171038936a3a 100644 --- a/R/shiny-ui-base.R +++ b/R/shiny-ui-base.R @@ -802,43 +802,6 @@ mk_shinyscreen_server <- function(projects,init) { message("project: ",rvs$gui$project()) }, label = "project-b") - ## observe({ - ## rvs$gui$paths$project - ## rvs$gui$paths$data - ## rvs$gui$datatab$file - ## rvs$gui$datatab$tag - ## rvs$gui$datatab$set - ## rvs$gui$datatab$adduct - ## rvs$gui$compounds$lists - ## rvs$gui$compounds$sets - ## input$missingprec - - ## input$ms1_fine - ## input$ms1_fine_unit - - ## input$ms1_coarse - ## input$ms1_coarse_unit - - ## input$ms1_eic - ## input$ms1_eic_unit - - ## input$ms1_rt_win - ## input$ms1_rt_win_unit - - ## input$missingprec - - ## isolate({ - ## rvs$m$conf <- input2conf_setup(gui=rvs$gui,conf=rvs$m$conf,input=input) - ## }) - - - - - ## message("Initial parameters updated.") - ## }, label = "gen-setup-state") - - - observeEvent(input$extract_b,{ rvs$m <-req(rf_setup_state()) m <- rvs$m @@ -1016,6 +979,11 @@ mk_shinyscreen_server <- function(projects,init) { rvs$gui$datatab$set <- z$set rvs$gui$datatab$adduct <- z$adduct }, label = "datatab-edit") + + observeEvent(input$cindex_row_last_clicked,{ + row <- input$cindex_row_last_clicked + message("row: ", paste0(row,collapse=',')) + }) ## RENDER output$curr_proj <- renderText({ @@ -1143,7 +1111,10 @@ mk_shinyscreen_server <- function(projects,init) { output$cindex <- DT::renderDT({ tab <- rf_get_cindex() validate(need(NROW(tab)>0L,message="Need to prescreen, first.")) - DT::datatable(tab,rownames=NULL,options=list(filter=T)) + DT::datatable(tab, + rownames=NULL, + options=list(filter=T), + selection="single") })