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.35 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6 7 8 9 10 11
require(DT)
require(tca)

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
12
        radioButtons(ns('rBlegendPos'), 'Legend placement:', list('top' = 'top', 'right' = 'right')),
dmattek's avatar
dmattek committed
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 48
        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")
  )
}


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

    
204
    p.out = LOCplotTrajRibbon(dt.arg = loc.dt.aggr, 
dmattek's avatar
dmattek committed
205 206 207 208
                           x.arg = 'realtime', 
                           y.arg = 'Mean',
                           col.arg = loc.facet.col,
                           group.arg = in.facet,
209 210 211
                           dt.stim.arg = loc.dt.stim,
                           x.stim.arg = c('tstart', 'tend'),
                           y.stim.arg = c('ystart', 'yend'),
dmattek's avatar
dmattek committed
212
                           xlab.arg = 'Time (min)',
213 214
                           ylab.arg = '') +
      ggplotTheme() +
215
      #myGgplotTheme +
216
      theme(legend.position = input$rBlegendPos)
dmattek's avatar
dmattek committed
217 218 219 220
    
    return(p.out)
  }
}