Skip to content
GitLab
Commit 9d78c001 authored by dmattek's avatar dmattek
Browse files

Mod: 

- heatmap plotting function moved to auxfunc.R
parent 0d6e33c7
Hide whitespace changes
Inline Side-by-side
modules/auxfunc.R
View file @ 9d78c001
......@@ -384,4 +384,67 @@ myGgplotTheme = theme_bw(base_size = 18, base_family = "Helvetica") +
legend.key.height = unit(1, "lines"),
legend.key.width = unit(2, "lines"),
legend.position = "right"
)
\ No newline at end of file
)
myPlotHeatmap <- function(data.arg,
dend.arg,
palette.arg,
palette.rev.arg = TRUE,
dend.show.arg = TRUE,
key.show.arg = TRUE,
margin.x.arg = 5,
margin.y.arg = 20,
nacol.arg = 0.5,
colCol.arg = NULL,
labCol.arg = NULL,
font.row.arg = 1,
font.col.arg = 1,
title.arg = 'Clustering') {
if (palette.rev.arg)
my_palette <-
rev(colorRampPalette(brewer.pal(9, palette.arg))(n = 99))
else
my_palette <-
colorRampPalette(brewer.pal(9, palette.arg))(n = 99)
col_labels <- get_leaves_branches_col(dend.arg)
col_labels <- col_labels[order(order.dendrogram(dend.arg))]
if (dend.show.arg) {
assign("var.tmp.1", dend.arg)
var.tmp.2 = "row"
} else {
assign("var.tmp.1", FALSE)
var.tmp.2 = "none"
}
loc.p = heatmap.2(
data.arg,
Colv = "NA",
Rowv = var.tmp.1,
srtCol = 90,
dendrogram = var.tmp.2,
trace = "none",
key = key.show.arg,
margins = c(margin.x.arg, margin.y.arg),
col = my_palette,
na.col = grey(nacol.arg),
denscol = "black",
density.info = "density",
RowSideColors = col_labels,
colRow = col_labels,
colCol = colCol.arg,
labCol = labCol.arg,
# sepcolor = grey(input$inPlotHierGridColor),
# colsep = 1:ncol(loc.dm),
# rowsep = 1:nrow(loc.dm),
cexRow = font.row.arg,
cexCol = font.col.arg,
main = title.arg
)
return(loc.p)
}
modules/clHeatmapPlot.R
View file @ 9d78c001
modClDistPlotUI = function(id, label = "Plot Fractions WIthin Clusters") {
modHeatmapPlotUI = function(id, label = "Plot Heatmap") {
ns <- NS(id)
}
modClDistPlot = function(input, output, session, in.data, in.facet = 'group') {
modHeatmapPlot = function(input, output, session, in.data) {
ns <- session$ns
......
server.R
View file @ 9d78c001
......@@ -719,52 +719,23 @@ shinyServer(function(input, output, session) {
if (is.null(loc.dend))
return(NULL)
if (input$inPlotHierRevPalette)
my_palette <-
rev(colorRampPalette(brewer.pal(9, input$selectPlotHierPalette))(n = 99))
else
my_palette <-
colorRampPalette(brewer.pal(9, input$selectPlotHierPalette))(n = 99)
col_labels <- get_leaves_branches_col(loc.dend)
col_labels <- col_labels[order(order.dendrogram(loc.dend))]
if (input$selectPlotHierDend) {
assign("var.tmp.1", loc.dend)
var.tmp.2 = "row"
} else {
assign("var.tmp.1", FALSE)
var.tmp.2 = "none"
}
loc.p = heatmap.2(
loc.dm,
Colv = "NA",
Rowv = var.tmp.1,
srtCol = 90,
dendrogram = var.tmp.2,
trace = "none",
key = input$selectPlotHierKey,
margins = c(input$inPlotHierMarginX, input$inPlotHierMarginY),
col = my_palette,
na.col = grey(input$inPlotHierNAcolor),
denscol = "black",
density.info = "density",
RowSideColors = col_labels,
colRow = col_labels,
# sepcolor = grey(input$inPlotHierGridColor),
# colsep = 1:ncol(loc.dm),
# rowsep = 1:nrow(loc.dm),
cexRow = input$inPlotHierFontX,
cexCol = input$inPlotHierFontY,
main = paste(
"Distance measure: ",
s.cl.diss[as.numeric(input$selectPlotHierDiss)],
"\nLinkage method: ",
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)]
)
)
loc.p = myPlotHeatmap(loc.dm,
loc.dend,
palette.arg = input$selectPlotHierPalette,
palette.rev.arg = input$inPlotHierRevPalette,
dend.show.arg = input$selectPlotHierDend,
key.show.arg = input$selectPlotHierKey,
margin.x.arg = input$inPlotHierMarginX,
margin.y.arg = input$inPlotHierMarginY,
nacol.arg = input$inPlotHierNAcolor,
font.row.arg = input$inPlotHierFontX,
font.col.arg = input$inPlotHierFontY,
title.arg = paste(
"Distance measure: ",
s.cl.diss[as.numeric(input$selectPlotHierDiss)],
"\nLinkage method: ",
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)]
))
return(loc.p)
}
......@@ -892,7 +863,7 @@ shinyServer(function(input, output, session) {
return(NULL)
}
plotHier()
}, height = getPlotHierHeatMapHeight)
......@@ -997,39 +968,22 @@ shinyServer(function(input, output, session) {
# This function is used to plot and to downoad a pdf
plotHierSpar <- function() {
dm.t = data4clust()
if (is.null(dm.t)) {
loc.dm = data4clust()
if (is.null(loc.dm)) {
return()
}
sparsehc <- userFitHierSpar()
dend <- as.dendrogram(sparsehc$hc)
dend <- color_branches(dend, k = input$inPlotHierSparNclust)
if (input$inPlotHierSparRevPalette)
my_palette <-
rev(colorRampPalette(brewer.pal(9, input$selectPlotHierSparPalette))(n = 99))
else
my_palette <-
colorRampPalette(brewer.pal(9, input$selectPlotHierSparPalette))(n = 99)
col_labels <- get_leaves_branches_col(dend)
col_labels <- col_labels[order(order.dendrogram(dend))]
if (input$selectPlotHierSparDend == 1)
assign("var.tmp", dend)
else
assign("var.tmp", FALSE)
loc.dend <- as.dendrogram(sparsehc$hc)
loc.dend <- color_branches(loc.dend, k = input$inPlotHierSparNclust)
loc.colnames = paste0(ifelse(sparsehc$ws == 0, "",
ifelse(
sparsehc$ws <= 0.1,
"* ",
ifelse(sparsehc$ws <= 0.5, "** ", "*** ")
)), colnames(dm.t))
)), colnames(loc.dm))
loc.colcol = ifelse(sparsehc$ws == 0,
"black",
......@@ -1039,34 +993,25 @@ shinyServer(function(input, output, session) {
ifelse(sparsehc$ws <= 0.5, "green", "red")
))
loc.p = heatmap.2(
dm.t,
Colv = "NA",
Rowv = var.tmp,
srtCol = 90,
dendrogram = ifelse(input$selectPlotHierSparDend == 1, "row", 'none'),
trace = "none",
key = input$selectPlotHierSparKey,
margins = c(
input$inPlotHierSparMarginX,
input$inPlotHierSparMarginY
),
col = my_palette,
na.col = grey(input$inPlotHierSparNAcolor),
denscol = "black",
density.info = "density",
RowSideColors = col_labels,
colRow = col_labels,
colCol = loc.colcol,
labCol = loc.colnames,
# sepcolor = grey(input$inPlotHierSparGridColor),
# colsep = 1:ncol(dm.t),
# rowsep = 1:nrow(dm.t),
cexRow = input$inPlotHierSparFontX,
cexCol = input$inPlotHierSparFontY,
main = paste("Linkage method: ", s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)])
)
loc.p = myPlotHeatmap(loc.dm,
loc.dend,
palette.arg = input$selectPlotHierSparPalette,
palette.rev.arg = input$inPlotHierSparRevPalette,
dend.show.arg = input$selectPlotHierSparDend,
key.show.arg = input$selectPlotHierSparKey,
margin.x.arg = input$inPlotHierSparMarginX,
margin.y.arg = input$inPlotHierSparMarginY,
nacol.arg = input$inPlotHierSparNAcolor,
colCol.arg = loc.colcol,
labCol.arg = loc.colnames,
font.row.arg = input$inPlotHierSparFontX,
font.col.arg = input$inPlotHierSparFontY,
title.arg = paste(
"Distance measure: ",
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
"\nLinkage method: ",
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)]
))
return(loc.p)
}
......
ui.R
View file @ 9d78c001
......@@ -246,7 +246,7 @@ shinyUI(fluidPage(
br(),
fluidRow(
column(
6,
4,
selectInput(
"selectPlotHierSparLinkage",
label = ("Select linkage method:"),
......@@ -264,21 +264,28 @@ shinyUI(fluidPage(
choices = list("Squared Distance" = 1,
"Absolute Value" = 2),
selected = 1
),
)
),
column(
4,
sliderInput(
'inPlotHierSparNclust',
'#dendrogram branches to colour',
min = 1,
max = 30,
max = 20,
value = 1,
step = 1,
ticks = TRUE,
round = TRUE
)
),
checkboxInput('chBPlotHierSparClSel', 'Manually select clusters to display'),
uiOutput('uiPlotHierSparClSel'),
downloadButton('downCellClSpar', 'Download CSV with cell IDs and cluster no.')
),
column(
6,
4,
checkboxInput('inHierSparAdv',
'Advanced options',
FALSE),
......@@ -287,10 +294,7 @@ shinyUI(fluidPage(
),
uiOutput(
'uiPlotHierSparNiter'
),
checkboxInput('chBPlotHierSparClSel', 'Manually select clusters to display'),
uiOutput('uiPlotHierSparClSel'),
downloadButton('downCellClSpar', 'Download CSV with cell IDs and cluster no.')
)
)
),
......@@ -302,15 +306,7 @@ shinyUI(fluidPage(
tabPanel('Heat-map',
fluidRow(
column(3,
radioButtons(
"selectPlotHierSparDend",
label = 'Dendrogram',
choices = list(
'Plot dendrogram; order samples accordingly' = 1,
'Don\'t plot dendrogram; retain original ordering' = 2
),
selected = 1
),
checkboxInput('selectPlotHierSparDend', 'Plot dendrogram and re-order samples', TRUE),
selectInput(
"selectPlotHierSparPalette",
label = "Select colour palette:",
......@@ -329,7 +325,12 @@ shinyUI(fluidPage(
value = 0.8,
step = .1,
ticks = TRUE
)
),
numericInput('inPlotHierSparHeatMapHeight',
'Display plot height [px]',
value = 600,
min = 100,
step = 100)
),
column(6,
br(),
......@@ -398,12 +399,6 @@ shinyUI(fluidPage(
downPlotUI('downPlotHierSparHM', "Download PDF"),
numericInput('inPlotHierSparHeatMapHeight',
'Display plot height [px]',
value = 600,
min = 100,
step = 100),
actionButton('butPlotHierSparHeatMap', 'Plot!'),
plotOutput('outPlotHierSpar')
),
......
Supports Markdown
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