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

modules/auxfunc.R

@@ -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)
 }
 

modules/trajPsdPlot.R

@@ -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