Commit 01800774 authored by dmattek's avatar dmattek
Browse files

Mod:

- colours from dendrogram cut match those in the bard plot and in trajectory plot
parent 9d78c001
## Custom plotting ## Custom plotting
require(ggplot2) require(ggplot2)
require(RColorBrewer)
require(gplots) # for heatmap.2
require(grid) # for modifying grob
rhg_cols <- c( rhg_cols <- c(
"#771C19", "#771C19",
...@@ -53,22 +56,23 @@ l.col.pal = list( ...@@ -53,22 +56,23 @@ l.col.pal = list(
) )
myGgplotTraj = function(dt.arg, myGgplotTraj = function(dt.arg, # data table
x.arg, x.arg, # string with column name for x-axis
y.arg, y.arg, # string with column name for y-axis
group.arg, group.arg, # string with column name for grouping time series (typicaly cell ID)
facet.arg, facet.arg, # string with column name for facetting
facet.ncol.arg = 2, facet.ncol.arg = 2, # default number of facet columns
line.col.arg = NULL, facet.color.arg = NULL, # vector with list of colours for adding colours to facet names (currently a horizontal line on top of the facet is drawn)
xlab.arg = NULL, line.col.arg = NULL, # string with column name for colouring time series (typically when individual time series are selected in UI)
ylab.arg = NULL, xlab.arg = NULL, # string with x-axis label
plotlab.arg = NULL, ylab.arg = NULL, # string with y-axis label
dt.stim.arg = NULL, plotlab.arg = NULL, # string with plot label
dt.stim.arg = NULL, # plotting additional dataset; typically to indicate stimulations (not fully implemented yet, not tested!)
tfreq.arg = 1, tfreq.arg = 1,
ylim.arg = NULL, ylim.arg = NULL,
stim.bar.height.arg = 0.1, stim.bar.height.arg = 0.1,
stim.bar.width.arg = 0.5, stim.bar.width.arg = 0.5,
aux.label1 = NULL, aux.label1 = NULL, # 1st point label; used for interactive plotting; displayed in the tooltip; typically used to display values of column holding x & y coordinates
aux.label2 = NULL, aux.label2 = NULL,
stat.arg = c('', 'mean', 'CI', 'SE')) { stat.arg = c('', 'mean', 'CI', 'SE')) {
...@@ -97,6 +101,21 @@ myGgplotTraj = function(dt.arg, ...@@ -97,6 +101,21 @@ myGgplotTraj = function(dt.arg,
scale_color_manual(name = '', scale_color_manual(name = '',
values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green', "NOT SEL" = rhg_cols[7])) values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green', "NOT SEL" = rhg_cols[7]))
} }
# this is temporary solution for adding colour according to cluster number
# use only when plotting traj from clustering!
# a horizontal line is added at the top of data
if (!is.null(facet.color.arg)) {
loc.y.max = max(dt.arg[, c(y.arg), with = FALSE])
loc.dt.cl = data.table(xx = 1:length(facet.color.arg), yy = loc.y.max)
setnames(loc.dt.cl, 'xx', facet.arg)
p.tmp = p.tmp +
geom_hline(data = loc.dt.cl, colour = facet.color.arg, yintercept = loc.y.max, size = 4) +
scale_colour_manual(values = facet.color.arg,
name = '')
}
if ('mean' %in% loc.stat) if ('mean' %in% loc.stat)
p.tmp = p.tmp + p.tmp = p.tmp +
...@@ -175,7 +194,10 @@ myGgplotTraj = function(dt.arg, ...@@ -175,7 +194,10 @@ myGgplotTraj = function(dt.arg,
legend.position = "top" legend.position = "top"
) )
p.tmp
return(p.tmp)
} }
......
...@@ -9,7 +9,13 @@ modClDistPlotUI = function(id, label = "Plot Fractions WIthin Clusters") { ...@@ -9,7 +9,13 @@ modClDistPlotUI = function(id, label = "Plot Fractions WIthin Clusters") {
} }
modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf') {
# Params:
# in.data - data prepared with data4clDistPlot f-n
# in.cols - table with 1st column as cluster number, 2nd column colour assignments
# prepared with getClColHier
# in.fname - file name for plot download
modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fname = 'clDist.pdf') {
ns <- session$ns ns <- session$ns
...@@ -24,18 +30,26 @@ modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf ...@@ -24,18 +30,26 @@ modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf
} }
p.out = ggplot(loc.dt, aes(x = group, y = nCells)) + p.out = ggplot(loc.dt, aes(x = group, y = nCells)) +
geom_bar(aes(fill = as.factor(cl)), stat = 'identity', position = 'fill') + geom_bar(aes(fill = as.factor(cl)), stat = 'identity', position = 'fill')
if(is.null(in.cols))
p.out = p.out + scale_fill_discrete(name = "Cluster no.")
else
p.out = p.out + scale_fill_manual(name = "Cluster no.",
values = in.cols()$cl.col)
p.out = p.out +
scale_y_continuous(labels = percent) + scale_y_continuous(labels = percent) +
ylab("percentage of cells\n") + ylab("percentage of cells\n") +
xlab("") + xlab("") +
scale_fill_discrete(name = "Cluster no.") +
myGgplotTheme myGgplotTheme
return(p.out) return(p.out)
} }
# Hierarchical - display bar plot # display bar plot
output$outPlotClDist <- renderPlot({ output$outPlotClDist <- renderPlot({
locBut = input$butPlotClDist locBut = input$butPlotClDist
...@@ -48,7 +62,7 @@ modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf ...@@ -48,7 +62,7 @@ modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf
plotClDist() plotClDist()
}) })
# Hierarchical - Bar Plot - download pdf # bar Plot - download pdf
callModule(downPlot, "downPlotClDist", in.fname, plotClDist, TRUE) callModule(downPlot, "downPlotClDist", in.fname, plotClDist, TRUE)
} }
\ No newline at end of file
...@@ -58,9 +58,16 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) { ...@@ -58,9 +58,16 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
height = input$inPlotHeight height = input$inPlotHeight
) )
} else { } else {
pdf(file, if (in.fname %like% 'pdf') {
width = input$inPlotWidth, pdf(file,
height = input$inPlotHeight) width = input$inPlotWidth,
height = input$inPlotHeight)
} else {
png(file,
width = input$inPlotWidth,
height = input$inPlotHeight, units = 'in', res = 300)
}
in.plot() in.plot()
dev.off() dev.off()
......
...@@ -51,7 +51,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") { ...@@ -51,7 +51,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
} }
modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.fname = 'tCourses.pdf') { modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.facet.color = NULL, in.fname = 'tCourses.pdf') {
ns <- session$ns ns <- session$ns
...@@ -145,6 +145,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f ...@@ -145,6 +145,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
group.arg = "id", group.arg = "id",
facet.arg = in.facet, facet.arg = in.facet,
facet.ncol.arg = input$inPlotTrajFacetNcol, facet.ncol.arg = input$inPlotTrajFacetNcol,
facet.color.arg = if (is.null(in.facet.color)) NULL else in.facet.color()$cl.col,
xlab.arg = 'Time (min)', xlab.arg = 'Time (min)',
line.col.arg = loc.line.col.arg, line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL, aux.label1 = if (locPos) 'pos.x' else NULL,
......
...@@ -15,6 +15,7 @@ library(gplots) # for heatmap.2 ...@@ -15,6 +15,7 @@ library(gplots) # for heatmap.2
library(plotly) library(plotly)
library(d3heatmap) # for interactive heatmap library(d3heatmap) # for interactive heatmap
library(dendextend) # for color_branches library(dendextend) # for color_branches
library(colorspace) # for palettes (ised to colour dendrogram)
library(RColorBrewer) library(RColorBrewer)
library(sparcl) # sparse hierarchical and k-means library(sparcl) # sparse hierarchical and k-means
library(scales) # for percentages on y scale library(scales) # for percentages on y scale
...@@ -690,10 +691,14 @@ shinyServer(function(input, output, session) { ...@@ -690,10 +691,14 @@ shinyServer(function(input, output, session) {
} }
}) })
# perform hierarchical clustering and return dendrogram coloured according to cutree
# branch coloring performed using dendextend package
userFitDendHier <- reactive({ userFitDendHier <- reactive({
cat(file = stderr(), 'userFitDendHier \n')
dm.t = data4clust() dm.t = data4clust()
if (is.null(dm.t)) { if (is.null(dm.t)) {
return() return(NULL)
} }
cl.dist = dist(dm.t, method = s.cl.diss[as.numeric(input$selectPlotHierDiss)]) cl.dist = dist(dm.t, method = s.cl.diss[as.numeric(input$selectPlotHierDiss)])
...@@ -701,12 +706,40 @@ shinyServer(function(input, output, session) { ...@@ -701,12 +706,40 @@ shinyServer(function(input, output, session) {
cl.lev = rev(row.names(dm.t)) cl.lev = rev(row.names(dm.t))
dend <- as.dendrogram(cl.hc) dend <- as.dendrogram(cl.hc)
dend <- color_branches(dend, k = input$inPlotHierNclust) dend <- color_branches(dend,
col = rainbow_hcl, # make sure that n here equals max in the input$inPlotHierNclust slider
k = input$inPlotHierNclust)
return(dend) return(dend)
}) })
# Function instead of reactive as per: # prepares a table with cluster numbers in 1st column and colour assignments in 2nd column
# the number of rows is determined by dendrogram cut
getClCol <- function(in.dend, in.k) {
loc.col_labels <- get_leaves_branches_col(in.dend)
loc.col_labels <- loc.col_labels[order(order.dendrogram(in.dend))]
return(unique(
data.table(cl.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE),
cl.col = loc.col_labels)))
}
# returns table prepared with f-n getClCol
# for hierarchical clustering
getClColHier <- reactive({
cat(file = stderr(), 'getClColHier \n')
loc.dend = userFitDendHier()
if (is.null(loc.dend))
return(NULL)
return(getClCol(loc.dend, input$inPlotHierNclust))
})
# Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
# This function is used to plot and to downoad a pdf # This function is used to plot and to downoad a pdf
plotHier <- function() { plotHier <- function() {
...@@ -767,7 +800,11 @@ shinyServer(function(input, output, session) { ...@@ -767,7 +800,11 @@ shinyServer(function(input, output, session) {
return(loc.dt) return(loc.dt)
}) })
callModule(modTrajPlot, 'modPlotHierTraj', data4trajPlotCl, 'cl', paste0('clust_hierch_tCourses_', callModule(modTrajPlot, 'modPlotHierTraj',
in.data = data4trajPlotCl,
in.facet = 'cl',
in.facet.color = getClColHier,
in.fname = paste0('clust_hierch_tCourses_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], s.cl.diss[as.numeric(input$selectPlotHierDiss)],
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf')) s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
...@@ -872,10 +909,12 @@ shinyServer(function(input, output, session) { ...@@ -872,10 +909,12 @@ shinyServer(function(input, output, session) {
callModule(downPlot, "downPlotHier", paste0('clust_hierch_heatMap_', callModule(downPlot, "downPlotHier", paste0('clust_hierch_heatMap_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], s.cl.diss[as.numeric(input$selectPlotHierDiss)],
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'), plotHier) s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.png'), plotHier)
callModule(modClDistPlot, 'hierClDistPlot', data4clDistPlot, callModule(modClDistPlot, 'hierClDistPlot',
paste0('clust_hierch_clDist_', in.data = data4clDistPlot,
in.cols = getClColHier,
in.fname = paste0('clust_hierch_clDist_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], s.cl.diss[as.numeric(input$selectPlotHierDiss)],
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf')) s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
...@@ -958,10 +997,25 @@ shinyServer(function(input, output, session) { ...@@ -958,10 +997,25 @@ shinyServer(function(input, output, session) {
} }
dend <- as.dendrogram(sparsehc$hc) dend <- as.dendrogram(sparsehc$hc)
dend <- color_branches(dend, k = input$inPlotHierSparNclust) dend <- color_branches(dend,
col = rainbow_hcl,
k = input$inPlotHierSparNclust)
return(dend) return(dend)
}) })
# returns table prepared with f-n getClCol
# for sparse hierarchical clustering
getClColHierSpar <- reactive({
cat(file = stderr(), 'getClColHierSpar \n')
loc.dend = userFitDendHierSpar()
if (is.null(loc.dend))
return(NULL)
return(getClCol(loc.dend, input$inPlotHierNclust))
})
# Function instead of reactive as per: # Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
...@@ -974,10 +1028,8 @@ shinyServer(function(input, output, session) { ...@@ -974,10 +1028,8 @@ shinyServer(function(input, output, session) {
} }
sparsehc <- userFitHierSpar() sparsehc <- userFitHierSpar()
loc.dend <- userFitDendHierSpar()
loc.dend <- as.dendrogram(sparsehc$hc)
loc.dend <- color_branches(loc.dend, k = input$inPlotHierSparNclust)
loc.colnames = paste0(ifelse(sparsehc$ws == 0, "", loc.colnames = paste0(ifelse(sparsehc$ws == 0, "",
ifelse( ifelse(
sparsehc$ws <= 0.1, sparsehc$ws <= 0.1,
...@@ -1042,7 +1094,11 @@ shinyServer(function(input, output, session) { ...@@ -1042,7 +1094,11 @@ shinyServer(function(input, output, session) {
return(loc.dt) return(loc.dt)
}) })
callModule(modTrajPlot, 'modPlotHierSparTraj', data4trajPlotClSpar, 'cl', paste0('clust_hierchSparse_tCourses_', callModule(modTrajPlot, 'modPlotHierSparTraj',
in.data = data4trajPlotClSpar,
in.facet = 'cl',
in.facet.color = getClColHierSpar,
paste0('clust_hierchSparse_tCourses_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf')) s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'))
...@@ -1083,8 +1139,10 @@ shinyServer(function(input, output, session) { ...@@ -1083,8 +1139,10 @@ shinyServer(function(input, output, session) {
}) })
callModule(modClDistPlot, 'hierClSparDistPlot', data4clSparDistPlot, callModule(modClDistPlot, 'hierClSparDistPlot',
paste0('clust_hierchSparse_clDist_', in.data = data4clSparDistPlot,
in.cols = getClColHierSpar,
in.fname = paste0('clust_hierchSparse_clDist_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf')) s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'))
......
Markdown is supported
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