diff --git a/R/plotting.R b/R/plotting.R index 70a4fc94fe68d1181d1c6c1a30da7ebbebfa07a8..dfbc5ca0294525149c02b8c393fa2fdab3df4979 100644 --- a/R/plotting.R +++ b/R/plotting.R @@ -187,6 +187,35 @@ make_line_label <- function(...) { paste(...,sep="; ") } + + + +define_labels_colours <- function(dt,keys,labs) { + one_keyset <- function(dt) { + labtab = dt[,unique(.SD),.SDcol=labs] + labtab[,label:=do.call(make_line_label,.SD)] + n <- NROW(labtab) + cols <- if (n<13L) { + RColorBrewer::brewer.pal(n=n,name="Paired") + } else { + scales::viridis_pal()(n) + } + labtab[,colour:=(cols)] + data.table::setkeyv(labtab,labs) + labtab + } + res <- dt[,one_keyset(.SD),by=keys] + data.table::setkeyv(res,keys) + res +} + +get_scale_values <- function(dt,kval) { + tab_lab <- dt[.(kval)] + x <- tab_lab$colour + names(x) <- tab_lab$label + x +} + ## Prepare MS1 eic data: rt and intensity of a subset of extracted ## data defined by the key named list. Argument `summ_rows' is a ## subset of the `summ' table based on `kvals'. We need it for rt-s in @@ -251,7 +280,7 @@ narrow_summ <- function(summ,kvals,labs,...) { ### PLOTTING: TOP-LEVEL PLOT CREATION -make_eic_ms1_plot <- function(extr_ms1,summ,kvals,labs,axis="linear",rt_range=NULL,i_range=NULL, asp=1) { +make_eic_ms1_plot <- function(extr_ms1,summ,kvals,labs,axis="linear",rt_range=NULL,i_range=NULL, asp=1,scale_legend=NULL) { key <- names(kvals) ## Get metadata. @@ -304,11 +333,11 @@ make_eic_ms1_plot <- function(extr_ms1,summ,kvals,labs,axis="linear",rt_range=NU ## p <- p + annotate("text",x=annt$x,y=annt$y,label=annt$txt,size=4,check_overlap=T)+guide_fun() ## Add theme. - p + theme_eic() + p + scale_legend + theme_eic() } -make_eic_ms2_plot <- function(summ,kvals,labs,axis="linear",rt_range=NULL,asp=1) { +make_eic_ms2_plot <- function(summ,kvals,labs,axis="linear",rt_range=NULL,asp=1, scale_legend=NULL) { ## Get metadata. summ_rows <- narrow_summ(summ,kvals,labs,"mz","ms2_rt","ms2_int","Name","SMILES","Formula") @@ -345,11 +374,11 @@ make_eic_ms2_plot <- function(summ,kvals,labs,axis="linear",rt_range=NULL,asp=1) ## p <- p + annotate("text",x=annt$x,y=annt$y,label=annt$txt,size=3,check_overlap=T) ## Add theme. - p + theme_eic() + p + scale_legend + theme_eic() } -make_spec_ms2_plot <- function(extr_ms2,summ,kvals,labs,axis="linear",asp=1) { +make_spec_ms2_plot <- function(extr_ms2,summ,kvals,labs,axis="linear",asp=1, scale_legend=NULL) { ## Only the chosen ones. @@ -385,7 +414,7 @@ make_spec_ms2_plot <- function(extr_ms2,summ,kvals,labs,axis="linear",asp=1) { p <- ggplot2::ggplot(pdata,aes(x=mz,ymin=0,ymax=intensity,colour=label))+ggplot2::labs(caption=tag_txt,title=title_txt,subtitle=subt_txt)+ggplot2::xlab("m/z")+cust_geom_linerange()+scale_y(axis=axis,labels=sci10)+guide_fun() ## Add theme. - p + theme_eic() + p + scale_legend + theme_eic() } diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R index a10305ff12ad8952ca2865cab1b10df4e7554850..9f84fb0da2d58d53ef60206a2e0959eb763acd0a 100644 --- a/R/shiny-ui-base.R +++ b/R/shiny-ui-base.R @@ -786,6 +786,27 @@ mk_shinyscreen_server <- function(projects,init) { if (length(res)!=0L) res else CINDEX_BY }) + ## Calculate the palette. + rf_get_legend_tab <- reactive({ + keys <- req(rf_get_cindex_key()) + labs <- req(rf_get_cindex_labs()) + cind <- req(rf_get_cindex()) + + ## When determining the number of colours, we only need to + ## know about sets, adducts and tags. + keys <- keys[keys!="ID"] + labs <- labs[labs!="ID"] + + define_labels_colours(cind,keys,labs) + }) + + rf_scale_legend <- reactive({ + leg_tab <- rf_get_legend_tab() + kval <- rf_get_cindex_kval() + lkval <- kval[names(kval)!="ID"] + get_scale_values(leg_tab,lkval) + }) + ## REACTIVE FUNCTIONS: PLOTS rf_get_rtrange <- reactive({ x1 <- input$plot_rt_min @@ -813,11 +834,14 @@ mk_shinyscreen_server <- function(projects,init) { }) req(NROW(summ)>0L) req(NROW(ms1)>0L) + + make_eic_ms1_plot(ms1,summ,kvals=req(rf_get_cindex_kval()), labs=req(rf_get_cindex_labs()), asp=PLOT_EIC_ASPECT, rt_range=rf_get_rtrange(), - i_range=rf_get_irange()) + i_range=rf_get_irange(), + scale_legend = rf_scale_legend()) }) rf_get_ms2_eic_rtrange <- reactive({ @@ -843,7 +867,8 @@ mk_shinyscreen_server <- function(projects,init) { kvals=rf_get_cindex_kval(), labs=rf_get_cindex_labs(), rt_range = rf_get_ms2_eic_rtrange(), - asp=PLOT_EIC_ASPECT) + asp=PLOT_EIC_ASPECT, + scale_legend=rf_scale_legend()) @@ -875,7 +900,8 @@ mk_shinyscreen_server <- function(projects,init) { make_spec_ms2_plot(ms2, summ, kvals=req(rf_get_cindex_kval()), - labs=req(rf_get_cindex_labs())) + labs=req(rf_get_cindex_labs()), + scale_legend=rf_scale_legend()) })