Commit 1bfeb168 authored by dmattek's avatar dmattek

Addded: an option to manually set bounds for heatmap colour scale

parent 31348d72
......@@ -456,14 +456,17 @@ myPlotHeatmap <- function(data.arg,
labCol.arg = NULL,
font.row.arg = 1,
font.col.arg = 1,
breaks.arg = NULL,
title.arg = 'Clustering') {
loc.n.colbreaks = 99
if (palette.rev.arg)
my_palette <-
rev(colorRampPalette(brewer.pal(9, palette.arg))(n = 99))
rev(colorRampPalette(brewer.pal(9, palette.arg))(n = loc.n.colbreaks))
else
my_palette <-
colorRampPalette(brewer.pal(9, palette.arg))(n = 99)
colorRampPalette(brewer.pal(9, palette.arg))(n = loc.n.colbreaks)
col_labels <- get_leaves_branches_col(dend.arg)
......@@ -501,7 +504,8 @@ myPlotHeatmap <- function(data.arg,
cexCol = font.col.arg,
main = title.arg,
symbreaks = FALSE,
symkey = FALSE
symkey = FALSE,
breaks = if (is.null(breaks.arg)) NULL else seq(breaks.arg[1], breaks.arg[2], length.out = loc.n.colbreaks+1)
)
return(loc.p)
......
......@@ -65,7 +65,17 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
selected = 'Rainbow'
),
checkboxInput(ns('selectPlotHierKey'), 'Plot colour key', TRUE)
checkboxInput(ns('selectPlotHierKey'), 'Plot colour key', TRUE),
checkboxInput(ns('chBsetColBounds'), 'Set bounds for colour scale', FALSE),
fluidRow(
column(3,
uiOutput(ns('uiSetColBoundsLow'))
),
column(3,
uiOutput(ns('uiSetColBoundsHigh'))
)
)
),
column(3,
selectInput(
......@@ -175,6 +185,39 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
}
})
output$uiSetColBoundsLow = renderUI({
ns <- session$ns
if(input$chBsetColBounds) {
loc.dt = in.data4trajPlot()
numericInput(
ns('inSetColBoundsLow'),
label = 'Lower',
step = 0.1,
value = floor(min(loc.dt[['y']], na.rm = T))
)
}
})
output$uiSetColBoundsHigh = renderUI({
ns <- session$ns
if(input$chBsetColBounds) {
loc.dt = in.data4trajPlot()
numericInput(
ns('inSetColBoundsHigh'),
label = 'Upper',
step = 0.1,
value = ceil(max(loc.dt[['y']], na.rm = T))
)
}
})
# calculate distance matrix for further clustering
# time series arranged in rows with columns corresponding to time points
userFitDistHier <- reactive({
......@@ -365,6 +408,13 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
if (is.null(loc.dend))
return(NULL)
loc.col.bounds = NULL
if (input$chBsetColBounds)
loc.col.bounds = c(input$inSetColBoundsLow, input$inSetColBoundsHigh)
else
loc.col.bounds = NULL
loc.p = myPlotHeatmap(loc.dm,
loc.dend,
palette.arg = input$selectPlotHierPalette,
......@@ -376,6 +426,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
nacol.arg = input$inPlotHierNAcolor,
font.row.arg = input$inPlotHierFontX,
font.col.arg = input$inPlotHierFontY,
breaks.arg = loc.col.bounds,
title.arg = paste0(
"Distance measure: ",
s.cl.diss[as.numeric(input$selectPlotHierDiss)],
......
......@@ -70,7 +70,19 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
selected = 'Spectral'
),
checkboxInput(ns('inPlotHierSparRevPalette'), 'Reverse colour palette', TRUE),
checkboxInput(ns('selectPlotHierSparKey'), 'Plot colour key', TRUE)
checkboxInput(ns('selectPlotHierSparKey'), 'Plot colour key', TRUE),
checkboxInput(ns('chBsetColBounds'), 'Set bounds for colour scale', FALSE),
fluidRow(
column(3,
uiOutput(ns('uiSetColBoundsLow'))
),
column(3,
uiOutput(ns('uiSetColBoundsHigh'))
)
)
),
column(3,
sliderInput(
......@@ -189,6 +201,39 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
)
})
output$uiSetColBoundsLow = renderUI({
ns <- session$ns
if(input$chBsetColBounds) {
loc.dt = in.data4trajPlot()
numericInput(
ns('inSetColBoundsLow'),
label = 'Lower',
step = 0.1,
value = floor(min(loc.dt[['y']], na.rm = T))
)
}
})
output$uiSetColBoundsHigh = renderUI({
ns <- session$ns
if(input$chBsetColBounds) {
loc.dt = in.data4trajPlot()
numericInput(
ns('inSetColBoundsHigh'),
label = 'Upper',
step = 0.1,
value = ceil(max(loc.dt[['y']], na.rm = T))
)
}
})
# UI for advanced options
output$uiPlotHierSparNiter = renderUI({
ns <- session$ns
......@@ -422,6 +467,13 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
ifelse(sparsehc$ws <= 0.5, "green", "red")
))
loc.col.bounds = NULL
if (input$chBsetColBounds)
loc.col.bounds = c(input$inSetColBoundsLow, input$inSetColBoundsHigh)
else
loc.col.bounds = NULL
loc.p = myPlotHeatmap(loc.dm,
loc.dend,
palette.arg = input$selectPlotHierSparPalette,
......@@ -435,6 +487,7 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
labCol.arg = loc.colnames,
font.row.arg = input$inPlotHierSparFontX,
font.col.arg = input$inPlotHierSparFontY,
breaks.arg = loc.col.bounds,
title.arg = paste(
"Distance measure: ",
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
......
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