Commit 32e1ddc7 authored by majpark21's avatar majpark21
Browse files

PSD: plot with color bar in clustering, inverse transform of axis, option to...

PSD: plot with color bar in clustering, inverse transform of axis, option to adjust period and frequency units
parent 3acb6728
...@@ -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.color.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)
......
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 function:', list('log2'= 'log2', 'log10'= 'log10', 'ln'= 'log')), selectInput(ns('inPSDlogtype'), 'Transformation:', 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.color.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)
} }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment