diff --git a/DESCRIPTION b/DESCRIPTION
index 3f20c1934a642e274e794fdd52ebd6f49aacfcd7..5ed7ee28da358cf2fd2a5ae4942c08ef25346307 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: shinyscreen
Title: Pre-screening of Mass Spectrometry Data
-Version: 0.9.2
+Version: 0.9.3
Author: Todor Kondić
Maintainer: Todor Kondić <todor.kondic@uni.lu>
Authors@R:
@@ -20,19 +20,19 @@ Authors@R:
person(given = "Hiba Mohammed",
family = "Taha",
role = c("ctb"),
- email = "hiba.mohammed-taha@ext.uni.lu"),
+ email = "hiba.mohammed-taha@uni.lu"),
person(given = "Jessy",
family = "Krier",
role = c("ctb"),
- email = "jessy.krier@ext.uni.lu"),
+ email = "jessy.krier@uni.lu"),
person(given = "Mira",
family = "Narayanan",
role = c("ctb"),
- email = "mira.narayanan@ext.uni.lu"),
+ email = "mira.narayanan@uni.lu"),
person(given = "Anjana",
family = "Elapavalore",
role = c("ctb"),
- email = "anjana.elapavalore@ext.uni.lu"),
+ email = "anjana.elapavalore@uni.lu"),
person(given = "Marc",
family = "Warmoes",
role = c("ctb"),
@@ -69,8 +69,6 @@ Imports:
grid,
curl,
shiny,
- shinydashboard,
- shinyFiles,
rhandsontable,
DT,
tcltk
diff --git a/NAMESPACE b/NAMESPACE
index 016758acf34db2df358d57a7b29b479932a77dec..bc5cd3df79d187b2252c0de32825ba072d1bb3e4 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -6,6 +6,8 @@ export(conf_trans)
export(create_plots)
export(extr_data)
export(extract)
+export(gen_key_plot_tab)
+export(gen_struct_plots)
export(get_fn_comp)
export(get_fn_conf)
export(get_fn_extr)
@@ -23,6 +25,11 @@ export(mz_input)
export(new_rv_state)
export(new_state)
export(new_state_fn_conf)
+export(plot_ms1_chr)
+export(plot_ms2_chr)
+export(plot_ms2_spec)
+export(plot_struct)
+export(plot_struct_nowrap)
export(prescreen)
export(report)
export(rev2list)
diff --git a/R/api.R b/R/api.R
index f15bc3795c7d8afddc6ea6925e3b369bb0e8c22d..4878a9afd12a4c5c2b1dd1b46b72b06466dab098 100644
--- a/R/api.R
+++ b/R/api.R
@@ -480,6 +480,29 @@ subset_summary <- function(m) {
m
}
+
+##' @export
+gen_struct_plots <- function(m) {
+ ## Generate structure plots.
+ comp <- m$out$tab$comp
+
+ res <- if (NROW(comp)>0) {
+ structtab <- m$out$tab$comp[known=="structure",unique(.SD),.SDcols=c("ID","SMILES")]
+ message("Start generating structures.")
+ structtab[,img:=.({tmp <- lapply(SMILES,function (sm) smiles2img(sm,width = 500,height = 500, zoom = 4.5))
+ tmp})]
+ message("Done generating structures.")
+ structtab
+ } else {
+ dtable(ID=character(0),SMILES=character(0),img=list())
+ }
+
+ m$out$tab$structfig <- res
+
+ m
+}
+
+
#' @export
create_plots <- function(m) {
## Produce plots of EICs and spectra and group them acording to
@@ -494,11 +517,6 @@ create_plots <- function(m) {
plot_ms1_label <- if (!shiny::isTruthy(group_data$plot)) FIG_DEF_CONF$grouping$label else group_data$label
plot_ms2_label <- "CE"
- message("plot_group: ",plot_group)
- message("plot_plot: ",plot_plot)
- message("plot_ms1_label: ",plot_ms1_label)
- message("plot_ms2_label: ",plot_ms2_label)
-
plot_index <- c(plot_group,plot_plot)
## All the possible curve labels.
@@ -530,96 +548,88 @@ create_plots <- function(m) {
ms1_legend_info = F)
+ plot_key <- gen_key_plot_tab(m)
+
+ topdir <- FIG_TOPDIR
+ dir.create(topdir,showWarnings = F)
+
+ my_theme <- function(...) plot_theme(legend.position = "left",
+ legend.direction = "vertical")
+
+ theme_full <- my_theme()
+ theme_noleg <- plot_theme(legend.position = "none")
+
+
+ clean_range<-function(def,rng) {
+ x1 <- rng[1]
+ x2 <- rng[2]
+ if (is.na(x1) || x1 == 0) x1 <- def[1]
+ if (is.na(x2) || x2 == 0) x2 <- def[2]
+ c(x1,x2)
+ }
+ ## If structures do not exist, generate them.
+ if (is.null(m$out$tab$structfig)) m <- gen_struct_plots(m)
- ## Generate MS1 EIC plots.
-
- iflt <- flt_summ[,.(mz,rt_peak=ms1_rt),keyby=c(plot_index,plot_ms1_label)]
- fml <- formula(paste0(plot_group,"+",plot_plot,"~",plot_ms1_label))
- iflt_squish <- iflt[,.(chunk=list(unique(.SD))),.SDcols=c(plot_ms1_label,"mz","rt_peak"),by=plot_index]
- ## iflt.dc <- data.table::dcast(iflt,fml, fun.aggregate = function(x) if (length(x)>0) head(x,1) else NA_real_, value.var = c("mz","rt_peak"))
- data.table::setkeyv(iflt_squish,plot_index)
- ms1_plot <- m$extr$ms1[iflt_squish,
- .(fig_eic={
- message("Progress: ",.GRP,"/",.NGRP)
- df<-.SD
- df$plot_label <- .SD[[..plot_ms1_label]]
- res <- i.chunk[[1]][df,on=..plot_ms1_label]
- list(plot_eic_ms1(res,
- style_fun = style_eic_ms1,
- plot_label = ..plot_ms1_label))
- }),
- on=plot_index,
- by=.EACHI,
- .SDcols=c("rt","intensity",
- plot_ms1_label)]
-
- message("Done creating MS1 EIC plots.")
-
- ## Generate MS2 EIC plots.
- message("Create MS2 EIC plots.")
- iflt <- flt_summ[,.(mz,rt_peak=ms2_rt,int_peak=ms2_int,ms2_sel),
- keyby=c(plot_index,plot_ms1_label,plot_ms2_label)]
- iflt_squish <- iflt[,.(chunk=list(unique(.SD))),.SDcols=c(plot_ms1_label,
- plot_ms2_label,
- "ms2_sel",
- "mz",
- "rt_peak",
- "int_peak"),by=plot_index]
-
- ms2_plot <- m$extr$ms2[iflt_squish,{
- df <- i.chunk[[1]]
- df <- df[ms2_sel==T,]
- df$parent_label <- df[[..plot_ms1_label]]
- df$plot_label <- df[[..plot_ms2_label]]
- spdf<-.SD[df,on=c(..plot_ms1_label,..plot_ms2_label),nomatch=NULL]
- spdf[,plot_label:=factor(plot_label)]
- spdf[,parent_label:=factor(parent_label)]
- df[,parent_label:=factor(parent_label)]
- df[,plot_label:=factor(plot_label)]
- df <- df[!is.na(plot_label) & !is.na(parent_label),]
- spdf <- spdf[!is.na(plot_label) & !is.na(parent_label),]
-
- message("Progress: ",.GRP,"/",.NGRP)
- .(fig_eic=list(plot_eic_ms2(df=df,
- style_fun = style_eic_ms2)),
- fig_spec=list(plot_spec_ms2(df=spdf,
- style_fun = style_spec_ms2))
- ,
- fig_leg= list(plot_leg_ms2(df=df,
- style_fun = style_ms2_leg))
- )
+ plot_key[,mapply(function(gv,pv) {
+
+ key <- c(gv,pv)
+ names(key) <- plot_index
+
+
+
+ p_chr_ms1 <- plot_ms1_chr(m, plot_index = key)
+ p_chr_ms2 <- plot_ms2_chr(m, plot_index = key)
+ p_spec_ms2 <- plot_ms2_spec(m, plot_index = key)
+ p_struct <- plot_struct_nowrap(m, plot_index = key)
+
+
+ ## Produce the filename.
+ fn <- paste0(paste(..plot_group,gv,..plot_plot,pv,sep = "_"),".pdf")
+ fn <- gsub("\\[","",fn)
+ fn <- gsub("\\]","",fn)
+ fn <- gsub("\\+","p",fn)
+ fn <- gsub("-","m",fn)
+ fn <- if (!is.null(topdir)) file.path(topdir,fn) else fn
+
+
+ rt_int <- get_rt_interval(p_chr_ms1$data, p_chr_ms2$data, m$conf$figures)
+ my_coord <- ggplot2::coord_cartesian(xlim = rt_int)
+
+ p_chr_ms1 <- p_chr_ms1 + my_coord + theme_full
+ p_chr_ms2 <- p_chr_ms2 + my_coord + theme_full
+ leg1 <- cowplot::get_legend(p_chr_ms1)
+ leg2 <- cowplot::get_legend(p_chr_ms2)
+ p_spec_ms2 <- p_spec_ms2 + theme_full
+
+
+ ## Plot labels.
+ labels <- c(paste0("EIC (MS1) ",..plot_group,": ",gv,", ",..plot_plot,": ",pv),
+ NA,
+ paste0("EIC (MS2) ",..plot_group,": ",gv,", ",..plot_plot,": ",pv),
+ NA,
+ paste0("MS2 Spectra ",..plot_group,": ",gv,", ",..plot_plot,": ",pv),
+ NA)
+
+ big_fig <- cowplot::plot_grid(p_chr_ms1+theme_noleg,
+ p_struct,
+ p_chr_ms2+theme_noleg,
+ leg2,
+ p_spec_ms2+theme_noleg,
+ leg1,
+ align = "hv",
+ axis='l',
+ ncol = 2,
+ nrow = 3,
+ labels = labels,
+ rel_widths = c(2,1))
+
+ message("Plotting: ",paste(key,collapse = ", ")," to: ",fn)
+ ggplot2::ggsave(plot=big_fig,width = 21, height = 29.7, units = "cm", filename = fn)
+
},
- .SDcols = c("adduct","tag","ID","CE","mz","intensity"),
- on = plot_index,
- by = .EACHI]
- message("Done creating MS1 EIC plots.")
-
- ## Generate structure plots.
- structab <- m$out$tab$comp[known=="structure",unique(.SD),.SDcols=c("ID","SMILES")]
- message("Start generating structures.")
- structab[,structimg:=.({tmp <- lapply(SMILES,function (sm) smiles2img(sm,width = 500,height = 500, zoom = 4.5))
- tmp})]
- message("Done generating structures.")
-
- ## We need to check if we have multiplots grouped by ID in order
- ## for structure generation to make sense.
- if (plot_plot == "ID") {
- ms1_plot <- structab[ms1_plot,on="ID"][,fig_struct := .(Map(function (st,eic) {
- df <- eic[[1]]$data
- ddf <- dtable(x=df$rt,
- y=df$intensity)
- ggplot2::ggplot(ddf) +
- ggplot2::geom_blank() +
- ggplot2::annotation_custom(st) +
- ggplot2::theme_void()
- },
- structimg,
- fig_eic))]
- ms1_plot[,structimg:=NULL]
- } else ms1_plot$fig_struct <- NA
- m$out$tab$ms2_plot <- ms2_plot
- m$out$tab$ms1_plot <- ms1_plot
+ get(..plot_group),
+ get(..plot_plot))]
m
}
@@ -628,7 +638,8 @@ save_plots <- function(m) {
topdir <- FIG_TOPDIR
dir.create(topdir,showWarnings = F)
- my_theme <- function(...) plot_theme(legend.position = "left")
+ my_theme <- function(...) plot_theme(legend.position = "left",
+ legend.direction = "vertical")
clean_range<-function(def,rng) {
diff --git a/R/mix.R b/R/mix.R
index 36f2c1edf640ea6d3dd006c4a8998797c5481f4f..952e19ddd14966508d59ddba16f4c483f8c0e519 100644
--- a/R/mix.R
+++ b/R/mix.R
@@ -1212,15 +1212,16 @@ gen_get_ms2_legend <- function(m,legend_name_ms2="CE",all_ms2_labels) {
}
-plot_eic_ms1 <- function(df,style_fun,plot_label) {
+plot_eic_ms1_df <- function(df,style_fun,plot_label) {
mk_leg_lab<-function(tag,rt) {if (length(tag) > 0) paste(tag,"; rt= ",formatC(rt,format='f',digits=RT_DIGITS)," min",sep='') else character(0)}
- mz <- df[,unique(mz)]
- tbl <- df[,.(verb_labs=mk_leg_lab(plot_label,rt_peak),plot_label),
- by=c("plot_label","rt_peak")]
+ ## mz <- df[,unique(prec_mz)]
+ tbl <- df[,.(verb_labs=mk_leg_lab(get(..plot_label),rt_peak),plot_label=get(..plot_label)),
+ by=c(plot_label,"rt_peak")]
+
verb_labs <- tbl[,verb_labs]
labs <- tbl[,plot_label]
- df[,plot_label:=factor(plot_label)]
+ df[,plot_label:=factor(get(..plot_label))]
style_fun(ggplot2::ggplot(df,ggplot2::aes(x=rt,y=intensity,colour=plot_label)),
breaks=labs,
labels=verb_labs) +
@@ -1229,15 +1230,11 @@ plot_eic_ms1 <- function(df,style_fun,plot_label) {
y=CHR_GRAM_Y)
}
-plot_eic_ms2 <- function(df,style_fun) {
- mz <- df[,unique(mz)]
+plot_eic_ms2_df <- function(df,style_fun) {
+ mz <- df[,unique(prec_mz)]
ddf <- df[!is.na(rt_peak)==T]
- ## mk_leg_lab<-function(tag,rt,have_sel) {if (length(tag) > 0 && have_sel) paste(tag,"; rt= ",formatC(rt,format='f',digits=RT_DIGITS)," min",sep='') else if (!have_sel) tag else character(0)}
- ## tbl <- ddf[,.(verb_labs=mk_leg_lab(plot_label,.SD[ms2_sel==T,rt_peak],any(ms2_sel)),plot_label),
- ## by="plot_label"]
- ## ms2_verb_labs <- tbl[,verb_labs] TODO: This is nonsense for
- ## multi-CE and multi-other-label.
+
ms2_labs <- ddf[,plot_label]
ms1_labs <- ddf[,levels(parent_label)]
@@ -1264,18 +1261,11 @@ plot_eic_ms2 <- function(df,style_fun) {
res
}
-plot_spec_ms2 <- function(df,style_fun) {
- mk_leg_lab<-function(tag,rt,have_sel) {if (length(tag) > 0 && have_sel) paste(tag,"; rt= ",formatC(rt,format='f',digits=RT_DIGITS)," min",sep='') else if (!have_sel) tag else character(0)}
-
+plot_spec_ms2_df <- function(df,style_fun) {
- labels <- df[,unique(plot_label)]
- parent_labels <- df[,unique(parent_label)]
- rts <- df[,unique(rt_peak)]
-
-
ms2_labs <- df[,levels(plot_label)]
ms1_labs <- df[,levels(parent_label)]
- leglabs <- mk_leg_lab(ms1_labs,rts,T)
+
plot <- if (NROW(df)>0) {
ddf <- df[,.(mz,intensity,parent_label,plot_label)]
plot <-style_fun(ggplot2::ggplot(ddf,
@@ -1283,7 +1273,7 @@ plot_spec_ms2 <- function(df,style_fun) {
y = intensity,
color=parent_label,
shape=plot_label)),
- labels=leglabs,
+ labels=ms1_labs,
breaks=ms1_labs,
ms2_breaks=ms2_labs,
ms2_labels=ms2_labs)
@@ -1293,11 +1283,13 @@ plot_spec_ms2 <- function(df,style_fun) {
ggplot2::labs(x="mz", y="intensity")
} else {
- p <- ggplot2::ggplot(df,ggplot2::aes(x=1:10,y=1:10))+ggplot2::geom_blank()+ggplot2::labs(x="",y="")
+ ddf <- data.table(x=1:10,y=1:10)
+ p <- ggplot2::ggplot(ddf,ggplot2::aes(x=x,y=y))+ggplot2::geom_blank()+ggplot2::labs(x="",y="")
p + ggplot2::annotate(geom="text", x=5, y=5, size=6, label="NO MS2 SPECTRA", color="black")+ggplot2::theme(axis.text.x=ggplot2::element_blank(),
axis.ticks.x=ggplot2::element_blank(),
axis.text.y=ggplot2::element_blank(),
axis.ticks.y=ggplot2::element_blank())
+
}
@@ -1358,3 +1350,263 @@ get_rt_interval <- function(data_ms1,data_ms2,conf_figures) {
llim <- max(rt_lim[[1]],ms1_lim[[1]],ms2_lim[[1]],na.rm = T)
c(llim-0.5,rlim+0.5)
}
+
+
+
+get_plot_data <- function(plot_index,plot_label,
+ summ_tab,summ_cols,extr_tab=NULL,
+ extr_cols=NULL) {
+ thenames<-ifelse(nchar(names(summ_cols))!=0,names(summ_cols),summ_cols)
+ names(summ_cols)<-thenames
+
+ ind_nms <- names(plot_index)
+ plot_group <- ind_nms[[1]]
+ plot_plot <- ind_nms[[2]]
+
+
+ meta <- summ_tab[get(ind_nms[[1]]) == plot_index[[1]] &
+ get(ind_nms[[2]]) == plot_index[[2]],
+ unique(.SD),.SDcols=c(plot_label,summ_cols)]
+
+ data.table::setkeyv(meta,plot_label)
+ data.table::setnames(meta,summ_cols,names(summ_cols))
+
+ if (!is.null(extr_tab)) {
+ data_cols <- c(plot_label,extr_cols)
+ data <- extr_tab[get(ind_nms[[1]]) == plot_index[[1]] &
+ get(ind_nms[[2]]) == plot_index[[2]],..data_cols]
+ return(meta[data,on=plot_label])
+ } else meta
+
+}
+
+
+get_ms1_chr_pdata <- function(m,plot_index) get_plot_data(m$out$tab$summ,
+ c("mz",
+ rt_peak="ms1_rt"),
+ m$extr$ms1,
+ extr_cols = c("rt","intensity"),
+ plot_index = plot_index,
+ plot_label = m$conf$figures$grouping$label)
+
+get_ms2_chr_pdata <- function(m,plot_index) {
+ z<- get_plot_data(plot_index = plot_index,
+ plot_label = c(m$conf$figures$grouping$label,"an"),
+ summ_tab = m$out$tab$summ,
+ summ_cols = c(prec_mz="mz",
+ rt_peak="ms2_rt",
+ int_peak="ms2_int",
+ "CE",
+ "ms2_sel"))
+ z$plot_label = factor(z$CE)
+ z$parent_label = factor(z[[m$conf$figures$grouping$label]])
+ z
+}
+
+get_ms2_spec_pdata <- function(m,plot_index) {
+ z <- get_plot_data(plot_index = plot_index,
+ plot_label = c(m$conf$figures$grouping$label,"an"),
+ summ_tab = m$out$tab$summ[ms2_sel == T,],
+ summ_cols = c(prec_mz="mz",
+ rt_peak="ms2_rt",
+ int_peak="ms2_int",
+ "CE",
+ "ms2_sel"),
+ extr_tab = m$extr$ms2,
+ extr_cols = c("mz","intensity"))
+ z$plot_label = factor(z$CE)
+ z$parent_label = factor(z[[m$conf$figures$grouping$label]])
+ z
+}
+
+##' @export
+plot_ms1_chr <- function(m,plot_index) {
+ pdata <- get_ms1_chr_pdata(m,plot_index)
+
+ if (NROW(data) < 0 ) {
+ p <- ggplot2::ggplot(data.frame(x=1:10,y=1:10),
+ ggplot2::aes(x=x,y=y))+
+ ggplot2::geom_blank()+ggplot2::labs(x="",y="")
+
+ p <- p + ggplot2::annotate(geom="text", x=5, y=5, size=6, label="NO MS1 SPECTRA", color="black")+
+ ggplot2::theme(axis.text.x=ggplot2::element_blank(),
+ axis.ticks.x=ggplot2::element_blank(),
+ axis.text.y=ggplot2::element_blank(),
+ axis.ticks.y=ggplot2::element_blank())
+ return(p)
+ } else
+
+ group_data <- m$conf$figures$grouping
+ plot_group <- names(plot_index)[[1]]
+ plot_plot <- names(plot_index)[[2]]
+ plot_label <- group_data$label
+
+ all_labels <- m$out$tab$flt_summ[,sort(unique(get(..plot_label)))]
+
+ style <- plot_decor(m,m$conf$logaxes$ms1_eic_int,
+ all_ms1_labels=all_labels,
+ legend_name_ms1=plot_label)
+
+ plot_eic_ms1_df(pdata,
+ style_fun = style,
+ plot_label = plot_label)
+
+
+
+}
+
+
+##' @export
+plot_ms2_chr <- function(m,plot_index) {
+ pdata <- get_ms2_chr_pdata(m,plot_index)
+
+ if (NROW(data) < 0 ) {
+ p <- ggplot2::ggplot(data.frame(x=1:10,y=1:10),
+ ggplot2::aes(x=x,y=y))+
+ ggplot2::geom_blank()+ggplot2::labs(x="",y="")
+
+ p <- p + ggplot2::annotate(geom="text", x=5, y=5, size=6, label="NO MS2 SPECTRA", color="black")+
+ ggplot2::theme(axis.text.x=ggplot2::element_blank(),
+ axis.ticks.x=ggplot2::element_blank(),
+ axis.text.y=ggplot2::element_blank(),
+ axis.ticks.y=ggplot2::element_blank())
+ return(p)
+ } else
+
+ group_data <- m$conf$figures$grouping
+ plot_group <- names(plot_index)[[1]]
+ plot_plot <- names(plot_index)[[2]]
+ plot_ms1_label <- group_data$label
+
+ all_ms1_labels <- m$out$tab$summ[,sort(unique(get(plot_ms1_label)))]
+ all_ms2_ce_labels <- m$out$tab$summ[,sort(na.omit(unique(CE)))]
+
+ style <- plot_decor(m,m$conf$logaxes$ms2_eic_int,
+ all_ms1_labels = all_ms1_labels,
+ all_ms2_labels = all_ms2_ce_labels,
+ legend_name_ms1 = plot_ms1_label,
+ legend_name_ms2 = "CE")
+
+ plot_eic_ms2_df(pdata, style_fun = style)
+
+
+
+}
+
+
+##' @export
+plot_ms2_spec <- function(m,plot_index) {
+ pdata <- get_ms2_spec_pdata(m,plot_index)
+ if (NROW(data) < 0 ) {
+ p <- ggplot2::ggplot(data.frame(x=1:10,y=1:10),
+ ggplot2::aes(x=x,y=y))+
+ ggplot2::geom_blank()+ggplot2::labs(x="",y="")
+
+ p <- p + ggplot2::annotate(geom="text", x=5, y=5, size=6, label="NO MS2 SPECTRA", color="black")+
+ ggplot2::theme(axis.text.x=ggplot2::element_blank(),
+ axis.ticks.x=ggplot2::element_blank(),
+ axis.text.y=ggplot2::element_blank(),
+ axis.ticks.y=ggplot2::element_blank())
+ return(p)
+ } else
+
+ group_data <- m$conf$figures$grouping
+ plot_group <- names(plot_index)[[1]]
+ plot_plot <- names(plot_index)[[2]]
+ plot_ms1_label <- group_data$label
+
+ all_ms1_labels <- m$out$tab$summ[,sort(unique(get(plot_ms1_label)))]
+ all_ms2_ce_labels <- m$out$tab$summ[,sort(na.omit(unique(CE)))]
+
+ style <- plot_decor(m,m$conf$logaxes$ms2_spec_int,
+ all_ms1_labels = all_ms1_labels,
+ all_ms2_labels = all_ms2_ce_labels,
+ legend_name_ms1 = plot_ms1_label,
+ legend_name_ms2 = "CE")
+
+
+ plot_spec_ms2_df(pdata, style_fun = style)
+
+
+
+}
+
+##' @export
+plot_struct <- function(m,plot_index) {
+
+ id <- plot_index[["ID"]]
+ if (is.null(id)) {
+ p <- ggplot2::ggplot(data.frame(x=1:10,y=1:10),
+ ggplot2::aes(x=x,y=y))+
+ ggplot2::geom_blank()+ggplot2::labs(x="",y="")
+
+ p <- p + ggplot2::annotate(geom="text", x=5, y=5, size=6, label="STRUCTURE PLOT UNAVAILABLE", color="black")+
+ ggplot2::theme(axis.text.x=ggplot2::element_blank(),
+ axis.ticks.x=ggplot2::element_blank(),
+ axis.text.y=ggplot2::element_blank(),
+ axis.ticks.y=ggplot2::element_blank())
+ return(p)
+ } else {
+ ## grid::grid.draw(gridExtra::arrangeGrob(m$out$tab$structfig[ID==id,img][[1]]))
+ grid::grid.draw(m$out$tab$structfig[ID==id,img][[1]],
+ recording = F)
+
+ }
+
+}
+
+
+##' @export
+plot_struct_nowrap <- function(m,plot_index) {
+
+ id <- plot_index[["ID"]]
+ if (is.null(id)) {
+ p <- ggplot2::ggplot(data.frame(x=1:10,y=1:10),
+ ggplot2::aes(x=x,y=y))+
+ ggplot2::geom_blank()+ggplot2::labs(x="",y="")
+
+ p <- p + ggplot2::annotate(geom="text", x=5, y=5, size=6, label="STRUCTURE PLOT UNAVAILABLE", color="black")+
+ ggplot2::theme(axis.text.x=ggplot2::element_blank(),
+ axis.ticks.x=ggplot2::element_blank(),
+ axis.text.y=ggplot2::element_blank(),
+ axis.ticks.y=ggplot2::element_blank())
+ return(p)
+ } else {
+ m$out$tab$structfig[ID==id,img][[1]]
+ }
+
+}
+
+
+##' @export
+gen_key_plot_tab <- function(m) {
+
+
+ fltsumm <- m$out$tab$flt_summ
+ validate(need(NROW(fltsumm) > 0,
+ message = "Generate summary table first."))
+
+
+ plot_group <- m$conf$figures$grouping$group
+ plot_plot <- m$conf$figures$grouping$plot
+ plot_label <- m$conf$figures$grouping$label
+ plot_key <- c(plot_group,plot_plot)
+
+
+ idx <- fltsumm[,{
+ lapply(.SD,
+ function (col) {
+ val <- unique(col)
+ if (length(val)<=1) T else F
+ })
+
+ },
+ by=c(plot_group,plot_plot)]
+ idxlst <- as.logical(idx[,lapply(.SD,function (col) all(col))])
+ nmidx <- colnames(idx)
+ cols <- nmidx[idxlst]
+ cols <- na.omit(setdiff(cols,plot_key))
+ fltsumm[,unique(.SD[,..cols]),
+ by=plot_key]
+
+}
diff --git a/R/resources.R b/R/resources.R
index b52819538b1b5a6d1841652acd6f83ed6b84c7d4..9fe17a4765fd3ad954b7d6f55fb1579dff1d3b55 100644
--- a/R/resources.R
+++ b/R/resources.R
@@ -116,7 +116,7 @@ MS1_SN_FAC <- 3.0
## Shiny objects
-NUM_INP_WIDTH="15%"
+NUM_INP_WIDTH=40
NUM_INP_HEIGHT="5%"
@@ -192,11 +192,6 @@ FIG_DEF_SUBSET <- c("set","adduct","ID")
REPORT_AUTHOR <- "Anonymous"
REPORT_TITLE <- "Plots of EICs and MS2 Spectra"
-
-PLOT_FEATURES <- c("adduct",
- "tag",
- "ID")
-
## Select the most fundamental group of entries. Within this group,
## each ID is unique.
BASE_KEY <- c("adduct","tag","ID")
@@ -211,6 +206,10 @@ FIG_DEF_CONF <-list(grouping=list(group="adduct",
SUMM_COLS=c("set",BASE_KEY_MS2,"an","mz","ms1_rt", "ms1_int", "ms2_rt", "ms2_int",
"ms1_mean","ms2_sel",QA_FLAGS,"Name", "SMILES", "Formula", "known","Comments","file")
+PLOT_FEATURES <- c("adduct",
+ "tag",
+ "ID")
+
## Empty summary table.
EMPTY_SUMM <- data.table::data.table(set=character(0),
adduct=character(0),
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index 09078bba116708ca2bb0f9255697057153db7744..bc83bf3e49f47b3ff8a25ec3acbf63f2cd0a49eb 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -107,17 +107,21 @@ mz_input <- function(input_mz,input_unit,width=NUM_INP_WIDTH,height=NUM_INP_HEIG
}
##' @export
-rt_input <- function(input_rt,input_unit,width=NUM_INP_WIDTH,height=NUM_INP_HEIGHT,def_rt=0,def_unit="min",pref="+/-") {
+rt_input <- function(input_rt,input_unit,width=NUM_INP_WIDTH,width_u=1-NUM_INP_WIDTH,height=NUM_INP_HEIGHT,def_rt=0,def_unit="min",pref="+/-") {
+ width=paste0(as.character(width), "%")
+ width_u=paste0(as.character(width_u), "%")
+
style="display: inline-block; vertical-align:top; width: "
style=paste0(style,width,"; ")
stylel <- "display: inline-block; vertical-align:top;"
+ styleu <- paste0("display: inline-block; vertical-align:top; color: black; width: ",width_u,";")
shiny::div(shiny::div(style=stylel,
shiny::tags$label(pref,`for`=input_rt)),
shiny::div(style=style,
shiny::numericInput(input_rt,
label=NULL,
value = def_rt)),
- shiny::div(style=style,
+ shiny::div(style=styleu,
shiny::selectInput(input_unit,
label=NULL,
c("min","s"),
diff --git a/inst/rmd/app.Rmd b/inst/rmd/app.Rmd
index e5c25857855e112ea080e503120b0628861c9784..47f0556fb375338533914380bfc294ae8da213bf 100644
--- a/inst/rmd/app.Rmd
+++ b/inst/rmd/app.Rmd
@@ -9,6 +9,7 @@ title: "`r paste('Shinyscreen', packageVersion('shinyscreen'))`"
library(data.table)
library(shinyscreen)
library(ggplot2)
+## library(shinydashboard)
def_state <- new_state()
def_datafiles <- shinyscreen:::dtable(file=character(0),
tag=character(0))
@@ -339,88 +340,6 @@ rhandsontable::rHandsontableOutput("order_summ")
</div>
-## Plots
-
-### Logarithmic axis
-
-```{r, echo=F}
-checkboxGroupInput("plot_log",
- label=NULL,
- choices = c("MS1 EIC","MS2 EIC","MS2 Spectrum"),
- selected = character(0))
-```
-
-### Global retention time range
-```{r, echo=F}
-shinyscreen::rt_input(input_rt = "plot_rt_min",
- input_unit = "plot_rt_min_unit",
- def_rt = NA_real_,
- def_unit = "min",
- pref = "min:")
-
-shinyscreen::rt_input(input_rt = "plot_rt_max",
- input_unit = "plot_rt_max_unit",
- def_rt = NA_real_,
- def_unit = "min",
- pref = "max:")
-```
-
-### Grouping plots
-
-<details><summary>How to group plots?</summary>
-
-Plots are organised according to three categories: _plot group_,
-_label group_ and _label_. Category _label_ represents a line in a
-plot (for example, data from a specific file designated by _tag_ key
-in the file table). Category _label group_ defines how different
-labels are grouped together onto a graph (for continuing from the
-previous example, if _label group_ is _ID_ then all _tag_s connected
-to a single _ID_ are going to be plotted together on a graph). Lastly,
-Different _label group_s are going to be organised into _plot group_s.
-
-Keys in different categores must be different.
-
-</details>
-
-<div style= "display: flex; vertical-align:top; ">
-
-<div style="padding-right:0.5em;">
-```{r, echo=F}
-p_feats <- 1:length(PLOT_FEATURES)
-names(p_feats) <- PLOT_FEATURES
-selectInput(inputId = "plot_grp",
- label = "Group plots",
- choices = p_feats,
- selected = p_feats[[shinyscreen:::FIG_DEF_CONF$grouping[["group"]]]],
- width = "100%")
-```
-</div>
-
-<div style="padding-right:0.5em;padding-left:0.5em;">
-```{r, echo=F}
-p_feats <- 1:length(PLOT_FEATURES)
-names(p_feats) <- PLOT_FEATURES
-selectInput(inputId = "plot_grp_plot",
- label = "Group labels",
- choices = p_feats,
- selected = p_feats[[shinyscreen:::FIG_DEF_CONF$grouping[["plot"]]]],
- width = "100%")
-```
-</div>
-
-<div style="padding-left:0.5em;">
-```{r, echo=F}
-p_feats <- 1:length(PLOT_FEATURES)
-names(p_feats) <- PLOT_FEATURES
-selectInput(inputId = "plot_label",
- label = "Label",
- choices = p_feats,
- selected = p_feats[[shinyscreen:::FIG_DEF_CONF$grouping[["label"]]]],
- width = "100%")
-```
-</div>
-
-</div>
## Report
```{r, echo=F}
@@ -509,21 +428,72 @@ actionButton(inputId = "sortsubset_b",
</div>
-# Browse Results
+# Browse Results {.tabset}
## Summary table
```{r, echo=FALSE}
DT::dataTableOutput("summ_table")
```
+## Data Explorer
+### Grouping plots
+
+<details><summary>How to group plots?</summary>
+
+Plots are organised according to three categories: _plot group_,
+_label group_ and _label_. Category _label_ represents a line in a
+plot (for example, data from a specific file designated by _tag_ key
+in the file table). Category _label group_ defines how different
+labels are grouped together onto a graph (for continuing from the
+previous example, if _label group_ is _ID_ then all _tag_s connected
+to a single _ID_ are going to be plotted together on a graph). Lastly,
+Different _label group_s are going to be organised into _plot group_s.
+
+Keys in different categores must be different.
+
+</details>
+
+<div style= "display: flex; vertical-align:top; ">
+
+<div style="padding-right:0.5em;">
```{r, echo=F}
+p_feats <- 1:length(PLOT_FEATURES)
+names(p_feats) <- PLOT_FEATURES
+selectInput(inputId = "plot_grp",
+ label = "Group plots",
+ choices = p_feats,
+ selected = p_feats[[shinyscreen:::FIG_DEF_CONF$grouping[["group"]]]],
+ width = "100%")
+```
+</div>
-uiOutput("plot_b_ctrl")
+<div style="padding-right:0.5em;padding-left:0.5em;">
+```{r, echo=F}
+p_feats <- 1:length(PLOT_FEATURES)
+names(p_feats) <- PLOT_FEATURES
+selectInput(inputId = "plot_grp_plot",
+ label = "Group labels",
+ choices = p_feats,
+ selected = p_feats[[shinyscreen:::FIG_DEF_CONF$grouping[["plot"]]]],
+ width = "100%")
+```
+</div>
+<div style="padding-left:0.5em;">
+```{r, echo=F}
+p_feats <- 1:length(PLOT_FEATURES)
+names(p_feats) <- PLOT_FEATURES
+selectInput(inputId = "plot_label",
+ label = "Label",
+ choices = p_feats,
+ selected = p_feats[[shinyscreen:::FIG_DEF_CONF$grouping[["label"]]]],
+ width = "100%")
```
+</div>
+
+</div>
-## Visualisation
### Plot selection
@@ -531,36 +501,68 @@ uiOutput("plot_b_ctrl")
DT::dataTableOutput("plot_sel")
```
-### Chromatograms and spectra
-
Each plot supports zooming by selecting an area within the plot. The
zoom can be reset by double clicking on the plot surface.
-```{r,echo=F}
-verbatimTextOutput("plot_hover_out")
-````
+<!-- <div style="overflow-y:scroll;max-height:80vh; width: 100%; background: white;"> -->
+```{r echo=F}
+sidebarLayout(sidebarPanel(h5("Global RT range"),
+ shinyscreen::rt_input(input_rt = "plot_rt_min",
+ input_unit = "plot_rt_min_unit",
+ width=55,
+ width_u=40,
+ def_rt = "min",
+ def_unit = "min",
+ pref = ""),
+
+ shinyscreen::rt_input(input_rt = "plot_rt_max",
+ input_unit = "plot_rt_max_unit",
+ width=55,
+ width_u=40,
+ def_rt = "max",
+ def_unit = "min",
+ pref = ""),
+ hr(),
+ h5("Log scale"),
+ checkboxGroupInput("plot_log",
+ label=NULL,
+ choices = c("MS1 EIC","MS2 EIC","MS2 Spectrum"),
+ selected = character(0)),
+ hr(),
+ uiOutput("plot_b_ctrl"),
+ h5("Pointer position"),
+ textOutput("plot_hover_out"),
+ width=4),
+ wellPanel(id = "tPanel",style = "overflow-y:scroll; max-height:80vh; background: white",
+ column(6,
+ plotOutput("plot_ms1_eic",
+ hover = hoverOpts(id="plot_hover",
+ delayType = "throttle",
+ delay=100),
+ dblclick = "plot_rt_click",
+ brush = "plot_brush"),
+ plotOutput("plot_ms2_eic",
+ hover = hoverOpts(id="plot_hover",
+ delayType = "throttle",
+ delay=100),
+ dblclick = "plot_rt_click",
+ brush = "plot_brush")),
+ column(6,
+ plotOutput("plot_struct"),
+ plotOutput("plot_ms2_spec",
+ hover = hoverOpts(id="plot_hover",
+ delayType = "throttle",
+ delay=100),
+ dblclick = "plot_mz_click",
+ brush = brushOpts(id="plot_mz_brush")))))
+
+
+
+```
+<!-- </div> -->
+
```{r, echo=F}
-wellPanel(id = "tPanel",style = "overflow-y:scroll;max-height:80vh; width: 100%; background: white",
- column(6,
- plotOutput("plot_ms1_eic",
- hover = hoverOpts(id="plot_hover",
- delayType = "throttle",
- delay=100),
- dblclick = "plot_rt_click",
- brush = "plot_brush"),
- plotOutput("plot_ms2_eic",
- hover = hoverOpts(id="plot_hover",
- delayType = "throttle",
- delay=100),
- dblclick = "plot_rt_click",
- brush = "plot_brush")),
- column(6,
- plotOutput("plot_ms2_spec",
- hover = hoverOpts(id="plot_hover",
- delayType = "throttle",
- delay=100),
- dblclick = "plot_mz_click",
- brush = brushOpts(id="plot_mz_brush"))))
+
```
<!-- ENGINE -->
@@ -574,15 +576,35 @@ ord_asc <- grepl("^-.+",shinyscreen:::DEF_INDEX_SUMM)
ord_asc <- factor(ifelse(ord_asc, "descending", "ascending"),levels = c("ascending","descending"))
def_ord_summ <- shinyscreen:::dtable("Column Name"=ord_nms,"Direction"=ord_asc)
+adapt_range <- function(fig,x_range=NULL) {
+ if (is.null(x_range)) fig else fig+coord_cartesian(xlim=x_range)
+}
+
-plot2rend <- function(plottab,seltab,row,plot_group,plot_plot,fig,x_range=NULL) {
+plot_boiler <- function(m,tab,row,plot_fun,rv_x_range,adapt_x_range=T) {
+ req(row)
+ plot_group <- m$conf$figures$grouping$group
+ plot_plot <- m$conf$figures$grouping$plot
+ ms1_plot <- m$out$tab$ms1_plot
+ ms1_plot <- m$out$tab$ms1_plot
req(row)
- req(NROW(seltab)>0)
- req(NROW(plottab)>0)
- sel_grp <- seltab[row,.SD,.SDcols=c(plot_group,plot_plot)]
- fig <- plottab[sel_grp,on=c(plot_group,plot_plot),nomatch=NULL][[fig]][[1]]
- if (!is.null(x_range)) fig <- fig+coord_cartesian(xlim=x_range)
- fig
+ idx <- get_plot_idx(tab = tab,
+ plot_group = plot_group,
+ plot_plot = plot_plot,
+ row =row)
+ fig <- plot_fun(m=m,plot_index = idx)
+ x_range <- if (adapt_x_range) c(rv_x_range$min,rv_x_range$max) else NULL
+ adapt_range(fig,x_range=x_range)
+}
+
+
+get_plot_idx <- function(tab,plot_group,plot_plot,row) {
+ pg <- tab[row,..plot_group]
+ pp <- tab[row,..plot_plot]
+ res <- c(pg,pp)
+ names(res) <- c(plot_group,plot_plot)
+ res
+
}
update_gui <- function(in_conf, session) {
@@ -791,17 +813,20 @@ rf_summ_table_rows <- eventReactive(input$summ_table_rows_all,{
})
rf_gen_sel_plot_tab <- reactive({
- validate(need(NROW(rv_state$out$tab$ms1_plot) > 0,
- message = "No plots found. Did you generate them?"))
+
+ rv_state$out$tab$flt_summ
+ m <- rev2list(rv_state)
+ fltsumm <- m$out$tab$flt_summ
+ validate(need(NROW(fltsumm) > 0,
+ message = "Generate summary table first."))
+
rows <- rf_summ_table_rows()
- plot_group <- rv_state$conf$figures$grouping$group
- plot_plot <- rv_state$conf$figures$grouping$plot
- plot_label <- rv_state$conf$figures$grouping$label
-
- summt<-rv_state$out$tab$flt_summ[rows,unique(.SD),.SDcols=c(plot_group,plot_plot)]
- summt
+ ## Reduce to currently selected rows.
+ m$out$tab$flt_summ <- m$out$tab$flt_summ[rows,]
+ gen_key_plot_tab(m)
+
})
rf_rtrange_from_data <- eventReactive(input$plot_sel_cell_clicked,{
@@ -818,17 +843,14 @@ rf_rtrange_from_data <- eventReactive(input$plot_sel_cell_clicked,{
mpl1 <- ms1_plot[sel_grp,on=c(plot_group,plot_plot),nomatch=NULL]
mpl2 <- ms2_plot[sel_grp,on=c(plot_group,plot_plot),nomatch=NULL]
- message('sel_grp')
- print(sel_grp)
-
res <- shinyscreen:::get_rt_interval(mpl1$fig_eic[[1]]$data,mpl2$fig_eic[[1]]$data,rv_state$conf$figures)
- message("RES:")
- print(res)
- print(class(res))
res
})
+
+
+rf_gen_struct_figs <- eventReactive(rv_state$out$tab$comp,gen_struct_plots(rv_state))
```
<!-- OBSERVERS -->
@@ -1002,8 +1024,7 @@ observeEvent(input$plot_b,{
yaml::write_yaml(x=m$conf,file=fn_c_state)
message("(generate plots) Config written to ", fn_c_state)
state <- shinyscreen::run(m=m,
- phases=c("plot",
- "saveplot"))
+ phases=c("plot"))
message("(generate plots) Done generating plots.")
z <- shinyscreen::merge2rev(rv_state,lst = state)
@@ -1087,6 +1108,12 @@ observeEvent(input$plot_mz_click,
rv_mzrange$max <- NA
})
+
+observeEvent(rv_state$out$tab$comp,{
+ m <- gen_struct_plots(rev2list(rv_state))
+ rv_state$out$tab$structfig <- m$out$tab$structfig
+}, label = "gen_struct_plots")
+
observeEvent(input$plot_mz_brush,{
xmin <- input$plot_mz_brush[["xmin"]]
xmax <- input$plot_mz_brush[["xmax"]]
@@ -1300,77 +1327,63 @@ output$plot_b_ctrl <- renderUI({
tab <- rv_state$out$tab$flt_summ
req(NROW(tab)>0)
actionButton(inputId = "plot_b",
- label= "Generate plots")
+ label= "Save all plots")
})
output$plot_ms1_eic <- renderPlot({
- tab <- rf_gen_sel_plot_tab()
-
- plot_group <- rv_state$conf$figures$grouping$group
- plot_plot <- rv_state$conf$figures$grouping$plot
- ms1_plot <- rv_state$out$tab$ms1_plot
- ms1_plot <- rv_state$out$tab$ms1_plot
- row <- input$plot_sel_cell_clicked[["row"]]
- rt_range <- c(rv_rtrange$min,
- rv_rtrange$max)
- plot2rend(plottab=ms1_plot,
- seltab=tab,
- row=row,
- plot_group=plot_group,
- plot_plot=plot_plot,
- x_range=rt_range,
- "fig_eic")
+ plot_boiler(m=rv_state,
+ tab=rf_gen_sel_plot_tab(),
+ row=input$plot_sel_cell_clicked[["row"]],
+ plot_fun=plot_ms1_chr,
+ rv_x_range=rv_rtrange)
})
output$plot_ms2_eic <- renderPlot({
- tab <- rf_gen_sel_plot_tab()
-
- plot_group <- rv_state$conf$figures$grouping$group
- plot_plot <- rv_state$conf$figures$grouping$plot
- ms2_plot <- rv_state$out$tab$ms2_plot
- ms2_plot <- rv_state$out$tab$ms2_plot
- row <- input$plot_sel_cell_clicked[["row"]]
- rt_range <- c(rv_rtrange$min,
- rv_rtrange$max)
- plot2rend(plottab=ms2_plot,
- seltab=tab,
- row=row,
- plot_group=plot_group,
- plot_plot=plot_plot,
- x_range=rt_range,
- "fig_eic")
+ plot_boiler(m=rv_state,
+ tab=rf_gen_sel_plot_tab(),
+ row=input$plot_sel_cell_clicked[["row"]],
+ plot_fun=plot_ms2_chr,
+ rv_x_range=rv_rtrange)
})
+
+
output$plot_ms2_spec <- renderPlot({
- tab <- rf_gen_sel_plot_tab()
+ plot_boiler(m=rv_state,
+ tab=rf_gen_sel_plot_tab(),
+ row=input$plot_sel_cell_clicked[["row"]],
+ plot_fun=plot_ms2_spec,
+ rv_x_range=rv_mzrange)
- plot_group <- rv_state$conf$figures$grouping$group
- plot_plot <- rv_state$conf$figures$grouping$plot
- ms2_plot <- rv_state$out$tab$ms2_plot
- ms2_plot <- rv_state$out$tab$ms2_plot
- row <- input$plot_sel_cell_clicked[["row"]]
- mz_range <- c(rv_mzrange$min,
- rv_mzrange$max)
- plot2rend(plottab=ms2_plot,
- seltab=tab,
- row=row,
- plot_group=plot_group,
- plot_plot=plot_plot,
- x_range = mz_range,
- "fig_spec")
-
+})
+
+output$plot_struct <- renderPlot({
+ req(NROW(rv_state$out$tab$structfig)>0)
+ message("plot struuuct")
+ plot_boiler(m=rv_state,
+ tab=rf_gen_sel_plot_tab(),
+ row=input$plot_sel_cell_clicked[["row"]],
+ plot_fun=plot_struct,
+ adapt_x_range=F)
})
output$plot_hover_out <- renderText({
- pr <- "Pointer position: "
- paste0(pr,'(',
- format(input$plot_hover[[1]],digits=5),
- ',',
- format(input$plot_hover[[2]],digits=2,scientific=T),
- ')')})
+ inp1 <- input$plot_hover[[1]]
+ inp2 <- input$plot_hover[[2]]
+ res <- if (all(!(c(is.null(inp1),is.null(inp2))))) {
+ paste0('(',
+ format(inp1,digits=5),
+ ',',
+ format(inp2,digits=2,scientific=T),
+ ')')
+ } else "Currently not in the plot."
+
+})
+
+
```