Newer
Older
## Throw out the possibly empty members.
really_okind <- okind[m$qa$ms[irows, ]$qa_pass]
m$qa$ms[which(qa_pass),ms2_sel:=.(mapply(function (spl,inds,ms1rt) {
rtdiff <- sapply(spl[inds],function (x) abs(x$rt-ms1rt))
closest <- which.min(rtdiff)
inds[[closest]]
},
spec,
really_okind,
gen_mz_err_f <- function(entry,msg) {
eppm <- grab_unit(entry,"ppm")
eda <- grab_unit(entry,"Da")
shinyscreen:::assert(xor(is.na(eda), is.na(eppm)), msg = msg)
if (is.na(eda)) function(mz) eppm*1e-6*mz else function (mz) eda
}
gen_rt_err <- function(entry,msg) {
em <- grab_unit(entry,"min")
es <- grab_unit(entry,"s")
shinyscreen:::assert(xor(is.na(em), is.na(es)), msg = msg)
if (is.na(em)) es/60. else em
}
fig_path <- function(top,set,group,id,suff,ext="pdf") {
base <- paste("plot",set,group,id,suff,sep="_")
fn <- paste0(base,".",ext)
fn <- gsub("\\[","",fn)
fn <- gsub("\\]","",fn)
fn <- gsub("\\+","p",fn)
fn <- gsub("-","m",fn)
if (!is.null(top)) file.path(top,fn) else fn
}
get_coord_lim <- function(new,def) {
if (is.null(new)) return(def)
res <- new
if (length(new[[1]])==0) res[[1]]<-def[[1]]
if (length(new[[2]])==0) res[[2]]<-def[[2]]
res
}
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
gen_base_ms1_plot_tab <- function(summ,ms1_spec) {
ident <- c("set",
"adduct",
"tag",
"ID",
"mz",
"Files")
res <- summ[ms1_spec,c(.SD,
list(rt_peak=i.ms1_rt,
eicMS1=lapply(i.eicMS1,list))),
.SDcols=ident,
on=BASE_KEY,
nomatch=NULL]
setkeyv(res,cols=BASE_KEY)
res
}
gen_base_ms2_plot_tab <- function(summ,ms2_spec) {
ident <- c("set",
"adduct",
"tag",
"ID",
"mz",
"Files")
res <- summ[ms2_spec,c(.SD,
list(CE=i.CE,
rt_peak = i.rt,
int_peak = ms2_max_int,
spec = i.spec,
ms2_sel = i.ms2_sel)),
.SDcols=ident,
on=BASE_KEY,
nomatch=NULL]
setkeyv(res,cols=BASE_KEY)
res
}
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
## Logarithmic, or linear y axis?
scale_y <- if (shiny::isTruthy(islog))
ggplot2::scale_y_log10 else ggplot2::scale_y_continuous
rt_new_lim <- c(rt_in_min(m$conf$figures$rt_min),
rt_in_min(m$conf$figures$rt_max))
rt_lim <- get_coord_lim(rt_new_lim,DEFAULT_RT_RANGE)
my_theme <- function (...) ggplot2::theme()
getpal <- colorRampPalette(RColorBrewer::brewer.pal(8,"Dark2"))
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
col_all_vals <- getpal(length(all_ms1_labels))
names(col_all_vals) <- all_ms1_labels
scale_colour <- if (ms1_legend_info) {
function(breaks, labels, ...) ggplot2::scale_colour_manual(values = col_all_vals,
breaks = breaks,
labels = labels,
name = legend_name_ms1,...)
} else {
function(breaks=NULL, labels=NULL, ...) NULL
}
shape_all_vals <- 1:length(all_ms2_labels)
scale_ms2 <- if (length(shape_all_vals)>0) {
names(shape_all_vals) <- all_ms2_labels
function(breaks, labels, ...) ggplot2::scale_shape_manual(values = shape_all_vals,
breaks = breaks,
labels = labels,
name = legend_name_ms2, ...)
} else {
function(breaks=NULL, labels=NULL, ...) NULL
}
my_coord <- ggplot2::coord_cartesian(xlim = rt_lim)
function(plot,breaks,labels,
ms2_breaks=NULL,ms2_labels=NULL) plot + my_coord +
scale_colour(breaks=breaks,
labels=labels) +
scale_ms2(breaks=ms2_breaks,
labels=ms2_labels) +
scale_y() + my_theme()
}
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
gen_get_ms2_legend <- function(m,legend_name_ms2="CE",all_ms2_labels) {
shape_all_vals <- 1:length(all_ms2_labels)
scale_ms2 <- if (length(shape_all_vals)>0) {
names(shape_all_vals) <- all_ms2_labels
function(breaks, labels, ...) ggplot2::scale_shape_manual(values = shape_all_vals,
breaks = breaks,
labels = labels,
name = legend_name_ms2, ...)
} else {
function(breaks=NULL, labels=NULL, ...) NULL
}
function(plot,breaks,labels) {
thing <- plot + scale_ms2(breaks=breaks,
labels=labels)
cowplot::get_legend(thing)
}
}
plot_eic_ms1 <- 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")]
verb_labs <- tbl[,verb_labs]
labs <- tbl[,plot_label]
df[,plot_label:=factor(plot_label)]
style_fun(ggplot2::ggplot(df,ggplot2::aes(x=rt,y=intensity,colour=plot_label)),
breaks=labs,
labels=verb_labs) +
ggplot2::geom_line(key_glyph=KEY_GLYPH) +
ggplot2::labs(x=CHR_GRAM_X,
y=CHR_GRAM_Y)
}
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]
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)
}
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")
}
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
plot_leg_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]
ms1_labs <- ddf[,levels(parent_label)]
blah <- ggplot2::ggplot(ddf,ggplot2::aes(shape = plot_label,y=int_peak,x=rt_peak)) + ggplot2::geom_point()
plot <- style_fun(blah,
breaks=ms1_labs,
labels=ms1_labs,
ms2_breaks=ms2_labs,
ms2_labels=ms2_verb_labs)
cowplot::get_legend(plot)
}