server.R 10.5 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#

library(shiny)
library(shinyjs) #http://deanattali.com/shinyjs/
library(data.table)
library(ggplot2)
library(plotly)

options(shiny.maxRequestSize=30*1024^2)
source('auxfunc.R')

dmattek's avatar
dmattek committed
17
shinyServer(function(input, output, session) {
dmattek's avatar
dmattek committed
18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
  
  butCounter <- reactiveValues(
    dataLoadNuc  = isolate(ifelse(is.null(input$inFileNucLoad), 0, 1)), 
    dataLoadStim = isolate(ifelse(is.null(input$inFileStimLoad), 0, 1)), 
    dataGen  = isolate(input$butDataGen)
  )
  
  getDataNucCols <- reactive({
    cat(file=stderr(), 'getDataNucCols: in\n')
    
    return(colnames(dataInBoth()))
  })
  
  output$varSelSite = renderUI({
    cat(file=stderr(), 'UI varSelSite\n')
    locCols = getDataNucCols()
    locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st

    cat(locColSel, '\n')
dmattek's avatar
dmattek committed
37
    selectInput('inSelSite', 'Select FOV (e.g. Metadata_Site or Metadata_Series):', locCols, width = '100%', selected = locColSel)
dmattek's avatar
dmattek committed
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
  })
  
  output$varSelTrackLabel = renderUI({
    cat(file=stderr(), 'UI varSelTrackLabel\n')
    locCols = getDataNucCols()
    locColSel = locCols[locCols %like% 'rack'][1] # index 1 at the end in case more matches; select 1st
    
    cat(locColSel, '\n')
    selectInput('inSelTrackLabel', 'Select Track Label (e.g. objNuc_Track_ObjectsLabel):', locCols, width = '100%', selected = locColSel)
  })
  
  output$varSelTime = renderUI({
    cat(file=stderr(), 'UI varSelTime\n')
    locCols = getDataNucCols()
    locColSel = locCols[locCols %like% 'ime'][1] # index 1 at the end in case more matches; select 1st
    
    cat(locColSel, '\n')
dmattek's avatar
dmattek committed
55
    selectInput('inSelTime', 'Select X (e.g. RealTime):', locCols, width = '100%', selected = locColSel)
dmattek's avatar
dmattek committed
56 57
  })

dmattek's avatar
dmattek committed
58 59 60 61 62 63
  # This is main field to select plot facet grouping
  # It's typically a column with the entire experimental description,
  # e.g. in Yannick's case it's Stim_All_Ch or Stim_All_S.
  # In Coralie's case it's a combination of 3 columns called Stimulation_...
  output$varSelGroup = renderUI({
    cat(file=stderr(), 'UI varSelGroup\n')
dmattek's avatar
dmattek committed
64
    locCols = getDataNucCols()
dmattek's avatar
dmattek committed
65 66 67 68 69 70
    locColSel = locCols[locCols %like% 'timulation']
    if (length(locColSel) == 0)
      locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
    else if (length(locColSel) > 1) {
      locColSel = locColSel[1]      
    }
dmattek's avatar
dmattek committed
71
    
dmattek's avatar
dmattek committed
72 73
#    cat('UI varSelGroup::locColSel ', locColSel, '\n')
    selectInput('inSelGroup', 'Select Grouping for Plotting (e.g. Site, Well, Channel):', locCols, width = '100%', selected = locColSel)
dmattek's avatar
dmattek committed
74 75
  })

dmattek's avatar
dmattek committed
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 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
  output$varSelGroup2 = renderUI({
    cat(file=stderr(), 'UI varSelGroup2\n')
    locCols = getDataNucCols()
    locColSel = locCols[locCols %like% 'timulation']
    if (length(locColSel) == 0)
      locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
    else if (length(locColSel) > 1) {
#      updateCheckboxInput(session, 'inGroupMore1', value = 1)
      locColSel = locColSel[2]      
    }
    
#    cat('UI varSelGroup2::locColSel ', locColSel, '\n')
    

    if(input$inGroupMore1) {
      selectInput('inSelGroup2', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel)
    } else {
      disabled(selectInput('inSelGroup2', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel))
    }
  })
  
  output$varSelGroup3 = renderUI({
    cat(file=stderr(), 'UI varSelGroup2\n')
    locCols = getDataNucCols()
    locColSel = locCols[locCols %like% 'timulation']
    if (length(locColSel) == 0)
      locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
    else if (length(locColSel) > 1) {
 #     updateCheckboxInput(session, 'inGroupMore2', value = 1)
      locColSel = locColSel[3]      
    }
    
#    cat('UI varSelGroup3::locColSel ', locColSel, '\n')
    
    
    if(input$inGroupMore2) {
      selectInput('inSelGroup3', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel)
    } else {
      disabled(selectInput('inSelGroup3', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel))
    }
  })
  
  output$varSelMeas1 = renderUI({
    cat(file=stderr(), 'UI varSelMeas1\n')
    locCols = getDataNucCols()
    locColSel = locCols[locCols %like% 'Intensity'][1] # index 1 at the end in case more matches; select 1st
    
#    cat(locColSel, '\n')
    selectInput('inSelMeas1', 'Select Y:', locCols, width = '100%', selected = locColSel)
dmattek's avatar
dmattek committed
125 126
  })

dmattek's avatar
dmattek committed
127

dmattek's avatar
dmattek committed
128 129 130 131 132
  output$varSelMeas2 = renderUI({
    cat(file=stderr(), 'UI varSelMeas2\n')
    locCols = getDataNucCols()
    locColSel = locCols[locCols %like% 'Intensity'][1] # index 1 at the end in case more matches; select 1st
    
dmattek's avatar
dmattek committed
133 134
#    cat(locColSel, '\n')
    selectInput('inSelMeas2', 'Select 2nd operand:', locCols, width = '100%', selected = locColSel)
dmattek's avatar
dmattek committed
135 136 137 138 139 140 141 142 143 144 145 146 147 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
  })
  
  output$outPlot = renderUI({
    
    plotlyOutput("trajPlot", width = paste0(input$inPlotWidth, '%'), height = paste0(input$inPlotHeight, 'px'))
  })
  
  userDataNuc <- eventReactive(input$inFileNucLoad, {
    cat(file=stderr(), 'userDataNuc: in\n')
    
    infile = input$inFileNucLoad
    
    dt = fread(infile$datapath)
    
    cat(file=stderr(), 'userDataNuc: out\n')
    return(dt)
  })
  
  userDataNucMod = reactive({
    # make unique cell identifier based on metadata.site
    cat(file=stderr(), 'userDataNucMod: in\n')
    
    dt = dataInBoth()
    colNameSite  = input$inSelSite
    colNameTrackLabel = input$inSelTrackLabel
    
    if (colNameSite == '' && colNameTrackLabel == '') {
      cat(file=stderr(), 'userDataNucMod: no colName\n')
      return(NULL)
    }
    
    dt[, trackObjectsLabelUni := paste(sprintf("%04d", get(colNameSite)),
                                       sprintf("%04d", get(colNameTrackLabel)),
                                       sep = "_")]

    loc.colnames = colnames(dt)
    
    cat(file=stderr(), 'userDataNucMod: out\n')
    return(dt)
  })
  
  userDataStim <- eventReactive(input$inFileStimLoad, {
    cat(file=stderr(), 'userDataStim: in\n')
    
    infile = input$inFileStimLoad
    
    dt = fread(infile$datapath)
    cat(file=stderr(), 'userDataStim: out\n')
    return(dt)
  })
  
  # This button will reset the inFileLoad
  observeEvent(input$butReset, {
    reset("inFileNucLoad")  # reset is a shinyjs function
    reset("inFileStimLoad")  # reset is a shinyjs function
dmattek's avatar
dmattek committed
190 191 192

    reset("inGroupMore1")  # reset is a shinyjs function
    reset("inGroupMore2")  # reset is a shinyjs function
dmattek's avatar
dmattek committed
193 194 195 196 197 198
  })
  
  dataInBoth <- reactive({
    cat(file=stderr(), 'dataInBoth: in\n')
    
    locInGen = input$butDataGen
dmattek's avatar
dmattek committed
199 200 201 202 203 204 205 206
    locButLoadNuc = isolate(butCounter$dataLoadNuc)
    locButLoadStim = isolate(butCounter$dataLoadStim)
    locButGen = isolate(butCounter$dataGen)
    cat("butCounter$dataGen: ", locButGen, "\nbutCounter$dataLoadNuc: ", locButLoadNuc, "\nbutCounter$locButLoadStim: ", locButLoadStim, "\n")
    
    locInLoadNuc  = ifelse(is.null(input$inFileNucLoad),  0, locButLoadNuc + 1)
    locInLoadStim = ifelse(is.null(input$inFileStimLoad), 0, locButLoadStim + 1)
    cat(file=stderr(), "dataInBoth\ninGen: ", locInGen, "\ninLoadNuc: ", locInLoadNuc, "\ninLoadStim: ", locInLoadStim, "\n")
dmattek's avatar
dmattek committed
207 208 209 210
    
    
    # isolate the checks of counter reactiveValues
    # as we set the values in this same reactive
dmattek's avatar
dmattek committed
211
    if (locInLoadNuc != locButLoadNuc) {
dmattek's avatar
dmattek committed
212 213 214 215
      cat(file=stderr(), "dataInBoth if inFileNucLoad\n")
      dm = userDataNuc()

      # no need to isolate updating the counter reactive values!
dmattek's avatar
dmattek committed
216
      
dmattek's avatar
dmattek committed
217
      butCounter$dataLoad <- locInLoadNuc
dmattek's avatar
dmattek committed
218
    } else if (locInGen != locButGen) {
dmattek's avatar
dmattek committed
219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
      cat(file=stderr(), "dataInBoth if inDataGen\n")
      dm = userDataGen()
      cat(colnames(dm))
      # no need to isolate updating the counter reactive values!
      butCounter$dataGen <- locInGen
    } else dm = NULL
    
    cat(file=stderr(), 'dataInBoth: out\n')
    return(dm)
  })
  
  output$trajPlot <- renderPlotly({
    
    cat(file=stderr(), 'trajPlot: in\n')
    locBut = input$butGo
    
    if (locBut == 0) {
      cat(file=stderr(), 'trajPlot: Go button not pressed\n')
      
      return(NULL)
    }
    
    
dmattek's avatar
dmattek committed
242
    dt.nuc = userDataNucMod()
dmattek's avatar
dmattek committed
243 244
    locInLoadStim = isolate(input$inFileStimLoad)
    
dmattek's avatar
dmattek committed
245
    
dmattek's avatar
dmattek committed
246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263
    if (is.null(dt.nuc) && is.null(locInLoadStim)) {
      cat(file=stderr(), 'trajPlot: Data not yet loaded\n')
      
      return(NULL)
    } else if (is.null(locInLoadStim)) {
      cat(file=stderr(), 'trajPlot: only timecourses loaded\n')
      dt.stim = NULL
      
    } else {
      cat(file=stderr(), 'trajPlot: timecourses and stimulation pattern loaded\n')
      
      dt.stim = userDataStim()
    }
    
    loc.facet.ncol.arg = isolate(input$inFacetNcol)
    loc.time = isolate(input$inSelTime)
    loc.meas.1 = isolate(input$inSelMeas1)
    
dmattek's avatar
dmattek committed
264 265 266 267 268 269 270 271 272 273 274 275 276 277
    # create an expression for faceting (max 3 fields)
    loc.facet.group = isolate(input$inSelGroup)
    if (isolate(input$inGroupMore1)) {
      loc.facet.group = paste0(loc.facet.group, ' + ', isolate(input$inSelGroup2))
    } 
    if (isolate(input$inGroupMore2)) {
      loc.facet.group = paste0(loc.facet.group, ' + ', isolate(input$inSelGroup3))
    }
#    cat("loc.facet.group: ", loc.facet.group, "\n")
    
    
    # create expression for plotting Y-axis
    loc.math = isolate(input$inSelMath)
    if (loc.math != '') {
dmattek's avatar
dmattek committed
278
      loc.meas.2 = isolate(input$inSelMeas2)
dmattek's avatar
dmattek committed
279
      loc.y.arg = paste0(loc.meas.1, loc.math, loc.meas.2)
dmattek's avatar
dmattek committed
280 281
    }  else
      loc.y.arg = loc.meas.1
dmattek's avatar
dmattek committed
282
#    cat("loc.y.arg", loc.y.arg, "\n")
dmattek's avatar
dmattek committed
283 284 285 286 287 288
    
    p.out = myGgplotTraj(
      dt.arg = dt.nuc,
      x.arg = loc.time,
      y.arg = loc.y.arg,
      group.arg = "trackObjectsLabelUni",
dmattek's avatar
dmattek committed
289
      facet.arg = loc.facet.group,
dmattek's avatar
dmattek committed
290 291 292 293 294 295 296 297 298
      dt.stim.arg = dt.stim,
      tfreq.arg = 1,
      facet.ncol.arg = loc.facet.ncol.arg,
      stim.bar.height.arg = 0.05,
      stim.bar.width.arg = 1
    )
    
    #ggplotly(p.out)
    cat(file=stderr(), 'trajPlot: out\n')
dmattek's avatar
dmattek committed
299
    
dmattek's avatar
dmattek committed
300 301 302 303
    # 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
dmattek's avatar
dmattek committed
304 305 306
    if (names(dev.cur()) != "null device") dev.off()
    pdf(NULL)
    
dmattek's avatar
dmattek committed
307 308 309 310 311 312 313 314 315
    p.out.ly = plotly_build(p.out)
    
    # Custom tooltip
    # p.out.ly$x$data[[1]]$text <- sprintf("t: %d <br>y: %.2f <br>id: %s <br>s: %s", 
    #                                      dt.nuc[[loc.time]], 
    #                                      dt.nuc[[loc.y.arg]], dt.nuc[['trackObjectsLabelUni']],
    #                                      dt.nuc[[loc.facet.group]])
    
    return(p.out.ly)
dmattek's avatar
dmattek committed
316 317 318 319
  })
  
})