From adb6cec3b47e645fa96431962be96fa58ffdcd8b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <todor.kondic@uni.lu>
Date: Thu, 10 Dec 2020 13:32:18 +0100
Subject: [PATCH] Squashed commit of the following:
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
commit ad789545c8fab046edc9f97c36c796006d576bf8
Author: Todor Kondić <todor.kondic@uni.lu>
Date: Thu Dec 10 13:21:13 2020 +0100
all: Version 0.9.3
We have redesigned the way the plotting works and how the data
exploration is situated within the application's interactive document.
Previously, plots have been generated and stored as tables in the
m$out$tab sublist of the state object (m). This, however, made it a
bit more difficult to manipulate plot details which differ between how
the plots are supposed to be displayed as a part of the application
and how they look like as individual figures.
The new approach is to have functions that generate single plots based
on plot index (see m$conf$figures$grouping) instead of pregenerating
collections of plots. The same functions are used in parts of the code
that display this interactively to a user (app.Rmd, the data explorer)
and those that save figures. The program knows when to apply
modifications which will make the output suitable to the format of
display.
The plot selection table, as well as the plots themselves are now
hidden in the Data Explorer tab. The plot parameters have been moved
from the beginning of the document to a side panel. The plots are
displayed within a well panel next to the side panel.
---
DESCRIPTION | 12 +-
NAMESPACE | 7 +
R/api.R | 197 ++++++++++++-----------
R/mix.R | 298 ++++++++++++++++++++++++++++++++---
R/resources.R | 11 +-
R/shiny-ui-base.R | 8 +-
inst/rmd/app.Rmd | 391 ++++++++++++++++++++++++----------------------
7 files changed, 604 insertions(+), 320 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 3f20c19..5ed7ee2 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 016758a..bc5cd3d 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 f15bc37..4878a9a 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 36f2c1e..952e19d 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 b528195..9fe17a4 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 09078bb..bc83bf3 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 e5c2585..47f0556 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."
+
+})
+
+
```
--
GitLab