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
03947223
Commit
03947223
authored
May 30, 2017
by
dmattek
Browse files
Added: scatter plot
parent
a79bbb1a
Changes
5
Hide whitespace changes
Inline
Side-by-side
global.R
View file @
03947223
source
(
'modules/auxfunc.R'
)
source
(
'modules/downPlot.R'
)
source
(
'modules/downCellIDsCls.R'
)
\ No newline at end of file
source
(
'modules/downCellIDsCls.R'
)
source
(
'modules/tabScatter.R'
)
\ No newline at end of file
modules/auxfunc.R
View file @
03947223
...
...
@@ -220,6 +220,105 @@ myNorm = function(in.dt,
return
(
loc.dt
)
}
# Plots a scatter plot with marginal histograms
# Points are connected by a line (grouping by cellID)
#
# Assumes an input of data.table with
# x, y - columns with x and y coordinates
# id - a unique point identifier (here corresponds to cellID)
# mid - a (0,1) column by which points are coloured (here corresponds to whether cells are within bounds)
myGgplotScat
=
function
(
dt.arg
,
band.arg
=
NULL
,
facet.arg
=
NULL
,
facet.ncol.arg
=
2
,
xlab.arg
=
NULL
,
ylab.arg
=
NULL
,
plotlab.arg
=
NULL
,
alpha.arg
=
1
,
group.col.arg
=
NULL
)
{
p.tmp
=
ggplot
(
dt.arg
,
aes
(
x
=
x
,
y
=
y
))
if
(
is.null
(
group.col.arg
))
{
p.tmp
=
p.tmp
+
geom_point
(
alpha
=
alpha.arg
,
aes
(
group
=
id
))
}
else
{
p.tmp
=
p.tmp
+
geom_point
(
aes
(
colour
=
as.factor
(
get
(
group.col.arg
)),
group
=
id
),
alpha
=
alpha.arg
)
+
geom_path
(
aes
(
colour
=
as.factor
(
get
(
group.col.arg
)),
group
=
id
),
alpha
=
alpha.arg
)
+
scale_color_manual
(
name
=
group.col.arg
,
values
=
c
(
"FALSE"
=
rhg_cols
[
7
],
"TRUE"
=
rhg_cols
[
3
],
"SELECTED"
=
'green'
))
}
if
(
is.null
(
band.arg
))
p.tmp
=
p.tmp
+
stat_smooth
(
method
=
function
(
formula
,
data
,
weights
=
weight
)
rlm
(
formula
,
data
,
weights
=
weight
,
method
=
'MM'
),
fullrange
=
FALSE
,
level
=
0.95
,
colour
=
'blue'
)
else
{
p.tmp
=
p.tmp
+
geom_abline
(
slope
=
band.arg
$
a
,
intercept
=
band.arg
$
b
)
+
geom_abline
(
slope
=
band.arg
$
a
,
intercept
=
band.arg
$
b
+
abs
(
band.arg
$
b
)
*
band.arg
$
width
,
linetype
=
'dashed'
)
+
geom_abline
(
slope
=
band.arg
$
a
,
intercept
=
band.arg
$
b
-
abs
(
band.arg
$
b
)
*
band.arg
$
width
,
linetype
=
'dashed'
)
}
if
(
!
is.null
(
facet.arg
))
{
p.tmp
=
p.tmp
+
facet_wrap
(
as.formula
(
paste
(
"~"
,
facet.arg
)),
ncol
=
facet.ncol.arg
)
}
if
(
!
is.null
(
xlab.arg
))
p.tmp
=
p.tmp
+
xlab
(
paste0
(
xlab.arg
,
"\n"
))
if
(
!
is.null
(
ylab.arg
))
p.tmp
=
p.tmp
+
ylab
(
paste0
(
"\n"
,
ylab.arg
))
if
(
!
is.null
(
plotlab.arg
))
p.tmp
=
p.tmp
+
ggtitle
(
paste0
(
plotlab.arg
,
"\n"
))
p.tmp
=
p.tmp
+
theme_bw
(
base_size
=
18
,
base_family
=
"Helvetica"
)
+
theme
(
panel.grid.minor
=
element_blank
(),
panel.grid.major
=
element_blank
(),
axis.line.x
=
element_line
(
color
=
"black"
,
size
=
0.25
),
axis.line.y
=
element_line
(
color
=
"black"
,
size
=
0.25
),
axis.text.x
=
element_text
(
size
=
12
),
axis.text.y
=
element_text
(
size
=
12
),
strip.text.x
=
element_text
(
size
=
14
,
face
=
"bold"
),
strip.text.y
=
element_text
(
size
=
14
,
face
=
"bold"
),
strip.background
=
element_blank
(),
legend.key
=
element_blank
(),
legend.key.height
=
unit
(
1
,
"lines"
),
legend.key.width
=
unit
(
2
,
"lines"
),
legend.position
=
"none"
)
# Marginal distributions don;t work with plotly...
# if (is.null(facet.arg))
# ggExtra::ggMarginal(p.scat, type = "histogram", bins = 100)
# else
return
(
p.tmp
)
}
myGgplotTheme
=
theme_bw
(
base_size
=
18
,
base_family
=
"Helvetica"
)
+
theme
(
...
...
modules/tabScatter.R
0 → 100644
View file @
03947223
# RShiny module for performing hierarchical clustering
# Use:
# in ui.R
# tabPanel(
# 'Hierarchical',
# clustHierUI('TabClustHier'))
#
# in server.R
# callModule(clustHier, 'TabClustHier', dataMod)
# where dataMod is the output from a reactive function that returns dataset ready for clustering
require
(
plotly
)
# interactive plot
require
(
robust
)
# UI
tabScatterPlotUI
<-
function
(
id
,
label
=
"Comparing t-points"
)
{
ns
<-
NS
(
id
)
tagList
(
h4
(
"Scatter plot between two time points"
),
br
(),
fluidRow
(
column
(
6
,
uiOutput
(
ns
(
'varSelTptX'
)),
uiOutput
(
ns
(
'varSelTptY'
))
),
column
(
6
,
numericInput
(
ns
(
'inPlotHeight'
),
'Display plot height'
,
value
=
1000
,
min
=
100
,
step
=
100
),
numericInput
(
ns
(
'inPlotNcolFacet'
),
'#columns'
,
value
=
2
,
min
=
1
,
step
=
1
)
)
),
br
(),
actionButton
(
ns
(
'butGoScatter'
),
'Plot!'
),
checkboxInput
(
ns
(
'plotInt'
),
'Interactive Plot?'
,
value
=
FALSE
),
uiOutput
(
ns
(
"plotInt_ui"
)),
downPlotUI
(
ns
(
'downPlotScatter'
),
"Download PDF"
)
)
}
# SERVER
tabScatterPlot
<-
function
(
input
,
output
,
session
,
in.data
)
{
# return all unique time points (real time)
# This will be used to display in UI for box-plot
# These timepoints are from the original dt and aren't affected by trimming of x-axis
getDataTpts
<-
reactive
({
cat
(
file
=
stderr
(),
'getDataTpts\n'
)
loc.dt
=
in.data
()
if
(
is.null
(
loc.dt
))
return
(
NULL
)
else
return
(
unique
(
loc.dt
$
realtime
))
})
output
$
varSelTptX
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelTptX\n'
)
ns
<-
session
$
ns
loc.v
=
getDataTpts
()
if
(
!
is.null
(
loc.v
))
{
selectInput
(
ns
(
'inSelTptX'
),
'Select timepoint for X-axis:'
,
loc.v
,
width
=
'100%'
,
selected
=
0
,
multiple
=
FALSE
)
}
})
output
$
varSelTptY
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelTptY\n'
)
ns
<-
session
$
ns
loc.v
=
getDataTpts
()
if
(
!
is.null
(
loc.v
))
{
selectInput
(
ns
(
'inSelTptY'
),
'Select timepoint for Y-axis:'
,
loc.v
,
width
=
'100%'
,
selected
=
0
,
multiple
=
FALSE
)
}
})
data4scatterPlot
<-
reactive
({
cat
(
file
=
stderr
(),
'data4scatterPlot\n'
)
loc.dt.in
=
in.data
()
if
(
is.null
(
loc.dt.in
))
return
(
NULL
)
loc.dt
=
data.table
(
x
=
loc.dt.in
[
realtime
==
input
$
inSelTptX
,
y
],
y
=
loc.dt.in
[
realtime
==
input
$
inSelTptY
,
y
],
group
=
loc.dt.in
[
realtime
==
input
$
inSelTptX
,
group
])
loc.dt.x
=
loc.dt.in
[
realtime
==
input
$
inSelTptX
]
loc.dt.y
=
loc.dt.in
[
realtime
==
input
$
inSelTptY
]
loc.dt
=
merge
(
loc.dt.x
,
loc.dt.y
,
by
=
'id'
)
setnames
(
loc.dt
,
c
(
'group.x'
,
'y.x'
,
'y.y'
),
c
(
'group'
,
'x'
,
'y'
))
return
(
loc.dt
)
})
# 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
plotScatter
<-
function
()
{
cat
(
file
=
stderr
(),
"plotScatter\n"
)
# isolate because calculations & plotting take a while
# re-plotting done upon button press
loc.dt
=
isolate
(
data4scatterPlot
())
#loc.fit = isolate(dataFit())
cat
(
"plotScatter on to plot\n\n"
)
if
(
is.null
(
loc.dt
))
{
cat
(
file
=
stderr
(),
'plotScatter: dt is NULL\n'
)
return
(
NULL
)
}
cat
(
file
=
stderr
(),
'plotScatter:dt not NULL\n'
)
## FIX: r.squared is unavailable for lm
# loc.fit.rsq = ifelse(input$inRobustFit, loc.fit$r.squared, )
p.out
=
myGgplotScat
(
dt.arg
=
loc.dt
,
band.arg
=
NULL
,
#list(a = loc.fit$coeff.a, b = loc.fit$coeff.b, width = input$inBandWidth),
group.col.arg
=
NULL
,
plotlab.arg
=
NULL
,
# plotlab.arg = sprintf(
# "%s%.2f\n%s%.2f x %.2f",
# ifelse(input$inRobustFit, "lmRob, entire dataset R2=", "lm, entire dataset R2="),
# loc.fit$r.squared,
# 'bandwidth=',
# input$inBandWidth,
# loc.fit$coeff.b
# ),
facet.arg
=
'group'
,
facet.ncol.arg
=
input
$
inPlotNcolFacet
,
alpha.arg
=
0.5
)
return
(
p.out
)
}
# display plot
output
$
outPlotScatter
<-
renderPlot
({
locBut
=
input
$
butGoScatter
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'plotScatter: Go button not pressed\n'
)
return
(
NULL
)
}
plotScatter
()
})
output
$
outPlotScatterInt
<-
renderPlotly
({
# This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
# https://github.com/ropensci/plotly/issues/494
if
(
names
(
dev.cur
())
!=
"null device"
)
dev.off
()
pdf
(
NULL
)
return
(
plotly_build
(
plotScatter
()))
})
# download pdf
callModule
(
downPlot
,
"downPlotScatter"
,
"scatter.pdf"
,
plotScatter
,
TRUE
)
# Hierarchical - choose to display regular heatmap.2 or d3heatmap (interactive)
output
$
plotInt_ui
<-
renderUI
({
ns
<-
session
$
ns
if
(
input
$
plotInt
)
tagList
(
plotlyOutput
(
ns
(
"outPlotScatterInt"
),
height
=
paste0
(
input
$
inPlotHeight
,
"px"
)))
else
tagList
(
plotOutput
(
ns
(
'outPlotScatter'
),
height
=
paste0
(
input
$
inPlotHeight
,
"px"
)))
})
}
\ No newline at end of file
server.R
View file @
03947223
...
...
@@ -803,6 +803,9 @@ shinyServer(function(input, output, session) {
}
###### Scatter plot
callModule
(
tabScatterPlot
,
'tabScatter'
,
data4trajPlot
)
##### Hierarchical clustering
output
$
uiPlotHierClSel
=
renderUI
({
...
...
@@ -972,12 +975,12 @@ shinyServer(function(input, output, session) {
# s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.csv'),
# getDataCl(userFitDendHier, input$inPlotHierNclust, getDataTrackObjLabUni_afterTrim))
#
#
output$downloadDataClean <- downloadHandler(
#
filename = 'tCoursesSelected_clean.csv',
#
content = function(file) {
#
write.csv(data4trajPlot(), file, row.names = FALSE)
#
}
#
)
output
$
downloadDataClean
<-
downloadHandler
(
filename
=
'tCoursesSelected_clean.csv'
,
content
=
function
(
file
)
{
write.csv
(
data4trajPlot
(),
file
,
row.names
=
FALSE
)
}
)
...
...
ui.R
View file @
03947223
...
...
@@ -142,12 +142,17 @@ shinyUI(fluidPage(
),
# scatter plot
tabPanel
(
'Scatter'
,
tabScatterPlotUI
(
'tabScatter'
)
),
tabPanel
(
'Hierarchical'
,
br
(),
fluidRow
(
column
(
6
,
column
(
4
,
selectInput
(
"selectPlotHierLinkage"
,
label
=
(
"Select linkage method:"
),
...
...
@@ -174,7 +179,7 @@ shinyUI(fluidPage(
selected
=
1
)
),
column
(
6
,
column
(
4
,
sliderInput
(
'inPlotHierNclust'
,
'#dendrogram branches to colour'
,
...
...
@@ -191,8 +196,6 @@ shinyUI(fluidPage(
downloadButton
(
'downCellCl'
,
'Download CSV with cell IDs and cluster no.'
)
)
),
br
(),
#checkboxInput('inPlotHierSparInteractive', 'Interactive Plot?', value = FALSE),
...
...
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