trajRibbonPlot.R 6.57 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6 7 8 9 10
require(DT)

modTrajRibbonPlotUI =  function(id, label = "Plot Individual Time Series") {
  ns <- NS(id)
  
  tagList(
    fluidRow(
      column(
        3,
        checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot?'),
dmattek's avatar
dmattek committed
11
        radioButtons(ns('rBlegendPos'), 'Legend placement:', list('top' = 'top', 'right' = 'right')),
dmattek's avatar
dmattek committed
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
        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")
  )
}


48 49
modTrajRibbonPlot = function(input, output, session, 
                             in.data, 
50
                             in.data.stim,
51 52
                             in.facet = 'group', 
                             in.facet.color = NULL, 
53
                             in.fname) {
dmattek's avatar
dmattek committed
54 55 56 57 58 59 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
  
  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
105 106 107
  callModule(downPlot, "downPlotTraj", 
             in.fname = in.fname, 
             plotTraj, TRUE)
dmattek's avatar
dmattek committed
108 109
  
  plotTraj <- function() {
110
    cat(file = stderr(), 'plotTrajRibbon: in\n')
dmattek's avatar
dmattek committed
111 112 113
    locBut = input$butPlotTraj
    
    if (locBut == 0) {
114
      cat(file = stderr(), 'plotTrajRibbon: Go button not pressed\n')
dmattek's avatar
dmattek committed
115 116 117 118
      
      return(NULL)
    }
    
119
    # check if main data exists
dmattek's avatar
dmattek committed
120 121
    loc.dt = isolate(in.data())
    
122
    cat("plotTrajRibbon: on to plot\n\n")
dmattek's avatar
dmattek committed
123
    if (is.null(loc.dt)) {
124
      cat(file = stderr(), 'plotTrajRibbon: dt is NULL\n')
dmattek's avatar
dmattek committed
125 126 127
      return(NULL)
    }
    
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
    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
148 149 150 151 152 153 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
    
    
    # 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
196
    loc.dt.aggr = LOCcalcTrajCI(in.dt = loc.dt, 
dmattek's avatar
dmattek committed
197 198 199 200 201 202
                             in.col.meas = 'y', 
                             in.col.by = c(in.facet, 'realtime'), 
                             in.type = 'normal')
    loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]

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