aucPlot.R 6.75 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 AUC as a choice of box/violin/dot-plots
dmattek's avatar
dmattek committed
6 7 8 9 10 11
# Assumes in.data contains columns:
# realtime
# y
# group
# id

dmattek's avatar
dmattek committed
12
# UI ----
dmattek's avatar
dmattek committed
13
modAUCplotUI =  function(id, label = "Plot AUC distributions") {
dmattek's avatar
dmattek committed
14 15 16 17 18 19
  ns <- NS(id)
  
  tagList(
    fluidRow(
      column(
        4,
dmattek's avatar
dmattek committed
20 21 22 23 24 25 26 27 28 29 30 31
        checkboxInput(ns("chBPlotTypeBox"),  "Box-plot", value = T),
        checkboxInput(ns("chBPlotTypeDot"),  "Dot-plot", value = F),
        checkboxInput(ns("chBPlotTypeViol"), "Violin-plot", value = F),
        checkboxInput(ns('chBPlotInt'), 'Interactive Plot'),
        actionButton(ns('butPlot'), 'Plot!')
      ),
      column(
        4,
        uiOutput(ns('uiPlotBoxNotches')),
        uiOutput(ns('uiPlotBoxOutliers')),
        uiOutput(ns('uiPlotDotNbins')),
        uiOutput(ns('uiPlotDotShade'))
dmattek's avatar
dmattek committed
32 33 34
      ),
      column(
        4,
dmattek's avatar
dmattek committed
35 36 37 38
        radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels",
                     c("horizontal" = 0,
                       "45 deg" = 45,
                       "90 deg" = 90)),
dmattek's avatar
dmattek committed
39 40
        numericInput(
          ns('inPlotBoxWidth'),
dmattek's avatar
dmattek committed
41
          'Width [%]',
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
42
          value = PLOTWIDTH,
dmattek's avatar
dmattek committed
43 44 45 46 47 48
          min = 10,
          width = '100px',
          step = 10
        ),
        numericInput(
          ns('inPlotBoxHeight'),
dmattek's avatar
dmattek committed
49
          'Height [px]',
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
50
          value = PLOTBOXHEIGHT,
dmattek's avatar
dmattek committed
51 52 53
          min = 100,
          width = '100px',
          step = 50
dmattek's avatar
dmattek committed
54
        )
dmattek's avatar
dmattek committed
55 56 57 58
      )
    ),
    
    uiOutput(ns('uiPlotBox')),
dmattek's avatar
dmattek committed
59
    downPlotUI(ns('downPlotBox'), "Download Plot")
dmattek's avatar
dmattek committed
60 61 62
  )
}

dmattek's avatar
dmattek committed
63
# SERVER ----
dmattek's avatar
dmattek committed
64 65 66
modAUCplot = function(input, output, session, 
                      in.data,                       # input data table in long format
                      in.cols = list(meas.x = COLRT, # column names
dmattek's avatar
dmattek committed
67 68 69
                                     meas.y = COLY,
                                     group = COLGR,
                                     id = COLID), 
dmattek's avatar
dmattek committed
70 71 72 73
                      in.labels = list(x = "",       # plot labels
                                       y = "", 
                                       legend = ""),
                      in.fname) {                      # file name for saving the plot                 
dmattek's avatar
dmattek committed
74 75
  
  ns <- session$ns
dmattek's avatar
dmattek committed
76 77
  
  # optional UI depending on the type of the plot chosen
dmattek's avatar
dmattek committed
78
  output$uiPlotBoxNotches = renderUI({
dmattek's avatar
dmattek committed
79
    cat(file = stderr(), 'aucPlot:uiPlotBoxNotches\n')
dmattek's avatar
dmattek committed
80 81 82
    
    ns <- session$ns
    
dmattek's avatar
dmattek committed
83 84
    if(input$chBPlotTypeBox)
      checkboxInput(ns('chBplotBoxNotches'), 'Notches in box-plot', FALSE)
dmattek's avatar
dmattek committed
85 86 87
  })
  
  output$uiPlotBoxOutliers = renderUI({
dmattek's avatar
dmattek committed
88
    cat(file = stderr(), 'aucPlot:uiPlotBoxNotches\n')
dmattek's avatar
dmattek committed
89 90 91
    
    ns <- session$ns
    
dmattek's avatar
dmattek committed
92 93
    if(input$chBPlotTypeBox)
      checkboxInput(ns('chBplotBoxOutliers'), 'Outliers in box-plot', FALSE)
dmattek's avatar
dmattek committed
94 95 96
  })
  
  
dmattek's avatar
dmattek committed
97 98
  output$uiPlotDotShade = renderUI({
    cat(file = stderr(), 'aucPlot:uiPlotDotShade\n')
dmattek's avatar
dmattek committed
99 100 101
    
    ns <- session$ns
    
dmattek's avatar
dmattek committed
102 103
    if(input$chBPlotTypeDot)
      sliderInput(ns('slPlotDotShade'), "Shade of grey in dot-plot", min = 0, max = 1, value = 0.5, step = 0.1)
dmattek's avatar
dmattek committed
104 105 106
  })
  
  output$uiPlotDotNbins = renderUI({
dmattek's avatar
dmattek committed
107
    cat(file = stderr(), 'aucPlot:uiPlotDotNbins\n')
dmattek's avatar
dmattek committed
108 109 110
    
    ns <- session$ns
    
dmattek's avatar
dmattek committed
111 112
    if(input$chBPlotTypeDot)
      sliderInput(ns('slPlotDotNbins'), 'Number of bins in dot-plot', min = 2, max = 50, value = 30, step = 1)
dmattek's avatar
dmattek committed
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
  })
  
  # Boxplot - display
  output$outPlotBox = renderPlot({
    
    plotBox()
    
  })
  
  
  output$outPlotBoxInt = 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( ggplotly(plotBox())  %>% layout(boxmode = 'group', width = '100%', height = '100%'))
    
  })
  
  
  output$uiPlotBox <- renderUI({
    ns <- session$ns
    
dmattek's avatar
dmattek committed
140
    if (input$chBPlotInt)
dmattek's avatar
dmattek committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
      plotlyOutput(ns("outPlotBoxInt"), 
                   width = paste0(input$inPlotBoxWidth, '%'),
                   height = paste0(input$inPlotBoxHeight, 'px'))
    else
      plotOutput(ns('outPlotBox'),
                 width = paste0(input$inPlotBoxWidth, '%'),
                 height = paste0(input$inPlotBoxHeight, 'px'))
  })
  
  # Boxplot - download pdf
  callModule(downPlot, "downPlotBox", in.fname, plotBox, TRUE)
  
  # 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
  
  plotBox <- function() {
dmattek's avatar
dmattek committed
158
    cat(file = stderr(), 'aucPlot:plotBox\n')
dmattek's avatar
dmattek committed
159
    
160 161
    # make the f-n dependent on the button click
    locBut = input$butPlot
dmattek's avatar
dmattek committed
162
    
163 164 165 166 167 168 169
    # Check if main data exists
    # Thanks to solate all mods in the left panel are delayed 
    # until clicking the Plot button
    loc.dt = isolate(in.data())
    validate(
      need(!is.null(loc.dt), "Nothing to plot. Load data first!")
    )    
dmattek's avatar
dmattek committed
170 171 172
    
    cat(file = stderr(), 'plotBox:dt not NULL\n')
    
dmattek's avatar
dmattek committed
173 174
    p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x), 
                                      y = in.cols$meas.y)) 
dmattek's avatar
dmattek committed
175
    
dmattek's avatar
dmattek committed
176 177 178 179 180 181 182 183 184
    
    if(input$chBPlotTypeDot) {
      # calculate bin width for dot-plot based on nBins provided in the UI
      loc.binwidth = abs(max(loc.dt[[ in.cols$meas.y ]], 
                             na.rm = T) - 
                           min(loc.dt[[ in.cols$meas.y ]], 
                               na.rm = T)) / (input$slPlotDotNbins - 1)
      
      p.out = p.out + geom_dotplot(fill = grey(input$slPlotDotShade),
dmattek's avatar
dmattek committed
185
                                   color = NA,
dmattek's avatar
dmattek committed
186
                                   binaxis = "y", 
dmattek's avatar
dmattek committed
187
                                   stackdir = "center", 
dmattek's avatar
dmattek committed
188
                                   binwidth = loc.binwidth, 
dmattek's avatar
dmattek committed
189
                                   method = 'histodot')
dmattek's avatar
dmattek committed
190 191
      
    }
dmattek's avatar
dmattek committed
192
    
dmattek's avatar
dmattek committed
193
    if(input$chBPlotTypeViol)
dmattek's avatar
dmattek committed
194
      p.out = p.out + 
dmattek's avatar
dmattek committed
195 196 197
      geom_violin(fill = NA,
                  color = "black",
                  width = 0.2)
dmattek's avatar
dmattek committed
198
    
dmattek's avatar
dmattek committed
199
    if (input$chBPlotTypeBox)
dmattek's avatar
dmattek committed
200
      p.out = p.out + geom_boxplot(
dmattek's avatar
dmattek committed
201 202 203 204
        fill = NA,
        color = "black",
        notch = input$chBplotBoxNotches, 
        outlier.colour = if (input$chBplotBoxOutliers)
dmattek's avatar
dmattek committed
205 206 207 208 209 210
          'red'
        else
          NA
      ) 
    
    p.out = p.out +
dmattek's avatar
dmattek committed
211 212 213
      scale_fill_discrete(name = in.labels$legend) +
      xlab(in.labels$x) +
      ylab(in.labels$y) +
214 215 216 217 218
      LOCggplotTheme(in.font.base = PLOTFONTBASE, 
                     in.font.axis.text = PLOTFONTAXISTEXT, 
                     in.font.axis.title = PLOTFONTAXISTITLE, 
                     in.font.strip = PLOTFONTFACETSTRIP, 
                     in.font.legend = PLOTFONTLEGEND) + 
dmattek's avatar
dmattek committed
219
      theme(axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate), 
220
                                                    size = PLOTFONTAXISTEXT))
dmattek's avatar
dmattek committed
221
    
dmattek's avatar
dmattek committed
222 223 224 225 226
    
    return(p.out)
  }
  
}