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
899e0590
Commit
899e0590
authored
Jun 10, 2019
by
majpark21
Browse files
added PSDplot file
parent
64dd334f
Changes
1
Hide whitespace changes
Inline
Side-by-side
modules/trajPsdPlot.R
0 → 100644
View file @
899e0590
require
(
DT
)
modPSDPlotUI
=
function
(
id
,
label
=
"Plot PSD of average trajectory."
)
{
ns
<-
NS
(
id
)
tagList
(
fluidRow
(
column
(
3
,
checkboxInput
(
ns
(
'chBplotTrajInt'
),
'Interactive Plot'
),
radioButtons
(
ns
(
'rBlegendPos'
),
'Legend placement:'
,
list
(
'top'
=
'top'
,
'right'
=
'right'
)),
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"
)
)
}
modPSDPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.facet
=
'group'
,
in.facet.color
=
NULL
,
in.fname
)
{
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
))
})
# PSD plot - download pdf
callModule
(
downPlot
,
"downPlotTraj"
,
in.fname
=
in.fname
,
plotTraj
,
TRUE
)
plotPSD
<-
function
()
{
cat
(
file
=
stderr
(),
'plotPSD: in\n'
)
locBut
=
input
$
butPlotTraj
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'plotPSD: Go button not pressed\n'
)
return
(
NULL
)
}
# check if main data exists
loc.dt
=
isolate
(
in.data
())
cat
(
"plotPSD: on to plot\n\n"
)
if
(
is.null
(
loc.dt
))
{
cat
(
file
=
stderr
(),
'plotPSD: dt is NULL\n'
)
return
(
NULL
)
}
cat
(
file
=
stderr
(),
'plotPSD: 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
<-
LOCcalcPSD
(
in.dt
=
loc.dt
,
in.col.meas
=
'y'
,
in.col.id
=
'id'
,
in.col.by
=
in.facet
,
in.method
=
'pgram'
,
in.return.period
=
TRUE
)
loc.dt.aggr
[,
(
in.facet
)
:=
as.factor
(
get
(
in.facet
))]
x_arg
<-
ifelse
(
'period'
%in%
colnames
(
loc.dt.aggr
),
'period'
,
'frequency'
)
p.out
<-
LOCplotPSD
(
dt.arg
=
loc.dt.aggr
,
x.arg
=
x_arg
,
y.arg
=
'spec'
,
group.arg
=
in.facet
,
xlab.arg
=
x_arg
,
ylab.arg
=
''
)
+
LOCggplotTheme
(
in.font.base
=
PLOTFONTBASE
,
in.font.axis.text
=
PLOTFONTAXISTEXT
,
in.font.axis.title
=
PLOTFONTAXISTITLE
,
in.font.strip
=
PLOTFONTFACETSTRIP
,
in.font.legend
=
PLOTFONTLEGEND
)
+
theme
(
legend.position
=
input
$
rBlegendPos
)
return
(
p.out
)
}
}
\ No newline at end of file
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