Upgrade to new Gitlab Version 13.9 on Saturday 19th April 20:00. Expect an interruption of about 30 to 60 minutes

trajRibbonPlot.R 6.74 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6 7
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for plotting group averages as ribbon plots (mean + 95%CI)
#

dmattek's avatar
dmattek committed
8 9 10 11 12 13 14 15
require(DT)

modTrajRibbonPlotUI =  function(id, label = "Plot Individual Time Series") {
  ns <- NS(id)
  
  tagList(
    fluidRow(
      column(
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
16
        2,
17
        checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot'),
dmattek's avatar
dmattek committed
18
        radioButtons(ns('rBlegendPos'), 'Legend placement:', list('top' = 'top', 'right' = 'right')),
dmattek's avatar
dmattek committed
19 20 21 22 23 24 25
        actionButton(ns('butPlotTraj'), 'Plot!')
      ),
      column(
        3,
        sliderInput(ns('sliPlotTrajSkip'), 'Plot every n-th point:', min = 1, max = 10, value = 1, step = 1)
      ),
      column(
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
26
        2,
dmattek's avatar
dmattek committed
27 28 29
        numericInput(
          ns('inPlotTrajWidth'),
          'Width [%]:',
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
30
          value = PLOTWIDTH,
dmattek's avatar
dmattek committed
31 32 33 34 35 36 37
          min = 10,
          width = '100px',
          step = 10
        ),
        numericInput(
          ns('inPlotTrajHeight'),
          'Height [px]:',
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
38
          value = PLOTRIBBONHEIGHT,
dmattek's avatar
dmattek committed
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
          min = 100,
          width = '100px',
          step = 50
        )
      )
    ),
    uiOutput(ns('uiPlotTraj')),
    br(),
    modTrackStatsUI(ns('dispTrackStats')),
    
    downPlotUI(ns('downPlotTraj'), "Download PDF")
  )
}


54 55
modTrajRibbonPlot = function(input, output, session, 
                             in.data, 
56
                             in.data.stim,
57 58
                             in.facet = 'group', 
                             in.facet.color = NULL, 
59
                             in.fname) {
dmattek's avatar
dmattek committed
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
  
  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
111 112 113
  callModule(downPlot, "downPlotTraj", 
             in.fname = in.fname, 
             plotTraj, TRUE)
dmattek's avatar
dmattek committed
114 115
  
  plotTraj <- function() {
116
    cat(file = stderr(), 'plotTrajRibbon: in\n')
dmattek's avatar
dmattek committed
117 118 119
    locBut = input$butPlotTraj
    
    if (locBut == 0) {
120
      cat(file = stderr(), 'plotTrajRibbon: Go button not pressed\n')
dmattek's avatar
dmattek committed
121 122 123 124
      
      return(NULL)
    }
    
125
    # check if main data exists
dmattek's avatar
dmattek committed
126 127
    loc.dt = isolate(in.data())
    
128
    cat("plotTrajRibbon: on to plot\n\n")
dmattek's avatar
dmattek committed
129
    if (is.null(loc.dt)) {
130
      cat(file = stderr(), 'plotTrajRibbon: dt is NULL\n')
dmattek's avatar
dmattek committed
131 132 133
      return(NULL)
    }
    
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
    cat(file = stderr(), 'plotTrajRibbon: dt not NULL\n')
    
    
    # check if stim data exists
    loc.dt.stim = isolate(in.data.stim())
    
    if (is.null(loc.dt.stim)) {
      cat(file = stderr(), 'plotTrajRibbon: stim is NULL\n')
    } else {
      cat(file = stderr(), 'plotTrajRibbon: stim not NULL\n')
      
      # choose only 1st group of stimulation pattern for ribbon plot
      
      loc.groups = unique(loc.dt.stim[['group']])
      if(length(loc.groups) > 1) {
        cat(file = stderr(), 'plotTrajRibbon: more than 1 group in stim; choosing 1st\n')
        loc.dt.stim = loc.dt.stim[group == loc.groups[1]]
      }
    }
    
dmattek's avatar
dmattek committed
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201
    
    
    # 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]
    }
    
dmattek's avatar
dmattek committed
202
    loc.dt.aggr = LOCcalcTrajCI(in.dt = loc.dt, 
dmattek's avatar
dmattek committed
203 204 205 206 207 208
                             in.col.meas = 'y', 
                             in.col.by = c(in.facet, 'realtime'), 
                             in.type = 'normal')
    loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]

    
209
    p.out = LOCplotTrajRibbon(dt.arg = loc.dt.aggr, 
dmattek's avatar
dmattek committed
210 211 212 213
                           x.arg = 'realtime', 
                           y.arg = 'Mean',
                           col.arg = loc.facet.col,
                           group.arg = in.facet,
214 215 216
                           dt.stim.arg = loc.dt.stim,
                           x.stim.arg = c('tstart', 'tend'),
                           y.stim.arg = c('ystart', 'yend'),
217
                           xlab.arg = 'Time',
218
                           ylab.arg = '') +
219 220 221 222 223
      LOCggplotTheme(in.font.base = PLOTFONTBASE, 
                     in.font.axis.text = PLOTFONTAXISTEXT, 
                     in.font.axis.title = PLOTFONTAXISTITLE, 
                     in.font.strip = PLOTFONTFACETSTRIP, 
                     in.font.legend = PLOTFONTLEGEND) + 
224
      theme(legend.position = input$rBlegendPos)
dmattek's avatar
dmattek committed
225 226 227 228
    
    return(p.out)
  }
}