Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
🚀
This server has been upgraded to GitLab release
15.7
.
🚀
Open sidebar
pertz-lab
shiny-timecourse-inspector
Commits
1bfeb168
Commit
1bfeb168
authored
May 08, 2018
by
dmattek
Browse files
Addded: an option to manually set bounds for heatmap colour scale
parent
31348d72
Changes
3
Hide whitespace changes
Inline
Side-by-side
modules/auxfunc.R
View file @
1bfeb168
...
...
@@ -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
)
...
...
modules/tabClHier.R
View file @
1bfeb168
...
...
@@ -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
)],
...
...
modules/tabClHierSpar.R
View file @
1bfeb168
...
...
@@ -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
)],
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment