Skip to content

GitLab

S
shiny-timecourse-inspector
Commit 01800774 authored by dmattek's avatar dmattek
Browse files
Options

Mod: 

- colours from dendrogram cut match those in the bard plot and in trajectory plot
parent 9d78c001
Hide whitespace changes
Inline Side-by-side
Showing with 139 additions and 37 deletions
modules/auxfunc.R
View file @ 01800774
## Custom plotting
require(ggplot2)
require(RColorBrewer)
require(gplots) # for heatmap.2
require(grid) # for modifying grob
rhg_cols <- c(
"#771C19",
......@@ -53,22 +56,23 @@ l.col.pal = list(
)
myGgplotTraj = function(dt.arg,
x.arg,
y.arg,
group.arg,
facet.arg,
facet.ncol.arg = 2,
line.col.arg = NULL,
xlab.arg = NULL,
ylab.arg = NULL,
plotlab.arg = NULL,
dt.stim.arg = NULL,
myGgplotTraj = function(dt.arg, # data table
x.arg, # string with column name for x-axis
y.arg, # string with column name for y-axis
group.arg, # string with column name for grouping time series (typicaly cell ID)
facet.arg, # string with column name for facetting
facet.ncol.arg = 2, # default number of facet columns
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)
line.col.arg = NULL, # string with column name for colouring time series (typically when individual time series are selected in UI)
xlab.arg = NULL, # string with x-axis label
ylab.arg = NULL, # string with y-axis label
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,
ylim.arg = NULL,
stim.bar.height.arg = 0.1,
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,
stat.arg = c('', 'mean', 'CI', 'SE')) {
......@@ -97,6 +101,21 @@ myGgplotTraj = function(dt.arg,
scale_color_manual(name = '',
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)
p.tmp = p.tmp +
......@@ -175,7 +194,10 @@ myGgplotTraj = function(dt.arg,
legend.position = "top"
)
p.tmp
return(p.tmp)
}
......
modules/clDistPlot.R
View file @ 01800774
......@@ -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
......@@ -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)) +
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) +
ylab("percentage of cells\n") +
xlab("") +
scale_fill_discrete(name = "Cluster no.") +
myGgplotTheme
return(p.out)
}
# Hierarchical - display bar plot
# display bar plot
output$outPlotClDist <- renderPlot({
locBut = input$butPlotClDist
......@@ -48,7 +62,7 @@ modClDistPlot = function(input, output, session, in.data, in.fname = 'clDist.pdf
plotClDist()
})
# Hierarchical - Bar Plot - download pdf
# bar Plot - download pdf
callModule(downPlot, "downPlotClDist", in.fname, plotClDist, TRUE)
}
\ No newline at end of file
modules/downPlot.R
View file @ 01800774
......@@ -58,9 +58,16 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
height = input$inPlotHeight
)
} else {
pdf(file,
width = input$inPlotWidth,
height = input$inPlotHeight)
if (in.fname %like% 'pdf') {
pdf(file,
width = input$inPlotWidth,
height = input$inPlotHeight)
} else {
png(file,
width = input$inPlotWidth,
height = input$inPlotHeight, units = 'in', res = 300)
}
in.plot()
dev.off()
......
modules/trajPlot.R
View file @ 01800774
......@@ -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
......@@ -145,6 +145,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
group.arg = "id",
facet.arg = in.facet,
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)',
line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL,
......
server.R
View file @ 01800774
......@@ -15,6 +15,7 @@ library(gplots) # for heatmap.2
library(plotly)
library(d3heatmap) # for interactive heatmap
library(dendextend) # for color_branches
library(colorspace) # for palettes (ised to colour dendrogram)
library(RColorBrewer)
library(sparcl) # sparse hierarchical and k-means
library(scales) # for percentages on y scale
......@@ -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({
cat(file = stderr(), 'userFitDendHier \n')
dm.t = data4clust()
if (is.null(dm.t)) {
return()
return(NULL)
}
cl.dist = dist(dm.t, method = s.cl.diss[as.numeric(input$selectPlotHierDiss)])
......@@ -701,12 +706,40 @@ shinyServer(function(input, output, session) {
cl.lev = rev(row.names(dm.t))
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)
})
# 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
# This function is used to plot and to downoad a pdf
plotHier <- function() {
......@@ -767,7 +800,11 @@ shinyServer(function(input, output, session) {
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.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
......@@ -872,10 +909,12 @@ shinyServer(function(input, output, session) {
callModule(downPlot, "downPlotHier", paste0('clust_hierch_heatMap_',
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,
paste0('clust_hierch_clDist_',
callModule(modClDistPlot, 'hierClDistPlot',
in.data = data4clDistPlot,
in.cols = getClColHier,
in.fname = paste0('clust_hierch_clDist_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)],
'_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
......@@ -958,10 +997,25 @@ shinyServer(function(input, output, session) {
}
dend <- as.dendrogram(sparsehc$hc)
dend <- color_branches(dend, k = input$inPlotHierSparNclust)
dend <- color_branches(dend,
col = rainbow_hcl,
k = input$inPlotHierSparNclust)
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:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
......@@ -974,10 +1028,8 @@ shinyServer(function(input, output, session) {
}
sparsehc <- userFitHierSpar()
loc.dend <- as.dendrogram(sparsehc$hc)
loc.dend <- color_branches(loc.dend, k = input$inPlotHierSparNclust)
loc.dend <- userFitDendHierSpar()
loc.colnames = paste0(ifelse(sparsehc$ws == 0, "",
ifelse(
sparsehc$ws <= 0.1,
......@@ -1042,7 +1094,11 @@ shinyServer(function(input, output, session) {
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.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'))
......@@ -1083,8 +1139,10 @@ shinyServer(function(input, output, session) {
})
callModule(modClDistPlot, 'hierClSparDistPlot', data4clSparDistPlot,
paste0('clust_hierchSparse_clDist_',
callModule(modClDistPlot, 'hierClSparDistPlot',
in.data = data4clSparDistPlot,
in.cols = getClColHierSpar,
in.fname = paste0('clust_hierchSparse_clDist_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
'_',
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