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

all: Complete adapting plot and saveplot phases to new data format

parent 078e27c4
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
R/api.R
+ 69
− 51
View file @ 187fcaf9
......@@ -314,7 +314,7 @@ extr_data <- function(m) {
## Reduce the comp table to only unique masses (this is because
## different sets can have same masses).
m$out$tab$data <- m$out$tab$comp[,head(.SD,1),by=c('adduct','tag','ID')]
m$out$tab$data <- m$out$tab$comp[,head(.SD,1),by=BASE_KEY]
m$out$tab$data[,set:=NULL] #This column is meaningless now.
files <- m$out$tab$data[,unique(Files)]
allCEs <- do.call(c,args=lapply(files,function(fn) {
......@@ -451,7 +451,6 @@ sort_spectra <- function(m) {
for (n in 1:length(cols)) tmp[[2+n]] <- parse(text=cols[[n]])[[1]]
message("Ordering expression: \n",deparse(tmp))
eval(tmp) #Execute the setorder call
m
}
......@@ -476,6 +475,7 @@ subset_summary <- function(m) {
} else m$out$tab$summ
m
}
......@@ -485,14 +485,7 @@ create_plots <- function(m) {
## conf$figures$grouping.
## Select the data nedeed for plotting.
x <- m$out$tab$flt_summ
message("Generate plot data.")
ms1_plot_data <- gen_base_ms1_plot_tab(summ=x,
ms1_spec=m$out$tab$ms1_spec)
ms2_plot_data <- gen_base_ms2_plot_tab(summ=x,
ms2_spec=m$out$tab$ms2_spec)
message("Done generating plot data.")
flt_summ <- m$out$tab$flt_summ
group_data <- m$conf$figures$grouping
plot_group <- if (!shiny::isTruthy(group_data$group)) FIG_DEF_CONF$grouping$group else group_data$group
......@@ -508,9 +501,11 @@ create_plots <- function(m) {
plot_index <- c(plot_group,plot_plot)
## All the possible curve labels.
all_ms1_labels <- ms1_plot_data[,unique(.SD),.SDcols=plot_ms1_label][[plot_ms1_label]]
all_ms2_ce_labels <- ms2_plot_data[,unique(CE)]
all_ms1_labels <- flt_summ[,unique(.SD),.SDcols=plot_ms1_label][[plot_ms1_label]]
all_ms1_labels <- sort(all_ms1_labels[!is.na(all_ms1_labels)])
all_ms2_ce_labels <- flt_summ[,unique(CE)]
all_ms2_ce_labels <- sort(all_ms2_ce_labels[!is.na(all_ms2_ce_labels)])
## Plot styling.
style_eic_ms1 <- plot_decor(m,m$conf$logaxes$ms1_eic_int,
all_ms1_labels=all_ms1_labels,
......@@ -534,50 +529,73 @@ create_plots <- function(m) {
ms1_legend_info = F)
message("Create MS1 EIC plots.")
## Generate MS1 EIC plots.
ms1_plot <- ms1_plot_data[,.(fig_eic={
df <- .SD[,data.table::rbindlist(Map(function (a,b,c,d) {
s <- a[[1]]
s$plot_label <- b
s$rt_peak <- c
s$mz <- d
s},
eicMS1,
.SD[[..plot_ms1_label]],
rt_peak,
mz))]
list(plot_eic_ms1(df,style_fun = style_eic_ms1,
plot_label = ..plot_ms1_label))
}),by = plot_index]
m$out$tab$ms1_plot <- ms1_plot
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,"/",z.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.")
ms2_plot_data[,parent_label:=factor(.SD[[1]]),.SDcols=plot_ms1_label]
ms2_plot_data[,plot_label:=factor(CE)]
ms2_plot <- ms2_plot_data[,
.(fig_eic=list(plot_eic_ms2(df=.SD,
style_fun = style_eic_ms2)),
fig_spec=list(plot_spec_ms2(df=.SD,
style_fun = style_spec_ms2)),
fig_leg= list(plot_leg_ms2(df=.SD,
style_fun = style_ms2_leg))),
.SDcols=c("rt_peak","int_peak",
plot_ms1_label,
"parent_label",
"plot_label",
"spec",
"ms2_sel",
"mz"),
by = plot_index]
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))
)
},
.SDcols = c("adduct","tag","ID","CE","mz","intensity"),
on = plot_index,
by = .EACHI]
message("Done creating MS1 EIC plots.")
## Generate structure plots.
structab <- ms1_plot_data[,.(ID=unique(ID))]
structab <- m$out$tab$comp[known=="structure",][structab,.(ID=i.ID,SMILES=SMILES),on="ID",nomatch=NULL,mult="first"]
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})]
......@@ -586,7 +604,7 @@ create_plots <- function(m) {
## 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"][,c("fig_struct") := .(Map(function (st,eic) {
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)
......
R/mix.R
+ 111
− 83
View file @ 187fcaf9
......@@ -258,14 +258,14 @@ preProc <- function (summ,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=500
if (maxInt < noiseFac*mInt) {
summ[ind,"AboveNoise"] <- F
summ[ind,"Alignment"] <- F ## If noisy, this is
## probably meaningles, so
## F.
## probably meaningles, so
## F.
}
}
}
## MS2 checks.
ms2<-allData[[wd]]$ms2
......@@ -304,20 +304,20 @@ preProc <- function (summ,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=500
}
summ[ind,"checked"]<-SUMM_CHK_AUTO
}
summ
}
smiles2img <- function(smiles, kekulise=TRUE, width=300, height=300,
zoom=1.3,style="cow", annotate="off", abbr="on",suppressh=TRUE,
showTitle=FALSE, smaLimit=100, sma=NULL) {
dep <- rcdk::get.depictor(width = width, height = height, zoom = zoom, style = style, annotate = annotate,
abbr = abbr, suppressh = suppressh, showTitle = showTitle, smaLimit = smaLimit,
sma = NULL)
mol <- RMassBank::getMolecule(smiles)
z<-rcdk::view.image.2d(mol, depictor=dep)
grid::rasterGrob(z)
zoom=1.3,style="cow", annotate="off", abbr="on",suppressh=TRUE,
showTitle=FALSE, smaLimit=100, sma=NULL) {
dep <- rcdk::get.depictor(width = width, height = height, zoom = zoom, style = style, annotate = annotate,
abbr = abbr, suppressh = suppressh, showTitle = showTitle, smaLimit = smaLimit,
sma = NULL)
mol <- RMassBank::getMolecule(smiles)
z<-rcdk::view.image.2d(mol, depictor=dep)
grid::rasterGrob(z)
}
gen_ms2_spec_data <- function(id,tag,iMS2rt,data,luckyN=NA) {
......@@ -500,11 +500,11 @@ plot_id_msn <- function(ni,
ggobj+
ggplot2::geom_linerange(ggplot2::aes(colour=legend),key_glyph=KEY_GLYPH)+
ggplot2::coord_cartesian(xlim = rrtMS2,
ylim = rintMS2)+
ylim = rintMS2)+
ggplot2::labs(x=CHR_GRAM_X,y=CHR_GRAM_Y,title=NULL,subtitle = "MS2",tag = " ")+
scale_y(labels=sci10)+
ggplot2::labs(colour=PLOT_MS2_LEG_TIT)+theme()
ggplot2::labs(colour=PLOT_MS2_LEG_TIT)+theme()
}
......@@ -518,7 +518,7 @@ plot_id_msn <- function(ni,
ggobj+
ggplot2::geom_linerange(ggplot2::aes(colour=tag),key_glyph=KEY_GLYPH)+
ggplot2::coord_cartesian(xlim = rmzSpMS2,
ylim = rintSpMS2)+
ylim = rintSpMS2)+
ggplot2::labs(subtitle="MS2",y="intensity")+
scale_y(labels=sci10)+theme()
}
......@@ -527,7 +527,7 @@ plot_id_msn <- function(ni,
## MS1 time series.
plMS1<- if(is.data.frame(dfChrMS1) && nrow(dfChrMS1)>0) {
ch_ms1_deco(ggplot2::ggplot(data=dfChrMS1,ggplot2::aes(x=rt,y=intensity,group=legend)))
} else NULL
} else NULL
## Empty
plEmpty<-ggplot2::ggplot(data=dfChrMS1,ggplot2::aes(x=rt,y=intensity))+ggplot2::theme_void()
......@@ -539,9 +539,9 @@ plot_id_msn <- function(ni,
} else plEmpty
## Structure
if (!is.null(smile) && !is.na(smile) && !nchar(smile)<1) {
......@@ -554,14 +554,14 @@ plot_id_msn <- function(ni,
## MS2 Spectrum
if (!all(sapply(dfsChrMS2,is.null))) {
plSpecMS2<-if (is.data.frame(dfSpecMS2)) { #sometimes
#dfSpecMS2 ends up
#as a list of
#logicals; this
#probably happens
#when either MS2 is
#bad in some way,
#or the RT
#intervals are
#dfSpecMS2 ends up
#as a list of
#logicals; this
#probably happens
#when either MS2 is
#bad in some way,
#or the RT
#intervals are
#mismatched.
ch_spec_deco(ggplot2::ggplot(data=dfSpecMS2,
ggplot2::aes(x=mz,
......@@ -584,7 +584,7 @@ plot_id_msn <- function(ni,
## str(df)
## message("---DF")
## gridExtra::tableGrob(df) #+ggplot2::labs(subtitle="Top m/z")
## } else NULL
res<- if (!is.null(plMS1)) cowplot::plot_grid(plMS1,plStruc,plMS2,plEmpty,plSpecMS2,align = "hv",axis='l',ncol = 2,nrow=3,rel_widths=c(3,1)) else NULL
......@@ -617,14 +617,14 @@ getEntryFromComp<-function(entry,id,set,adduct,compTab) {
res
names(res)<-entry
res
}
## add_comp_summ <- function(ft,ctab) {
## nR<-nrow(ft)
## mzCol<-rep(NA,nR)
## nmCol<-rep("",nR)
## rtCol<-rep(NA,nR)
## for (ir in 1:nR) {
## id<-ft[ir,"ID"]
## set<-ft[ir,"set"]
......@@ -835,7 +835,7 @@ verify_cmpd_l <- function(dt,fn) {
exst <- ess[pres]
x <- lapply(exst,function (nm) do.call(all,as.list(is.na(dt[[nm]]))))
assert(!do.call(all,x), msg = paste('At least one of', paste(exst,collapse = ','),
'\nmust contain some values in compound list from',fn))
'\nmust contain some values in compound list from',fn))
invisible(T)
}
......@@ -1046,8 +1046,8 @@ gen_base_ms1_plot_tab <- function(summ,ms1_spec) {
res <- summ[ms1_spec,c(.SD,
list(rt_peak=i.ms1_rt,
eicMS1=lapply(i.eicMS1,list))),
.SDcols=ident,
on=BASE_KEY,
.SDcols=ident,
on=BASE_KEY,
nomatch=NULL]
setkeyv(res,cols=BASE_KEY)
res
......@@ -1075,10 +1075,10 @@ gen_base_ms2_plot_tab <- function(summ,ms2_spec) {
plot_decor <- function(m,islog,all_ms1_labels,legend_name_ms1,legend_name_ms2="CE",all_ms2_labels=NULL,
ms1_legend_info=T) {
textf <- ggplot2::element_text
sci10<-function(x) {ifelse(x==0, "0", parse(text=gsub("[+]", "", gsub("e", " %*% 10^", scales::scientific_format()(x)))))}
## Logarithmic, or linear y axis?
scale_y <- if (shiny::isTruthy(islog))
ggplot2::scale_y_log10 else ggplot2::scale_y_continuous
ggplot2::scale_y_log10 else ggplot2::scale_y_continuous
my_theme <- function (...) ggplot2::theme()
......@@ -1112,12 +1112,19 @@ plot_decor <- function(m,islog,all_ms1_labels,legend_name_ms1,legend_name_ms2="C
function(plot, breaks, labels, ms2_breaks=NULL, ms2_labels=NULL) plot +
scale_colour(breaks=breaks,
labels=labels) +
scale_ms2(breaks=ms2_breaks,
labels=ms2_labels) +
scale_y() + my_theme()
function(plot, breaks, labels, ms2_breaks=NULL, ms2_labels=NULL) {
plot +
scale_colour(breaks=breaks,
labels=labels) +
scale_ms2(breaks=ms2_breaks,
labels=ms2_labels) +
scale_y() + my_theme()
## plot +
## scale_colour(breaks=breaks,
## labels=labels) +
## scale_y(labels=sci10) +
## my_theme()
}
}
......@@ -1165,55 +1172,76 @@ plot_eic_ms2 <- function(df,style_fun) {
mz <- df[,unique(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]
ms2_labs <- tbl[,plot_label]
## 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)]
plot <- style_fun(ggplot2::ggplot(ddf,ggplot2::aes(x = rt_peak,ymin = 0,ymax = int_peak,
y = int_peak,
color = parent_label, shape = plot_label)),
breaks=ms1_labs,
labels=ms1_labs,
ms2_breaks=ms2_labs,
ms2_labels=ms2_verb_labs)
plot + ggplot2::geom_linerange(key_glyph=KEY_GLYPH) +
ggplot2::geom_point() +
ggplot2::labs(x=CHR_GRAM_X,
y=CHR_GRAM_Y)
res <- if (NROW(ddf)>0) {
plot <- style_fun(ggplot2::ggplot(ddf,ggplot2::aes(x = rt_peak,ymin = 0,ymax = int_peak,
y = int_peak,
color = parent_label, shape = plot_label)),
breaks=ms1_labs,
labels=ms1_labs,
ms2_breaks=ms2_labs,
ms2_labels=ms2_labs)
plot + ggplot2::geom_linerange(key_glyph=KEY_GLYPH) +
ggplot2::geom_point() +
ggplot2::labs(x=CHR_GRAM_X,
y=CHR_GRAM_Y)
} else {
p <- ggplot2::ggplot(ddf,ggplot2::aes(x=1:10,y=1:10))+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())
}
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)}
ddf <- df[ms2_sel == T]
mz <- ddf[,unique(mz)]
labels <- ddf[,plot_label]
parent_labels <- ddf[,parent_label]
specs <- ddf[,spec]
rts <- ddf[,rt_peak]
lst <- Map(function(d,t,pt) {d$plot_label<-t;d$parent_label <- pt;d},specs,labels,parent_labels)
data <- dtable(mz=numeric(0),intensity=numeric(0),plot_label=factor(0),parent_label=factor(0))
data <- rbind(data,
data.table::rbindlist(lst),
fill=T)
data <- data[!(is.na(mz)),]
leglabs <- mk_leg_lab(labels,rts,T)
plot <- style_fun(ggplot2::ggplot(data,ggplot2::aes(x=mz,ymin=0,ymax=intensity,
y = intensity,
color=plot_label,
shape=parent_label)),
labels=parent_labels,
breaks=parent_labels,
ms2_breaks=labels,
ms2_labels=leglabs)
plot +
ggplot2::geom_linerange(key_glyph=KEY_GLYPH) +
ggplot2::geom_point() +
ggplot2::labs(x="mz", y="intensity")
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,
ggplot2::aes(x=mz,ymin=0,ymax=intensity,
y = intensity,
color=parent_label,
shape=plot_label)),
labels=leglabs,
breaks=ms1_labs,
ms2_breaks=ms2_labs,
ms2_labels=ms2_labs)
plot + ggplot2::geom_linerange(key_glyph=KEY_GLYPH) +
ggplot2::geom_point() +
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="")
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())
}
plot
}
......
R/resources.R
+ 11
− 11
View file @ 187fcaf9
......@@ -155,13 +155,13 @@ CONF_PRES_TU <- c("ret_time_shift_tol")
## Prescreening columns
QA_FLAGS <- c("qa_ms1_exists",
QA_FLAGS <- c("qa_pass",
"qa_ms1_exists",
"qa_ms2_exists",
"qa_ms1_good_int",
"qa_ms1_above_noise",
"qa_ms2_near",
"qa_ms2_good_int",
"qa_pass")
"qa_ms2_good_int")
QA_NUM_REAL <- c("ms1_int","ms1_rt","ms1_mean")
......@@ -193,24 +193,23 @@ REPORT_AUTHOR <- "Anonymous"
REPORT_TITLE <- "Plots of EICs and MS2 Spectra"
PLOT_FEATURES <- c("set",
"adduct",
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")
BASE_KEY_MS2 <- c("adduct","tag","ID","CE")
BASE_KEY_MS2 <- c(BASE_KEY,"CE")
FIG_DEF_CONF <-list(grouping=list(group="set",
FIG_DEF_CONF <-list(grouping=list(group="adduct",
plot="ID",
label="tag"))
## File table properties
SUMM_COLS=c("set",BASE_KEY_MS2,"an","mz","ms1_rt", "ms1_int", "ms2_rt", "ms2_int",
"ms1_mean",QA_FLAGS,"Name", "SMILES", "Formula", "Files","known","Comments")
"ms1_mean","ms2_sel",QA_FLAGS,"Name", "SMILES", "Formula", "known","Comments","Files")
## Empty summary table.
EMPTY_SUMM <- data.table::data.table(set=character(0),
......@@ -225,19 +224,20 @@ EMPTY_SUMM <- data.table::data.table(set=character(0),
ms2_rt=numeric(0),
ms2_int=numeric(0),
ms1_mean=numeric(0),
ms2_sel=logical(0),
qa_pass=logical(0),
qa_ms1_exists=logical(0),
qa_ms2_exists=logical(0),
qa_ms1_good_int=logical(0),
qa_ms1_above_noise=logical(0),
qa_ms2_near=logical(0),
qa_ms2_good_int=logical(0),
qa_pass=logical(0),
Name=character(0),
SMILES=character(0),
Formula=character(0),
Files=character(0),
known=character(0),
Comments=character(0))
Comments=character(0),
Files=character(0))
## Default sorting keys of spectra in the summary table
DEF_KEY_SUMM <- c(BASE_KEY_MS2,"an")
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