Newer
Older
setkeyv(qa_ms2,BASE_KEY_MS2)
m$qa$ms2 <- qa_ms2
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
}
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
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
my_theme <- function (...) ggplot2::theme()
getpal <- colorRampPalette(RColorBrewer::brewer.pal(8,"Dark2"))
col_all_vals <- getpal(length(all_ms1_labels))
names(col_all_vals) <- all_ms1_labels
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
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
}
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()
}
}
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
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] TODO: This is nonsense for
## multi-CE and multi-other-label.
ms2_labs <- ddf[,plot_label]
ms1_labs <- ddf[,levels(parent_label)]
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())
}
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)}
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
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
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
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)
}
#' @export
tk_save_file <- function (default = "", caption = "Select files", filters = NULL, index = 1) {
args <- list("tk_getSaveFile", title = caption)
if (nzchar(default))
args <- c(args, initialdir = dirname(default), initialfile = basename(default))
if (!is.null(filters)) {
if (!is.character(filters) || length(dim(filters)) !=
2 || ncol(filters) != 2)
stop("'filters' must be a 2-column character matrix")
f <- filters
f[] <- paste0("{", filters, "}")
ff <- apply(f, 1, paste, collapse = " ")
fff <- paste0("{", ff, "}")
args <- c(args, filetypes = paste(fff, collapse = " "))
}
as.character(do.call(tcltk::tcl, args))
}