Skip to content
GitLab
Menu
Projects
Groups
Snippets
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
ffab21c1
Unverified
Commit
ffab21c1
authored
Jun 12, 2019
by
Maciej Dobrzynski
Committed by
GitHub
Jun 12, 2019
Browse files
Merge pull request #2 from majpark21/master
PSD plot improvments
parents
2b6b221d
32e1ddc7
Changes
2
Hide whitespace changes
Inline
Side-by-side
modules/auxfunc.R
View file @
ffab21c1
...
@@ -229,6 +229,7 @@ LOCcalcPSD <- function(in.dt,
...
@@ -229,6 +229,7 @@ LOCcalcPSD <- function(in.dt,
in.col.by
,
in.col.by
,
in.method
=
"pgram"
,
in.method
=
"pgram"
,
in.return.period
=
TRUE
,
in.return.period
=
TRUE
,
in.time.btwPoints
=
1
,
...
){
...
){
require
(
data.table
)
require
(
data.table
)
# Method "ar" returns $spec as matrix whereas "pgram" returns a vector, custom function to homogenze output format
# Method "ar" returns $spec as matrix whereas "pgram" returns a vector, custom function to homogenze output format
...
@@ -250,8 +251,11 @@ LOCcalcPSD <- function(in.dt,
...
@@ -250,8 +251,11 @@ LOCcalcPSD <- function(in.dt,
dt_agg
<-
dt_spec
[,
.
(
spec
=
mean
(
spec
)),
by
=
c
(
in.col.by
,
"freq"
)]
dt_agg
<-
dt_spec
[,
.
(
spec
=
mean
(
spec
)),
by
=
c
(
in.col.by
,
"freq"
)]
if
(
in.return.period
){
if
(
in.return.period
){
dt_agg
[,
period
:=
1
/
freq
]
dt_agg
[,
period
:=
1
/
freq
]
dt_agg
[,
frequency
:=
NULL
]
dt_agg
[,
freq
:=
NULL
]
# Adjust period unit to go from frame unit to time unit
dt_agg
[,
period
:=
period
*
in.time.btwPoints
]
}
else
{
}
else
{
dt_agg
[,
freq
:=
freq
*
(
1
/
in.time.btwPoints
)]
setnames
(
dt_agg
,
"freq"
,
"frequency"
)
setnames
(
dt_agg
,
"freq"
,
"frequency"
)
}
}
return
(
dt_agg
)
return
(
dt_agg
)
...
@@ -703,7 +707,7 @@ LOCplotPSD <- function(dt.arg, # input data table
...
@@ -703,7 +707,7 @@ LOCplotPSD <- function(dt.arg, # input data table
group.arg
=
NULL
,
# string with column name for grouping time series (here, it's a column corresponding to grouping by condition)
group.arg
=
NULL
,
# string with column name for grouping time series (here, it's a column corresponding to grouping by condition)
xlab.arg
=
x.arg
,
xlab.arg
=
x.arg
,
ylab.arg
=
y.arg
,
ylab.arg
=
y.arg
,
col.arg
=
NULL
){
facet.
col
or
.arg
=
NULL
){
require
(
ggplot2
)
require
(
ggplot2
)
if
(
length
(
setdiff
(
c
(
x.arg
,
y.arg
,
group.arg
),
colnames
(
dt.arg
)))
>
0
){
if
(
length
(
setdiff
(
c
(
x.arg
,
y.arg
,
group.arg
),
colnames
(
dt.arg
)))
>
0
){
stop
(
paste
(
"Missing columns in dt.arg: "
,
setdiff
(
c
(
x.arg
,
y.arg
,
group.arg
),
colnames
(
dt.arg
))))
stop
(
paste
(
"Missing columns in dt.arg: "
,
setdiff
(
c
(
x.arg
,
y.arg
,
group.arg
),
colnames
(
dt.arg
))))
...
@@ -714,12 +718,18 @@ LOCplotPSD <- function(dt.arg, # input data table
...
@@ -714,12 +718,18 @@ LOCplotPSD <- function(dt.arg, # input data table
facet_wrap
(
group.arg
)
+
facet_wrap
(
group.arg
)
+
labs
(
x
=
xlab.arg
,
y
=
ylab.arg
)
labs
(
x
=
xlab.arg
,
y
=
ylab.arg
)
if
(
is.null
(
col.arg
))
{
if
(
!
is.null
(
facet.color.arg
))
{
p.tmp
=
p.tmp
+
scale_color_discrete
(
name
=
''
)
loc.y.max
=
max
(
dt.arg
[,
c
(
y.arg
),
with
=
FALSE
])
}
else
{
loc.dt.cl
=
data.table
(
xx
=
1
:
length
(
facet.color.arg
),
yy
=
loc.y.max
)
setnames
(
loc.dt.cl
,
'xx'
,
group.arg
)
# adjust facet.color.arg to plot
p.tmp
=
p.tmp
+
p.tmp
=
p.tmp
+
scale_colour_manual
(
values
=
col.arg
,
name
=
''
)
geom_hline
(
data
=
loc.dt.cl
,
colour
=
facet.color.arg
,
yintercept
=
loc.y.max
,
size
=
4
)
+
scale_colour_manual
(
values
=
facet.color.arg
,
name
=
''
)
}
}
return
(
p.tmp
)
return
(
p.tmp
)
...
...
modules/trajPsdPlot.R
View file @
ffab21c1
require
(
DT
)
require
(
DT
)
require
(
scales
)
# UI ----
# UI ----
modPSDPlotUI
=
function
(
id
,
label
=
"Plot PSD of average trajectory."
)
{
modPSDPlotUI
=
function
(
id
,
label
=
"Plot PSD of average trajectory."
)
{
...
@@ -8,18 +9,19 @@ modPSDPlotUI = function(id, label = "Plot PSD of average trajectory.") {
...
@@ -8,18 +9,19 @@ modPSDPlotUI = function(id, label = "Plot PSD of average trajectory.") {
fluidRow
(
fluidRow
(
column
(
column
(
3
,
3
,
radioButtons
(
ns
(
'rBPSDmethod'
),
'Method for PSD estimation:'
,
list
(
'Smoothed Fourier'
=
'pgram'
,
'AR Fit'
=
'ar'
)),
checkboxInput
(
ns
(
'chBplotTrajInt'
),
'Interactive Plot'
),
checkboxInput
(
ns
(
'chBplotTrajInt'
),
'Interactive Plot'
),
actionButton
(
ns
(
'butPlotTraj'
),
'Plot!'
)
actionButton
(
ns
(
'butPlotTraj'
),
'Plot!'
)
),
),
column
(
column
(
3
,
3
,
selectInput
(
ns
(
'inPSDxchoice'
),
'Xaxis:'
,
list
(
'Period'
=
TRUE
,
'Frequency'
=
FALSE
)),
selectInput
(
ns
(
'inPSDxchoice'
),
'X
-
axis:'
,
list
(
'Period'
=
TRUE
,
'Frequency'
=
FALSE
)),
radioButtons
(
ns
(
'rBPSDmethod'
),
'Method for PSD estimation:'
,
list
(
'Smoothed Fourier'
=
'pgram'
,
'AR Fit'
=
'ar'
)
)
numericInput
(
ns
(
'ninPSDsamplFreq'
),
'# time units between 2 points:'
,
value
=
1
,
min
=
0
,
step
=
1
)
),
),
column
(
column
(
3
,
3
,
selectInput
(
ns
(
'inPSDlogtype'
),
'
Log func
tion:'
,
list
(
'log2'
=
'log2'
,
'log10'
=
'log10'
,
'ln'
=
'log'
)),
selectInput
(
ns
(
'inPSDlogtype'
),
'
Transforma
tion:'
,
list
(
'1/x'
=
'inverse_trans'
,
'log2'
=
'log2'
,
'log10'
=
'log10'
,
'ln'
=
'log'
)),
checkboxGroupInput
(
ns
(
'chBGPSDlogaxis'
),
'
Log
the axis:'
,
list
(
'x'
=
'x'
,
'y'
=
'y'
),
inline
=
TRUE
)
checkboxGroupInput
(
ns
(
'chBGPSDlogaxis'
),
'
Transform
the axis:'
,
list
(
'x'
=
'x'
,
'y'
=
'y'
),
inline
=
TRUE
)
),
),
column
(
column
(
3
,
3
,
...
@@ -43,9 +45,6 @@ modPSDPlotUI = function(id, label = "Plot PSD of average trajectory.") {
...
@@ -43,9 +45,6 @@ modPSDPlotUI = function(id, label = "Plot PSD of average trajectory.") {
)
)
),
),
uiOutput
(
ns
(
'uiPlotTraj'
)),
uiOutput
(
ns
(
'uiPlotTraj'
)),
br
(),
modTrackStatsUI
(
ns
(
'dispTrackStats'
)),
downPlotUI
(
ns
(
'downPlotTraj'
),
"Download PDF"
)
downPlotUI
(
ns
(
'downPlotTraj'
),
"Download PDF"
)
)
)
}
}
...
@@ -187,7 +186,8 @@ modPSDPlot = function(input, output, session,
...
@@ -187,7 +186,8 @@ modPSDPlot = function(input, output, session,
in.col.id
=
'id'
,
in.col.id
=
'id'
,
in.col.by
=
in.facet
,
in.col.by
=
in.facet
,
in.method
=
input
$
rBPSDmethod
,
in.method
=
input
$
rBPSDmethod
,
in.return.period
=
input
$
inPSDxchoice
in.return.period
=
input
$
inPSDxchoice
,
in.time.btwPoints
=
input
$
ninPSDsamplFreq
)
)
loc.dt.aggr
[,
(
in.facet
)
:=
as.factor
(
get
(
in.facet
))]
loc.dt.aggr
[,
(
in.facet
)
:=
as.factor
(
get
(
in.facet
))]
...
@@ -197,7 +197,7 @@ modPSDPlot = function(input, output, session,
...
@@ -197,7 +197,7 @@ modPSDPlot = function(input, output, session,
x.arg
=
x_arg
,
x.arg
=
x_arg
,
y.arg
=
'spec'
,
y.arg
=
'spec'
,
group.arg
=
in.facet
,
group.arg
=
in.facet
,
col.arg
=
loc.facet.col
,
facet.
col
or
.arg
=
loc.facet.col
,
xlab.arg
=
x_arg_str
,
xlab.arg
=
x_arg_str
,
ylab.arg
=
''
)
+
ylab.arg
=
''
)
+
LOCggplotTheme
(
in.font.base
=
PLOTFONTBASE
,
LOCggplotTheme
(
in.font.base
=
PLOTFONTBASE
,
...
@@ -205,11 +205,23 @@ modPSDPlot = function(input, output, session,
...
@@ -205,11 +205,23 @@ modPSDPlot = function(input, output, session,
in.font.axis.title
=
PLOTFONTAXISTITLE
,
in.font.axis.title
=
PLOTFONTAXISTITLE
,
in.font.strip
=
PLOTFONTFACETSTRIP
,
in.font.strip
=
PLOTFONTFACETSTRIP
,
in.font.legend
=
PLOTFONTLEGEND
)
in.font.legend
=
PLOTFONTLEGEND
)
# TODO: Restore tick labels when using inverse transformation
# See: https://stackoverflow.com/questions/56130614/ggplot2-missing-labels-after-custom-scaling-of-axis
inverse_trans
<-
scales
::
trans_new
(
"myinverse"
,
transform
=
function
(
x
)
1
/
x
,
inverse
=
function
(
x
)
1
/
(
1
/
x
))
if
(
"x"
%in%
input
$
chBGPSDlogaxis
){
if
(
"x"
%in%
input
$
chBGPSDlogaxis
){
p.out
<-
p.out
+
scale_x_continuous
(
trans
=
input
$
inPSDlogtype
)
if
(
input
$
inPSDlogtype
==
"inverse_trans"
){
p.out
<-
p.out
+
scale_x_continuous
(
trans
=
inverse_trans
)
}
else
{
p.out
<-
p.out
+
scale_x_continuous
(
trans
=
input
$
inPSDlogtype
)
}
}
}
if
(
"y"
%in%
input
$
chBGPSDlogaxis
){
if
(
"y"
%in%
input
$
chBGPSDlogaxis
){
if
(
input
$
inPSDlogtype
==
"inverse_trans"
){
p.out
<-
p.out
+
scale_y_continuous
(
trans
=
inverse_trans
)
}
else
{
p.out
<-
p.out
+
scale_y_continuous
(
trans
=
input
$
inPSDlogtype
)
p.out
<-
p.out
+
scale_y_continuous
(
trans
=
input
$
inPSDlogtype
)
}
}
}
return
(
p.out
)
return
(
p.out
)
}
}
...
...
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