Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
pertz-lab
shiny-timecourse-inspector
Commits
9d78c001
Commit
9d78c001
authored
Jul 28, 2017
by
dmattek
Browse files
Mod:
- heatmap plotting function moved to auxfunc.R
parent
0d6e33c7
Changes
4
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
mod
ClDist
PlotUI
=
function
(
id
,
label
=
"Plot
Fractions WIthin Clusters
"
)
{
mod
Heatmap
PlotUI
=
function
(
id
,
label
=
"Plot
Heatmap
"
)
{
ns
<-
NS
(
id
)
}
mod
ClDist
Plot
=
function
(
input
,
output
,
session
,
in.data
,
in.facet
=
'group'
)
{
mod
Heatmap
Plot
=
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
=
3
0
,
max
=
2
0
,
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'
)
),
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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