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
e102708a
Commit
e102708a
authored
Feb 27, 2018
by
dmattek
Browse files
Added: ribbon plot with averages
parent
eef7cc31
Changes
5
Hide whitespace changes
Inline
Side-by-side
global.R
View file @
e102708a
...
...
@@ -4,6 +4,7 @@ source('modules/downCellIDsCls.R')
source
(
'modules/dispStats.R'
)
source
(
'modules/dispTrackStats.R'
)
source
(
'modules/trajPlot.R'
)
source
(
'modules/trajRibbonPlot.R'
)
source
(
'modules/boxPlot.R'
)
source
(
'modules/tabAUC.R'
)
source
(
'modules/clDistPlot.R'
)
...
...
modules/downPlot.R
View file @
e102708a
...
...
@@ -36,13 +36,24 @@ downPlotUI <- function(id, label = "Download Plot") {
)
),
column
(
6
,
downloadButton
(
ns
(
'downPlot'
),
'PDF'
))
uiOutput
(
ns
(
'uiDownButton'
)
))
)
)
}
downPlot
<-
function
(
input
,
output
,
session
,
in.fname
,
in.plot
,
in.gg
=
FALSE
)
{
output
$
uiDownButton
=
renderUI
({
ns
<-
session
$
ns
if
(
in.fname
%like%
'pdf'
)
{
downloadButton
(
ns
(
'downPlot'
),
'PDF'
)
}
else
{
downloadButton
(
ns
(
'downPlot'
),
'PNG'
)
}
})
output
$
downPlot
<-
downloadHandler
(
filename
=
function
()
{
in.fname
...
...
modules/tabClHier.R
View file @
e102708a
...
...
@@ -151,6 +151,9 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
tabPanel
(
'Time-courses'
,
modTrajPlotUI
(
ns
(
'modPlotHierTraj'
))),
tabPanel
(
'Averages'
,
modTrajRibbonPlotUI
(
ns
(
'modPlotHierTrajRibbon'
))),
tabPanel
(
'Cluster dist.'
,
modClDistPlotUI
(
ns
(
'hierClDistPlot'
),
'xxx'
))
...
...
@@ -411,6 +414,15 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
))
callModule
(
modTrajRibbonPlot
,
'modPlotHierTrajRibbon'
,
in.data
=
data4trajPlotCl
,
in.facet
=
'cl'
,
in.facet.color
=
getClColHier
,
in.fname
=
paste0
(
'clust_hierch_tCoursesMeans_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
))
callModule
(
modClDistPlot
,
'hierClDistPlot'
,
in.data
=
data4clDistPlot
,
in.cols
=
getClColHier
,
...
...
modules/tabClHierSpar.R
View file @
e102708a
...
...
@@ -455,7 +455,14 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
))
callModule
(
modTrajRibbonPlot
,
'modPlotHierSparTrajRibbon'
,
in.data
=
data4trajPlotClSpar
,
in.facet
=
'cl'
,
in.facet.color
=
getClColHierSpar
,
in.fname
=
paste0
(
'clust_hierchSparse_tCoursesMeans_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
))
callModule
(
modClDistPlot
,
'hierClSparDistPlot'
,
...
...
modules/trajRibbonPlot.R
0 → 100644
View file @
e102708a
require
(
DT
)
require
(
tca
)
modTrajRibbonPlotUI
=
function
(
id
,
label
=
"Plot Individual Time Series"
)
{
ns
<-
NS
(
id
)
tagList
(
fluidRow
(
column
(
3
,
checkboxInput
(
ns
(
'chBplotTrajInt'
),
'Interactive Plot?'
),
actionButton
(
ns
(
'butPlotTraj'
),
'Plot!'
)
),
column
(
3
,
sliderInput
(
ns
(
'sliPlotTrajSkip'
),
'Plot every n-th point:'
,
min
=
1
,
max
=
10
,
value
=
1
,
step
=
1
)
),
column
(
3
,
numericInput
(
ns
(
'inPlotTrajWidth'
),
'Width [%]:'
,
value
=
100
,
min
=
10
,
max
=
100
,
width
=
'100px'
,
step
=
10
),
numericInput
(
ns
(
'inPlotTrajHeight'
),
'Height [px]:'
,
value
=
800
,
min
=
100
,
width
=
'100px'
,
step
=
50
)
)
),
uiOutput
(
ns
(
'uiPlotTraj'
)),
br
(),
modTrackStatsUI
(
ns
(
'dispTrackStats'
)),
downPlotUI
(
ns
(
'downPlotTraj'
),
"Download PDF"
)
)
}
modTrajRibbonPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.facet
=
'group'
,
in.facet.color
=
NULL
,
in.fname
=
'tCourses.pdf'
)
{
ns
<-
session
$
ns
output
$
uiPlotTraj
=
renderUI
({
if
(
input
$
chBplotTrajInt
)
plotlyOutput
(
ns
(
"outPlotTrajInt"
),
width
=
paste0
(
input
$
inPlotTrajWidth
,
'%'
),
height
=
paste0
(
input
$
inPlotTrajHeight
,
'px'
)
)
else
plotOutput
(
ns
(
"outPlotTraj"
),
width
=
paste0
(
input
$
inPlotTrajWidth
,
'%'
),
height
=
paste0
(
input
$
inPlotTrajHeight
,
'px'
)
)
})
callModule
(
modTrackStats
,
'dispTrackStats'
,
in.data
=
in.data
)
output
$
outPlotTraj
<-
renderPlot
({
loc.p
=
plotTraj
()
if
(
is.null
(
loc.p
))
return
(
NULL
)
return
(
loc.p
)
})
output
$
outPlotTrajInt
<-
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
)
loc.p
=
plotTraj
()
if
(
is.null
(
loc.p
))
return
(
NULL
)
return
(
plotly_build
(
loc.p
))
})
# Trajectory plot - download pdf
callModule
(
downPlot
,
"downPlotTraj"
,
in.fname
,
plotTraj
,
TRUE
)
plotTraj
<-
function
()
{
cat
(
file
=
stderr
(),
'plotTraj: in\n'
)
locBut
=
input
$
butPlotTraj
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'plotTraj: Go button not pressed\n'
)
return
(
NULL
)
}
loc.dt
=
isolate
(
in.data
())
cat
(
"plotTraj: on to plot\n\n"
)
if
(
is.null
(
loc.dt
))
{
cat
(
file
=
stderr
(),
'plotTraj: dt is NULL\n'
)
return
(
NULL
)
}
cat
(
file
=
stderr
(),
'plotTraj: dt not NULL\n'
)
# Future: change such that a column with colouring status is chosen by the user
# colour trajectories, if dataset contains mid.in column
# with filtering status of trajectory
if
(
sum
(
names
(
loc.dt
)
%in%
'mid.in'
)
>
0
)
loc.line.col.arg
=
'mid.in'
else
loc.line.col.arg
=
NULL
# select every other point for plotting
loc.dt
=
loc.dt
[,
.SD
[
seq
(
1
,
.N
,
input
$
sliPlotTrajSkip
)],
by
=
id
]
# check if columns with XY positions are present
if
(
sum
(
names
(
loc.dt
)
%like%
'pos'
)
==
2
)
locPos
=
TRUE
else
locPos
=
FALSE
# check if column with ObjectNumber is present
if
(
sum
(
names
(
loc.dt
)
%like%
'obj.num'
)
==
1
)
locObjNum
=
TRUE
else
locObjNum
=
FALSE
# If in.facet.color present,
# make sure to include the same number of colours in the palette,
# as the number of groups in dt.
# in.facet.color is typically used when plotting time series within clusters.
# Then, the number of colours in the palette has to be equal to the number of clusters (facetted according to in.facet variable).
# This might differ if the user selects manually clusters to display.
if
(
is.null
(
in.facet.color
))
loc.facet.col
=
NULL
else
{
# get group numbers in dt;
# loc.dt[, c(in.facet), with = FALSE] returns a data table with a single column
# [[1]] at the end extracts the first column and returns as a vector
loc.groups
=
unique
(
loc.dt
[,
c
(
in.facet
),
with
=
FALSE
][[
1
]])
# get colour palette
# the length is equal to the number of groups in the original dt.
# When plotting time series within clusters, the length equals the number of clusters.
loc.facet.col
=
in.facet.color
()
$
cl.col
loc.facet.col
=
loc.facet.col
[
loc.groups
]
}
loc.dt.aggr
=
calcTrajCI
(
in.dt
=
loc.dt
,
in.col.meas
=
'y'
,
in.col.by
=
c
(
in.facet
,
'realtime'
),
in.type
=
'normal'
)
loc.dt.aggr
[,
(
in.facet
)
:=
as.factor
(
get
(
in.facet
))]
p.out
=
tca
::
plotTrajRibbon
(
dt.arg
=
loc.dt.aggr
,
x.arg
=
'realtime'
,
y.arg
=
'Mean'
,
col.arg
=
loc.facet.col
,
group.arg
=
in.facet
,
xlab.arg
=
'Time (min)'
,
ylab.arg
=
''
)
# p.out = myGgplotTraj(
# dt.arg = loc.dt,
# x.arg = 'realtime',
# y.arg = 'y',
# group.arg = "id",
# facet.arg = in.facet,
# facet.ncol.arg = input$inPlotTrajFacetNcol,
# facet.color.arg = loc.facet.col,
# xlab.arg = 'Time (min)',
# line.col.arg = loc.line.col.arg,
# aux.label1 = if (locPos) 'pos.x' else NULL,
# aux.label2 = if (locPos) 'pos.y' else NULL,
# aux.label3 = if (locObjNum) 'obj.num' else NULL,
# stat.arg = input$chBPlotTrajStat
# )
return
(
p.out
)
}
}
\ No newline at end of file
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