trajPlot.R 8.89 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
dmattek's avatar
dmattek committed
5
# This module is for plotting individual time series
dmattek's avatar
dmattek committed
6 7 8 9 10
#


# UI ----

dmattek's avatar
Mod:  
dmattek committed
11 12 13 14 15 16
modTrajPlotUI =  function(id, label = "Plot Individual Time Series") {
  ns <- NS(id)
  
  tagList(
    fluidRow(
      column(
dmattek's avatar
dmattek committed
17
        3,
dmattek's avatar
Mod:  
dmattek committed
18 19
        numericInput(
          ns('inPlotTrajFacetNcol'),
dmattek's avatar
dmattek committed
20
          '#columns',
21
          value = PLOTNFACETDEFAULT,
dmattek's avatar
Mod:  
dmattek committed
22
          min = 1,
dmattek's avatar
dmattek committed
23
          width = '100px',
dmattek's avatar
Mod:  
dmattek committed
24 25
          step = 1
        ),
26
        checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot'),
dmattek's avatar
Mod:  
dmattek committed
27 28 29
        actionButton(ns('butPlotTraj'), 'Plot!')
      ),
      column(
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
30
        2,
dmattek's avatar
dmattek committed
31
        checkboxGroupInput(ns('chBPlotTrajStat'), 'Add', list('Mean' = 'mean', 
dmattek's avatar
dmattek committed
32 33
                                                                   '95% conf. interv.' = 'CI', 
                                                                   'Std. error' = 'SE'))
dmattek's avatar
Mod:  
dmattek committed
34 35 36
      ),
      column(
        3,
dmattek's avatar
dmattek committed
37
        sliderInput(ns('sliPlotTrajSkip'), 'Plot every n-th point', 
dmattek's avatar
dmattek committed
38
                    min = 1, max = 10, value = 1, step = 1),
39
        
dmattek's avatar
dmattek committed
40
        checkboxInput(ns('chBsetXbounds'), 'Bounds for X', FALSE),
41 42
        fluidRow(
          column(6,
dmattek's avatar
dmattek committed
43
                 uiOutput(ns('uiSetXboundsLow'))
44 45
          ),
          column(6,
dmattek's avatar
dmattek committed
46 47 48
                 uiOutput(ns('uiSetXboundsHigh'))
          )),
        
dmattek's avatar
dmattek committed
49
        checkboxInput(ns('chBsetYbounds'), 'Bounds for Y', FALSE),
dmattek's avatar
dmattek committed
50 51 52 53 54 55 56 57
        fluidRow(
          column(6,
                 uiOutput(ns('uiSetYboundsLow'))
          ),
          column(6,
                 uiOutput(ns('uiSetYboundsHigh'))
          ))
        
58
        
dmattek's avatar
Mod:  
dmattek committed
59 60
      ),
      column(
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
61
        2,
dmattek's avatar
Mod:  
dmattek committed
62 63
        numericInput(
          ns('inPlotTrajWidth'),
dmattek's avatar
dmattek committed
64
          'Width [%]',
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
65
          value = PLOTWIDTH,
dmattek's avatar
Mod:  
dmattek committed
66 67 68 69 70 71
          min = 10,
          width = '100px',
          step = 10
        ),
        numericInput(
          ns('inPlotTrajHeight'),
dmattek's avatar
dmattek committed
72
          'Height [px]',
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
73
          value = PLOTTRAJHEIGHT,
dmattek's avatar
Mod:  
dmattek committed
74 75 76 77 78 79
          min = 100,
          width = '100px',
        )
      )
    ),
    uiOutput(ns('uiPlotTraj')),
dmattek's avatar
dmattek committed
80 81
    br(),
    modTrackStatsUI(ns('dispTrackStats')),
82
    br(),
dmattek's avatar
dmattek committed
83
    downPlotUI(ns('downPlotTraj'), "Download Plot")
dmattek's avatar
Mod:  
dmattek committed
84 85 86
  )
}

dmattek's avatar
dmattek committed
87
# Server ----
88 89
modTrajPlot = function(input, output, session, 
                       in.data, 
90
                       in.data.stim,
91
                       in.fname,
dmattek's avatar
dmattek committed
92
                       in.facet = COLGR, 
dmattek's avatar
dmattek committed
93 94
                       in.facet.color = NULL,
                       in.ylab = NULL) {
dmattek's avatar
Mod:  
dmattek committed
95 96 97 98 99
  
  ns <- session$ns
  
  output$uiPlotTraj = renderUI({
    if (input$chBplotTrajInt)
dmattek's avatar
dmattek committed
100
      withSpinner(plotlyOutput(
dmattek's avatar
Mod:  
dmattek committed
101 102
        ns("outPlotTrajInt"),
        width = paste0(input$inPlotTrajWidth, '%'),
dmattek's avatar
dmattek committed
103
        height = paste0(input$inPlotTrajHeight, 'px'))
dmattek's avatar
Mod:  
dmattek committed
104
      ) else
dmattek's avatar
dmattek committed
105
        withSpinner(plotOutput(
dmattek's avatar
Mod:  
dmattek committed
106 107
          ns("outPlotTraj"),
          width = paste0(input$inPlotTrajWidth, '%'),
dmattek's avatar
dmattek committed
108
          height = paste0(input$inPlotTrajHeight, 'px'))
dmattek's avatar
Mod:  
dmattek committed
109 110 111
        )
  })
  
dmattek's avatar
dmattek committed
112 113
  # UI for bounding the x-axis ====
  output$uiSetXboundsLow = renderUI({
114 115
    ns <- session$ns
    
dmattek's avatar
dmattek committed
116
    if(input$chBsetXbounds) {
117 118 119
      
      loc.dt = in.data()
      
dmattek's avatar
dmattek committed
120 121 122 123 124
      if (is.null(loc.dt)) {
        cat(file = stderr(), 'uiSetXboundsLow: dt is NULL\n')
        return(NULL)
      }
      
125
      numericInput(
dmattek's avatar
dmattek committed
126
        ns('inSetXboundsLow'),
127 128
        label = 'Lower',
        step = 0.1, 
dmattek's avatar
dmattek committed
129
        value = floor(min(loc.dt[[COLRT]], na.rm = T))
130 131 132 133 134
      )
    }
  })
  
  
dmattek's avatar
dmattek committed
135
  output$uiSetXboundsHigh = renderUI({
136 137
    ns <- session$ns
    
dmattek's avatar
dmattek committed
138
    if(input$chBsetXbounds) {
139 140 141
      
      loc.dt = in.data()
      
dmattek's avatar
dmattek committed
142 143 144 145 146
      if (is.null(loc.dt)) {
        cat(file = stderr(), 'uiSetXboundsHigh: dt is NULL\n')
        return(NULL)
      }
      
147
      numericInput(
dmattek's avatar
dmattek committed
148
        ns('inSetXboundsHigh'),
149 150
        label = 'Upper',
        step = 0.1, 
dmattek's avatar
dmattek committed
151
        value = ceil(max(loc.dt[[COLRT]], na.rm = T))
152 153 154
      )
    }
  })
dmattek's avatar
dmattek committed
155 156 157 158 159
  
  
  # UI for bounding the y-axis ====
  output$uiSetYboundsLow = renderUI({
    ns <- session$ns
160
    
dmattek's avatar
dmattek committed
161 162 163
    if(input$chBsetYbounds) {
      
      loc.dt = in.data()
164
      
dmattek's avatar
dmattek committed
165 166 167 168 169
      if (is.null(loc.dt)) {
        cat(file = stderr(), 'uiSetYboundsLow: dt is NULL\n')
        return(NULL)
      }
      
dmattek's avatar
dmattek committed
170 171 172 173
      numericInput(
        ns('inSetYboundsLow'),
        label = 'Lower',
        step = 0.1, 
dmattek's avatar
dmattek committed
174
        value = min(loc.dt[[COLY]], na.rm = T)
dmattek's avatar
dmattek committed
175 176
      )
    }
177 178 179
  })
  
  
dmattek's avatar
dmattek committed
180 181 182 183 184 185 186
  output$uiSetYboundsHigh = renderUI({
    ns <- session$ns
    
    if(input$chBsetYbounds) {
      
      loc.dt = in.data()
      
dmattek's avatar
dmattek committed
187 188 189 190 191
      if (is.null(loc.dt)) {
        cat(file = stderr(), 'uiSetYboundsHigh: dt is NULL\n')
        return(NULL)
      }
      
dmattek's avatar
dmattek committed
192 193 194 195
      numericInput(
        ns('inSetYboundsHigh'),
        label = 'Upper',
        step = 0.1, 
dmattek's avatar
dmattek committed
196
        value = max(loc.dt[[COLY]], na.rm = T)
dmattek's avatar
dmattek committed
197 198 199 200 201
      )
    }
  })
  
  # Plotting ====
202
  
dmattek's avatar
dmattek committed
203
  callModule(modTrackStats, 'dispTrackStats',
dmattek's avatar
dmattek committed
204 205
             in.data = in.data,
             in.bycols = in.facet)
dmattek's avatar
dmattek committed
206 207
  
  
dmattek's avatar
Mod:  
dmattek committed
208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
  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)
    
231
    return(ggplotly(loc.p))
dmattek's avatar
Mod:  
dmattek committed
232 233 234 235 236 237 238
  })
  
  
  
  # Trajectory plot - download pdf
  callModule(downPlot, "downPlotTraj", in.fname, plotTraj, TRUE)
  
dmattek's avatar
dmattek committed
239
  
dmattek's avatar
Mod:  
dmattek committed
240 241 242
  plotTraj <- function() {
    cat(file = stderr(), 'plotTraj: in\n')
    
243 244
    # make the f-n dependent on the button click
    locBut = input$butPlotTraj
dmattek's avatar
Mod:  
dmattek committed
245
    
246 247 248
    # Check if main data exists
    # Thanks to solate all mods in the left panel are delayed 
    # until clicking the Plot button
dmattek's avatar
Mod:  
dmattek committed
249
    loc.dt = isolate(in.data())
250 251 252
    validate(
      need(!is.null(loc.dt), "Nothing to plot. Load data first!")
    )
dmattek's avatar
Mod:  
dmattek committed
253 254
    
    cat(file = stderr(), 'plotTraj: dt not NULL\n')
dmattek's avatar
dmattek committed
255
    
256 257
    # check if stim data exists
    loc.dt.stim = isolate(in.data.stim())
dmattek's avatar
dmattek committed
258
    
259 260 261 262 263
    if (is.null(loc.dt.stim)) {
      cat(file = stderr(), 'plotTraj: dt.stim is NULL\n')
    } else {
      cat(file = stderr(), 'plotTraj: dt.stim not NULL\n')
    }
dmattek's avatar
dmattek committed
264
    
dmattek's avatar
Mod:  
dmattek committed
265
    # Future: change such that a column with colouring status is chosen by the user
266
    # colour trajectories, if dataset contains mid.in column
dmattek's avatar
Mod:  
dmattek committed
267 268 269 270 271 272 273 274 275 276 277 278 279 280 281
    # 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
    
282 283 284 285 286 287 288 289
    # check if column with ObjectNumber is present
    if (sum(names(loc.dt) %like% 'obj.num') == 1)
      locObjNum = TRUE
    else
      locObjNum = FALSE
    
    
    
dmattek's avatar
Fixed:  
dmattek committed
290 291 292 293 294 295 296 297 298 299 300 301 302
    # 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]])
dmattek's avatar
dmattek committed
303
      
dmattek's avatar
Fixed:  
dmattek committed
304 305 306 307 308 309
      # 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
310 311 312 313 314 315
    
    
    loc.xlim.arg = NULL
    if(input$chBsetXbounds) {
      loc.xlim.arg = c(input$inSetXboundsLow, input$inSetXboundsHigh)
    } 
dmattek's avatar
Fixed:  
dmattek committed
316
    
dmattek's avatar
dmattek committed
317 318 319 320 321
    loc.ylim.arg = NULL
    if(input$chBsetYbounds) {
      loc.ylim.arg = c(input$inSetYboundsLow, input$inSetYboundsHigh)
    } 
    
322
    p.out = LOCplotTraj(
dmattek's avatar
Mod:  
dmattek committed
323
      dt.arg = loc.dt,
dmattek's avatar
dmattek committed
324 325 326
      x.arg = COLRT,
      y.arg = COLY,
      group.arg = COLID,
dmattek's avatar
Mod:  
dmattek committed
327 328
      facet.arg = in.facet,
      facet.ncol.arg = input$inPlotTrajFacetNcol,
329 330 331
      facet.color.arg = loc.facet.col, 
      dt.stim.arg = loc.dt.stim, 
      x.stim.arg = c('tstart', 'tend'),
dmattek's avatar
dmattek committed
332 333
      y.stim.arg = c('ystart', 'yend'), 
      stim.bar.width.arg = 1,
334
      xlab.arg = 'Time',
dmattek's avatar
Mod:  
dmattek committed
335
      line.col.arg = loc.line.col.arg,
dmattek's avatar
dmattek committed
336 337 338
      aux.label1 = if (locPos) COLPOSX else NULL,
      aux.label2 = if (locPos) COLPOSY else NULL,
      aux.label3 = if (locObjNum) COLOBJN else NULL,
339
      stat.arg = input$chBPlotTrajStat,
dmattek's avatar
dmattek committed
340 341
      ylim.arg = loc.ylim.arg,
      xlim.arg = loc.xlim.arg
dmattek's avatar
Mod:  
dmattek committed
342 343 344 345 346
    )
    
    return(p.out)
  }
}