tabScatter.R 10.4 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is a tab for plotting scatter plots between two time points
#
dmattek's avatar
dmattek committed
7 8 9 10 11 12 13 14 15 16
# Use:
# in ui.R
# tabPanel(
#  'Hierarchical',
#  clustHierUI('TabClustHier'))
#
# in server.R
# callModule(clustHier, 'TabClustHier', dataMod)
# where dataMod is the output from a reactive function that returns dataset ready for clustering

dmattek's avatar
dmattek committed
17 18 19 20 21 22 23 24 25 26 27
helpText.tabScatter = c(
  alScatter = paste0(
    "Display a relationship between measurements at two different time points as a scatter plot. ",
    "Instead of using the exact measurements at selected time points, you have an option to smooth and use local average of measurements around chosen time points."
  ),
  rBfoldChange = paste0(
    "Y-axis can display a value at a selected time point (the magnitude), ",
    "or a difference between the value at time point selected for Y-axis and the value at time point displayed on the X-axis ",
    "(i.e. the amplitude at the second time point with respect to the value at the first time point)."
  ),
  chBregression = 'Add a line with linear regression and regions of 95% confidence interval.',
dmattek's avatar
dmattek committed
28 29
  inAvgWin = paste0(
    "Length of the averaging window to smooth data before plotting. ",
majpark21's avatar
majpark21 committed
30
    "Useful to avoid artefacts due to spurious variations at specific time points."
dmattek's avatar
dmattek committed
31 32
  ),
  inPlotHeight = 'Height in pixels of the displayed plot',
dmattek's avatar
dmattek committed
33 34 35
  inPlotNcolFacet = 'Number of facets in a row. Each facet displayes a scatter plot for a single group.',
  alert2differentTpts = "Select two different time points.",
  alertSmoothWrong = "Smoothing window smaller than the interval between existing time points."
dmattek's avatar
dmattek committed
36
)
dmattek's avatar
dmattek committed
37

dmattek's avatar
dmattek committed
38
# UI ----
dmattek's avatar
dmattek committed
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
tabScatterPlotUI <-
  function(id, label = "Scatter plot between two time points") {
    ns <- NS(id)
    
    tagList(
      h4("Scatter plot between two time points"),
      actionLink(ns("alScatter"), "Learn more"),
      br(),
      br(),
      fluidRow(
        column(
          4,
          uiOutput(ns('uiSelTptX')),
          uiOutput(ns('uiSelTptY')),
          bsAlert("alertAnchor2differentTpts")
dmattek's avatar
dmattek committed
54
        ),
dmattek's avatar
dmattek committed
55 56 57
        column(
          4,
          numericInput(
dmattek's avatar
dmattek committed
58
            ns('inAvgWin'),
dmattek's avatar
dmattek committed
59 60 61 62 63 64 65
            'Smoothing',
            value = 0,
            step = 1,
            min = 0,
            width = "120px"
          ),
          bsTooltip(
dmattek's avatar
dmattek committed
66 67
            ns('inAvgWin'),
            helpText.tabScatter[["inAvgWin"]],
dmattek's avatar
dmattek committed
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
            placement = "top",
            trigger = "hover",
            options = NULL
          ),
          checkboxInput(ns('chBregression'), 'Linear regression with 95% CI'),
          bsTooltip(
            ns('chBregression'),
            helpText.tabScatter[["chBregression"]],
            placement = "top",
            trigger = "hover",
            options = NULL
          ),
          radioButtons(
            ns('rBfoldChange'),
            'Y-axis',
            choices = c("Y" = "y", "Y - X" = "diff"),
            width = "100px",
            inline = T
          ),
          bsTooltip(
            ns("rBfoldChange"),
            helpText.tabScatter[["rBfoldChange"]],
            placement = "top",
            trigger = "hover",
            options = NULL
          )
dmattek's avatar
dmattek committed
94
        ),
dmattek's avatar
dmattek committed
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
        column(
          4,
          numericInput(
            ns('inPlotHeight'),
            'Height [px]',
            value = PLOTSCATTERHEIGHT,
            min = 100,
            step = 100,
            width = "100px"
          ),
          bsTooltip(
            ns('inPlotHeight'),
            helpText.tabScatter[["inPlotHeight"]],
            placement = "top",
            trigger = "hover",
            options = NULL
          ),
          
          numericInput(
            ns('inPlotNcolFacet'),
            '#columns',
            value = PLOTNFACETDEFAULT,
            min = 1,
            step = 1,
            width = "100px"
          ),
          bsTooltip(
            ns('inPlotNcolFacet'),
            helpText.tabScatter[["inPlotNcolFacet"]],
            placement = "top",
            trigger = "hover",
            options = NULL
          )
        )
      ),
      
      br(),
      checkboxInput(ns('plotInt'),
                    'Interactive Plot',
                    value = FALSE),
135
      actionButton(ns('butPlot'), 'Plot!'),
dmattek's avatar
dmattek committed
136 137
      uiOutput(ns("plotInt_ui")),
      downPlotUI(ns('downPlotScatter'), "Download Plot")
dmattek's avatar
dmattek committed
138 139
    )
  }
dmattek's avatar
dmattek committed
140

dmattek's avatar
dmattek committed
141 142 143 144
# SERVER ----
tabScatterPlot <-
  function(input, output, session, in.data, in.fname) {
    ns <- session$ns
dmattek's avatar
dmattek committed
145
    
dmattek's avatar
dmattek committed
146 147 148 149 150 151 152 153 154 155 156 157 158
    # UI rendering ----
    # return all unique time points (real time)
    # This will be used to display in UI for box-plot
    # These timepoints are from the original dt and aren't affected by trimming of x-axis
    getDataTpts <- reactive({
      cat(file = stderr(), 'getDataTpts\n')
      loc.dt = in.data()
      
      if (is.null(loc.dt))
        return(NULL)
      else
        return(unique(loc.dt[[COLRT]]))
    })
159
    
dmattek's avatar
dmattek committed
160 161 162 163 164 165
    output$uiSelTptX = renderUI({
      cat(file = stderr(), 'tabScatter:uiSelTptX\n')
      
      ns <- session$ns
      
      loc.v = getDataTpts()
dmattek's avatar
dmattek committed
166
      
dmattek's avatar
dmattek committed
167 168 169 170 171 172
      if (!is.null(loc.v)) {
        selectInput(
          ns('inSelTptX'),
          'Time point for X-axis',
          loc.v,
          width = '180px',
dmattek's avatar
dmattek committed
173
          selected = loc.v[[1]],
dmattek's avatar
dmattek committed
174 175 176 177
          multiple = FALSE
        )
      }
    })
178
    
dmattek's avatar
dmattek committed
179 180 181 182 183 184
    output$uiSelTptY = renderUI({
      cat(file = stderr(), 'tabScatter:uiSelTptY\n')
      
      ns <- session$ns
      
      loc.v = getDataTpts()
dmattek's avatar
dmattek committed
185
      
dmattek's avatar
dmattek committed
186 187 188 189 190 191
      if (!is.null(loc.v)) {
        selectInput(
          ns('inSelTptY'),
          'Time point for Y-axis',
          loc.v,
          width = '180px',
dmattek's avatar
dmattek committed
192
          selected = ifelse(length(loc.v) > 1, loc.v[[2]], loc.v[[1]]), 
dmattek's avatar
dmattek committed
193 194 195 196
          multiple = FALSE
        )
      }
    })
197
    
dmattek's avatar
dmattek committed
198 199 200 201
    # prepare a dataset for scatter plot from long format
    # picks y values from two time points as selected in the UI
    # returns a dt with columns x, y, id, and grouping
    # columns x and y containsmeasurments from two points
dmattek's avatar
dmattek committed
202 203 204 205 206 207 208 209
    data4scatterPlot <- reactive({
      cat(file = stderr(), 'data4scatterPlot\n')
      
      loc.dt.in = in.data()
      if (is.null(loc.dt.in))
        return(NULL)
      
      # obtain selected time points from UI
dmattek's avatar
dmattek committed
210 211
      loc.tpt.x = as.numeric(input$inSelTptX)
      loc.tpt.y = as.numeric(input$inSelTptY)
dmattek's avatar
dmattek committed
212
      
dmattek's avatar
dmattek committed
213 214
      # throw an error if both time points for the scatter plot are identical
      if (loc.tpt.x == loc.tpt.y) {
dmattek's avatar
dmattek committed
215 216 217 218 219
        createAlert(
          session,
          "alertAnchor2differentTpts",
          "alert2differentTpts",
          title = "Error",
dmattek's avatar
dmattek committed
220
          content = helpText.tabScatter[["alert2differentTpts"]],
dmattek's avatar
dmattek committed
221 222 223 224 225 226 227 228 229
          append = FALSE,
          style = "danger"
        )
        return(NULL)
        
      } else {
        closeAlert(session, "alert2differentTpts")
      }
      
dmattek's avatar
dmattek committed
230 231 232
      if (input$inAvgWin > 0) {
        # aggregate time points within smoothing window
        loc.winLen = input$inAvgWin
dmattek's avatar
dmattek committed
233 234
      } else {
        # get data from selected time points
dmattek's avatar
dmattek committed
235
        loc.winLen = .Machine$double.eps
dmattek's avatar
dmattek committed
236 237
      }
      
dmattek's avatar
dmattek committed
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
      # x and y separate
      # otherwise, a dcast w.r.t. time column would be required, 
      # which is risky if time is a float
      loc.dt.x = loc.dt.in[(get(COLRT) >= loc.tpt.x - 0.5*loc.winLen) & 
                             (get(COLRT) <= loc.tpt.x + 0.5*loc.winLen), 
                           .(y = mean(get(COLY), na.rm = T)), 
                           by = c(COLGR, COLID)]
      
      loc.dt.y = loc.dt.in[(get(COLRT) >= loc.tpt.y - 0.5*loc.winLen) & 
                             (get(COLRT) <= loc.tpt.y + 0.5*loc.winLen), 
                           .(y = mean(get(COLY), na.rm = T)), 
                           by = c(COLGR, COLID)]        
      
      
      # merge measurements from two time points
      loc.dt = merge(loc.dt.x, loc.dt.y, by = COLID)
      loc.dt[, (paste0(COLGR, ".y")) := NULL]
      
      # setting new names; columns with measurements from two time points 
      # are assigned x & y names, respectively (only for internal usage in this module)
      setnames(loc.dt,
               c(paste0(COLGR, '.x'), paste0(COLY, '.x'), paste0(COLY, '.y')),
               c(COLGR, 'x', 'y'))
dmattek's avatar
dmattek committed
261 262
      
      
dmattek's avatar
dmattek committed
263
      # calculating the fold change between two time points to display on the y axis
dmattek's avatar
dmattek committed
264 265 266 267 268 269
      if (input$rBfoldChange == "diff") {
        loc.dt[, y := y - x]
      }
      return(loc.dt)
      
    })
dmattek's avatar
dmattek committed
270
    
dmattek's avatar
dmattek committed
271
    
dmattek's avatar
dmattek committed
272 273 274 275 276 277 278
    # Plotting ----
    # Function instead of reactive as per:
    # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
    # This function is used to plot and to downoad a pdf
    
    plotScatter <- function() {
      cat(file = stderr(), "plotScatter\n")
279
      locBut = input$butPlot
dmattek's avatar
dmattek committed
280
      
281 282 283
      # Check if main data exists
      # Thanks to solate all mods in the left panel are delayed 
      # until clicking the Plot button
dmattek's avatar
dmattek committed
284
      loc.dt = isolate(data4scatterPlot())
285 286 287
      validate(
        need(!is.null(loc.dt), "Nothing to plot. Load data first!")
      )    
dmattek's avatar
dmattek committed
288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
      
      cat(file = stderr(), 'plotScatter:dt not NULL\n')
      
      p.out = LOCggplotScat(
        dt.arg = loc.dt,
        plotlab.arg = NULL,
        facet.arg = COLGR,
        facet.ncol.arg = input$inPlotNcolFacet,
        alpha.arg = 0.5,
        trend.arg = input$chBregression,
        ci.arg = 0.95
      )
      return(p.out)
    }
    
    # Plot rendering ----
    output$outPlotScatter <- renderPlot({
      plotScatter()
    })
    
    output$outPlotScatterInt <- 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)
      
      return(plotly_build(plotScatter()))
      
    })
    
    # download pdf
    callModule(downPlot, "downPlotScatter", in.fname, plotScatter, TRUE)
    
    # Scatter plot - choose to display regular or interactive plot
    output$plotInt_ui <- renderUI({
      ns <- session$ns
      if (input$plotInt)
        tagList(withSpinner(plotlyOutput(
          ns("outPlotScatterInt"),
          height = paste0(input$inPlotHeight, "px")
        )))
      else
        tagList(withSpinner(plotOutput(
          ns('outPlotScatter'), height = paste0(input$inPlotHeight, "px")
        )))
    })
    
    # Pop-overs ----
    addPopover(
      session,
      id = ns("alScatter"),
      title = "Scatter plot",
      content = helpText.tabScatter[["alScatter"]],
      trigger = "click"
    )
  }