Skip to content
Snippets Groups Projects
mix.R 44.9 KiB
Newer Older
    ## Throw out the possibly empty members.
    really_okind <- okind[m$qa$ms[irows, ]$qa_pass]
Todor Kondic's avatar
Todor Kondic committed
    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,
Todor Kondic's avatar
Todor Kondic committed
    ms1_rt,

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

    ## 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"))
    
    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() 
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::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::labs(x="mz", y="intensity")

}

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)

}