Added: ribbon plot with averages

global.R

@@ -4,6 +4,7 @@ source('modules/downCellIDsCls.R')
 source('modules/dispStats.R')
 source('modules/dispTrackStats.R')
 source('modules/trajPlot.R')
+source('modules/trajRibbonPlot.R')
 source('modules/boxPlot.R')
 source('modules/tabAUC.R')
 source('modules/clDistPlot.R')

modules/downPlot.R

@@ -36,13 +36,24 @@ downPlotUI <- function(id, label = "Download Plot") {
         )
       ),
       column(6,
-             downloadButton(ns('downPlot'), 'PDF'))
+             uiOutput(ns('uiDownButton')))
     )
   )
 }
 
 downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
 
+  output$uiDownButton = renderUI({
+    ns <- session$ns
+    
+    if (in.fname %like% 'pdf') {
+      downloadButton(ns('downPlot'), 'PDF')
+    } else {
+      downloadButton(ns('downPlot'), 'PNG')
+    }
+    
+  })
+  
   output$downPlot <- downloadHandler(
     filename = function() {
       in.fname

modules/tabClHier.R

@@ -151,6 +151,9 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
       tabPanel('Time-courses',
                modTrajPlotUI(ns('modPlotHierTraj'))),
       
+      tabPanel('Averages',
+               modTrajRibbonPlotUI(ns('modPlotHierTrajRibbon'))),
+      
       tabPanel('Cluster dist.',
                modClDistPlotUI(ns('hierClDistPlot'), 'xxx'))
       
@@ -411,6 +414,15 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
                                '_',
                                s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
   
+  callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon', 
+             in.data = data4trajPlotCl, 
+             in.facet = 'cl',  
+             in.facet.color = getClColHier,
+             in.fname = paste0('clust_hierch_tCoursesMeans_',
+                               s.cl.diss[as.numeric(input$selectPlotHierDiss)],
+                               '_',
+                               s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'))
+  
   callModule(modClDistPlot, 'hierClDistPlot', 
              in.data = data4clDistPlot,
              in.cols = getClColHier,

modules/tabClHierSpar.R

@@ -455,7 +455,14 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
                     '_',
                     s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'))
   
-  
+  callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon', 
+             in.data = data4trajPlotClSpar, 
+             in.facet = 'cl',  
+             in.facet.color = getClColHierSpar,
+             in.fname = paste0('clust_hierchSparse_tCoursesMeans_',
+                               s.cl.diss[as.numeric(input$selectPlotHierSparDiss)],
+                               '_',
+                               s.cl.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'))
   
   
   callModule(modClDistPlot, 'hierClSparDistPlot', 

modules/trajRibbonPlot.R

+require(DT)
+require(tca)
+
+modTrajRibbonPlotUI =  function(id, label = "Plot Individual Time Series") {
+  ns <- NS(id)
+  
+  tagList(
+    fluidRow(
+      column(
+        3,
+        checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot?'),
+        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")
+  )
+}
+
+
+modTrajRibbonPlot = function(input, output, session, in.data, in.facet = 'group', in.facet.color = NULL, in.fname = 'tCourses.pdf') {
+  
+  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))
+  })
+  
+  
+  
+  # Trajectory plot - download pdf
+  callModule(downPlot, "downPlotTraj", in.fname, plotTraj, TRUE)
+  
+  plotTraj <- function() {
+    cat(file = stderr(), 'plotTraj: in\n')
+    locBut = input$butPlotTraj
+    
+    if (locBut == 0) {
+      cat(file = stderr(), 'plotTraj: Go button not pressed\n')
+      
+      return(NULL)
+    }
+    
+    loc.dt = isolate(in.data())
+    
+    cat("plotTraj: on to plot\n\n")
+    if (is.null(loc.dt)) {
+      cat(file = stderr(), 'plotTraj: dt is NULL\n')
+      return(NULL)
+    }
+    
+    cat(file = stderr(), 'plotTraj: 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 = calcTrajCI(in.dt = loc.dt, 
+                             in.col.meas = 'y', 
+                             in.col.by = c(in.facet, 'realtime'), 
+                             in.type = 'normal')
+    loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]
+
+    
+    p.out = tca::plotTrajRibbon(dt.arg = loc.dt.aggr, 
+                           x.arg = 'realtime', 
+                           y.arg = 'Mean',
+                           col.arg = loc.facet.col,
+                           group.arg = in.facet,
+                           xlab.arg = 'Time (min)',
+                           ylab.arg = '')
+    
+    # p.out = myGgplotTraj(
+    #   dt.arg = loc.dt,
+    #   x.arg = 'realtime',
+    #   y.arg = 'y',
+    #   group.arg = "id",
+    #   facet.arg = in.facet,
+    #   facet.ncol.arg = input$inPlotTrajFacetNcol,
+    #   facet.color.arg = loc.facet.col,
+    #   xlab.arg = 'Time (min)',
+    #   line.col.arg = loc.line.col.arg,
+    #   aux.label1 = if (locPos) 'pos.x' else NULL,
+    #   aux.label2 = if (locPos) 'pos.y' else NULL,
+    #   aux.label3 = if (locObjNum) 'obj.num' else NULL,
+    #   stat.arg = input$chBPlotTrajStat
+    # )
+    
+    return(p.out)
+  }
+}
\ No newline at end of file