In order to mitigate against the brute force attacks against Gitlab accounts, we are moving to all edu-ID Logins. We would like to remind you to link your account with your edu-id. Login will be possible only by edu-ID after November 30, 2021. Here you can find the instructions for linking your account.

If you don't have a SWITCH edu-ID, you can create one with this guide here

kind regards

This Server has been upgraded to GitLab release 14.2.6

Commit afea0ae1 authored by majpark21's avatar majpark21
Browse files

Fix bug with AR periodogram, add rugs PSD plot, custom UI PSD

parent 09033ebd
......@@ -231,15 +231,28 @@ LOCcalcPSD <- function(in.dt,
in.return.period = TRUE,
...){
require(data.table)
# Method "ar" returns $spec as matrix whereas "pgram" returns a vector, custom function to homogenze output format
mySpectrum <- function(x, ...){
args_spec <- list(x=x, plot=FALSE)
inargs <- list(...)
args_spec[names(inargs)] <- inargs
out <- do.call(spectrum, args_spec)
out$spec <- as.vector(out$spec)
return(out)
}
if(!in.method %in% c("pgram", "ar")){
stop('Method should be one of: c("pgram", "ar"')
}
dt_spec <- copy(in.dt)
dt_spec[, c("frequency", "spec") := (spectrum(get(in.col.meas), plot = FALSE, method = in.method, ...)[c("freq", "spec")]), by = in.col.id]
dt_agg <- dt_spec[, .(spec = mean(spec)), by = c(in.col.by, "frequency")]
dt_spec <- in.dt[, (mySpectrum(get(in.col.meas), plot = FALSE, method = in.method)[c("freq", "spec")]), by = in.col.id]
dt_group <- in.dt[, .SD[1, get(in.col.by)], by = in.col.id]
setnames(dt_group, "V1", in.col.by)
dt_spec <- merge(dt_spec, dt_group, by = in.col.id)
dt_agg <- dt_spec[, .(spec = mean(spec)), by = c(in.col.by, "freq")]
if(in.return.period){
dt_agg[, period := 1/frequency]
dt_agg[, period := 1/freq]
dt_agg[, frequency := NULL]
} else {
setnames(dt_agg, "freq", "frequency")
}
return(dt_agg)
}
......@@ -689,15 +702,26 @@ LOCplotPSD <- function(dt.arg, # input data table
y.arg, # string with column name for y-axis
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,
ylab.arg = y.arg){
ylab.arg = y.arg,
col.arg = NULL){
require(ggplot2)
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))))
}
p.tmp <- ggplot(dt.arg, aes_string(x=x.arg, y=y.arg)) +
geom_line() +
geom_rug(sides="b", alpha = 1, color = "lightblue") +
facet_wrap(group.arg) +
labs(x = xlab.arg, y = ylab.arg)
if (is.null(col.arg)) {
p.tmp = p.tmp +
scale_color_discrete(name = '')
} else {
p.tmp = p.tmp +
scale_colour_manual(values = col.arg, name = '')
}
return(p.tmp)
}
......
......@@ -9,12 +9,16 @@ modPSDPlotUI = function(id, label = "Plot PSD of average trajectory.") {
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)
radioButtons(ns('rBPSDmethod'), 'Method for PSD estimation:', list('Smoothed Fourier' = 'pgram', 'AR Fit' = 'ar'))
),
column(
3,
selectInput(ns('inPSDlogtype'), 'Log function:', list('log2'= 'log2', 'log10'= 'log10', 'ln'= 'log')),
checkboxGroupInput(ns('chBGPSDlogaxis'), 'Log the axis:', list('x' = 'x', 'y' = 'y'), inline = TRUE)
),
column(
3,
......@@ -105,7 +109,7 @@ modPSDPlot = function(input, output, session,
# PSD plot - download pdf
callModule(downPlot, "downPlotTraj",
in.fname = in.fname,
in.fname = in.fname,
plotTraj, TRUE)
plotTraj <- function() {
......@@ -139,9 +143,9 @@ modPSDPlot = function(input, output, session,
else
loc.line.col.arg = NULL
# select every other point for plotting
loc.dt = loc.dt[, .SD[seq(1, .N, input$sliPlotTrajSkip)], by = id]
# select every other point for plotting (fixed for PSD because lead to false interpretation of PSD)
loc.dt = loc.dt[, .SD[seq(1, .N, 1)], by = id]
# check if columns with XY positions are present
if (sum(names(loc.dt) %like% 'pos') == 2)
locPos = TRUE
......@@ -155,7 +159,6 @@ modPSDPlot = function(input, output, session,
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.
......@@ -182,25 +185,31 @@ modPSDPlot = function(input, output, session,
in.col.meas = 'y',
in.col.id = 'id',
in.col.by = in.facet,
in.method = 'pgram',
in.method = input$rBPSDmethod,
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')
x_arg_str <- paste0(toupper(substr(x_arg, 1, 1)), tolower(substring(x_arg, 2))) # capitalized
p.out <- LOCplotPSD(dt.arg = loc.dt.aggr,
x.arg = x_arg,
y.arg = 'spec',
group.arg = in.facet,
xlab.arg = x_arg,
col.arg = loc.facet.col,
xlab.arg = x_arg_str,
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)
in.font.legend = PLOTFONTLEGEND)
if("x" %in% input$chBGPSDlogaxis){
p.out <- p.out + scale_x_continuous(trans = input$inPSDlogtype) + xlab(paste0(input$inPSDlogtype, "(", x_arg_str, ")"))
}
if("y" %in% input$chBGPSDlogaxis){
p.out <- p.out + scale_y_continuous(trans = input$inPSDlogtype)
}
return(p.out)
}
}
\ No newline at end of file
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