server.R 29.3 KB
Newer Older
dmattek's avatar
dmattek committed
1
#
dmattek's avatar
dmattek committed
2 3 4 5
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This is the server logic for a Shiny web application.
dmattek's avatar
dmattek committed
6 7 8 9
#

library(shiny)
library(shinyjs) #http://deanattali.com/shinyjs/
dmattek's avatar
dmattek committed
10 11
library(shinyBS) # for tooltips
library(shinycssloaders) # for loader animations
dmattek's avatar
dmattek committed
12 13
library(data.table)
library(ggplot2)
dmattek's avatar
dmattek committed
14
library(gplots) # for heatmap.2
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
15 16 17
library(plotly) # interactive plot
library(DT) # interactive tables

dmattek's avatar
dmattek committed
18
library(dendextend) # for color_branches
19
library(colorspace) # for palettes (used to colour dendrogram)
dmattek's avatar
dmattek committed
20 21
library(RColorBrewer)
library(scales) # for percentages on y scale
dmattek's avatar
dmattek committed
22
library(ggthemes) # nice colour palettes
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
23 24

library(sparcl) # sparse hierarchical and k-means
dmattek's avatar
Added:  
dmattek committed
25 26
library(dtw) # for dynamic time warping
library(imputeTS) # for interpolating NAs
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
27 28 29 30
library(robust) # for robust linear regression
library(MASS)
library(pracma) # for trapz

dmattek's avatar
dmattek committed
31

32
# Global parameters ----
dmattek's avatar
dmattek committed
33
# change to increase the limit of the upload file size
dmattek's avatar
Added:  
dmattek committed
34
options(shiny.maxRequestSize = 200 * 1024 ^ 2)
dmattek's avatar
dmattek committed
35

dmattek's avatar
dmattek committed
36 37 38
# colour of loader spinner (shinycssloaders)
options(spinner.color="#00A8AA")

dmattek's avatar
dmattek committed
39
# Server logic ----
dmattek's avatar
dmattek committed
40
shinyServer(function(input, output, session) {
41
  useShinyjs()
dmattek's avatar
dmattek committed
42
  
43
  # This is only set at session start
dmattek's avatar
dmattek committed
44
  # We use this as a way to determine which input was
45 46
  # clicked in the dataInBoth reactive
  counter <- reactiveValues(
dmattek's avatar
dmattek committed
47 48 49
    # The value of actionButton is the number of times the button is pressed
    dataGen1        = isolate(input$inDataGen1),
    dataLoadNuc     = isolate(input$inButLoadNuc),
50 51
    dataLoadTrajRem = isolate(input$inButLoadTrajRem),
    dataLoadStim    = isolate(input$inButLoadStim)
dmattek's avatar
dmattek committed
52
  )
dmattek's avatar
dmattek committed
53 54 55 56 57 58 59 60 61

  nCellsCounter <- reactiveValues(
    nCellsOrig = 0,
    nCellsAfterOutlierTrim = 0
  )
    
  myReactVals = reactiveValues(
    outlierIDs = NULL
  )
dmattek's avatar
dmattek committed
62
  
dmattek's avatar
dmattek committed
63
  # UI-side-panel-data-load ----
dmattek's avatar
dmattek committed
64
  
dmattek's avatar
dmattek committed
65
  # Generate random dataset
66
  dataGen1 <- eventReactive(input$inDataGen1, {
67
    if (DEB)
68
      cat("server:dataGen1\n")
69
    
dmattek's avatar
dmattek committed
70
    return(LOCgenTraj(in.nwells = 3, in.addout = 3))
71 72
  })
  
dmattek's avatar
dmattek committed
73
  # Load main data file
74
  dataLoadNuc <- eventReactive(input$inButLoadNuc, {
75
    if (DEB)
76
      cat("server:dataLoadNuc\n")
77

78 79 80 81 82 83 84
    locFilePath = input$inFileLoadNuc$datapath
    
    counter$dataLoadNuc <- input$inButLoadNuc - 1
    
    if (is.null(locFilePath) || locFilePath == '')
      return(NULL)
    else {
85
      return(fread(locFilePath, strip.white = T))
86 87 88
    }
  })
  
dmattek's avatar
dmattek committed
89 90 91 92
  # This button will reset the inFileLoad
  observeEvent(input$butReset, {
    reset("inFileLoadNuc")  # reset is a shinyjs function
  })
93

dmattek's avatar
dmattek committed
94
  # Load data with trajectories to remove
95
  dataLoadTrajRem <- eventReactive(input$inButLoadTrajRem, {
96
    if (DEB)
97
      cat(file = stdout(), "server:dataLoadTrajRem\n")
98
    
99 100 101 102 103 104 105 106 107 108
    locFilePath = input$inFileLoadTrajRem$datapath
    
    counter$dataLoadTrajRem <- input$inButLoadTrajRem - 1
    
    if (is.null(locFilePath) || locFilePath == '')
      return(NULL)
    else {
      return(fread(locFilePath))
    }
  })
dmattek's avatar
dmattek committed
109
  
dmattek's avatar
dmattek committed
110
  # Load data with stimulation pattern
111
  dataLoadStim <- eventReactive(input$inButLoadStim, {
112
    if (DEB)
113
      cat(file = stdout(), "server:dataLoadStim\n")
114
    
115 116 117 118 119 120 121 122 123 124 125 126
    locFilePath = input$inFileLoadStim$datapath
    
    counter$dataLoadStim <- input$inButLoadStim - 1
    
    if (is.null(locFilePath) || locFilePath == '')
      return(NULL)
    else {
      return(fread(locFilePath))
    }
  })
  
    
dmattek's avatar
Added:  
dmattek committed
127 128
  # UI for loading csv with cell IDs for trajectory removal
  output$uiFileLoadTrajRem = renderUI({
129
    if (DEB)
130
      cat(file = stdout(), 'server:uiFileLoadTrajRem\n')
dmattek's avatar
Added:  
dmattek committed
131 132 133 134
    
    if(input$chBtrajRem) 
      fileInput(
        'inFileLoadTrajRem',
135
        'Select file and press "Load Data"',
dmattek's avatar
Added:  
dmattek committed
136 137 138 139 140
        accept = c('text/csv', 'text/comma-separated-values,text/plain')
      )
  })
  
  output$uiButLoadTrajRem = renderUI({
141
    if (DEB)
142
      cat(file = stdout(), 'server:uiButLoadTrajRem\n')
dmattek's avatar
Added:  
dmattek committed
143 144 145 146 147
    
    if(input$chBtrajRem)
      actionButton("inButLoadTrajRem", "Load Data")
  })

148 149
  # UI for loading csv with stimulation pattern
  output$uiFileLoadStim = renderUI({
150
    if (DEB)
151
      cat(file = stdout(), 'server:uiFileLoadStim\n')
dmattek's avatar
Added:  
dmattek committed
152
    
153 154 155
    if(input$chBstim) 
      fileInput(
        'inFileLoadStim',
156
        'Select file and press "Load Data"',
157 158 159 160 161
        accept = c('text/csv', 'text/comma-separated-values,text/plain')
      )
  })
  
  output$uiButLoadStim = renderUI({
162
    if (DEB)
163
      cat(file = stdout(), 'server:uiButLoadStim\n')
dmattek's avatar
Added:  
dmattek committed
164
    
165 166
    if(input$chBstim)
      actionButton("inButLoadStim", "Load Data")
dmattek's avatar
Added:  
dmattek committed
167 168
  })
  
169

dmattek's avatar
dmattek committed
170
  
dmattek's avatar
dmattek committed
171
  # UI-side-panel-column-selection ----
dmattek's avatar
dmattek committed
172
  output$varSelTrackLabel = renderUI({
173
    if (DEB)
174
      cat(file = stdout(), 'server:varSelTrackLabel\n')
175
    
dmattek's avatar
dmattek committed
176
    locCols = getDataNucCols()
177
    locColSel = locCols[grep('(T|t)rack|ID|id', locCols)[1]] # index 1 at the end in case more matches; select 1st; matches TrackLabel, tracklabel, Track Label etc
dmattek's avatar
dmattek committed
178 179 180
    
    selectInput(
      'inSelTrackLabel',
dmattek's avatar
dmattek committed
181
      'Track ID column:',
dmattek's avatar
dmattek committed
182 183 184 185 186 187 188
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
  
  output$varSelTime = renderUI({
189
    if (DEB)
190
      cat(file = stdout(), 'server:varSelTime\n')
191
    
dmattek's avatar
dmattek committed
192
    locCols = getDataNucCols()
193
    locColSel = locCols[grep('(T|t)ime|Metadata_T', locCols)[1]] # index 1 at the end in case more matches; select 1st; matches RealTime, realtime, real time, etc.
dmattek's avatar
dmattek committed
194 195 196
    
    selectInput(
      'inSelTime',
dmattek's avatar
dmattek committed
197
      'Time column:',
dmattek's avatar
dmattek committed
198 199 200 201 202
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
203 204

  output$varSelTimeFreq = renderUI({
205
    if (DEB)
206
      cat(file = stdout(), 'server:varSelTimeFreq\n')
207
    
208 209 210
    if (input$chBtrajInter) {
      numericInput(
        'inSelTimeFreq',
dmattek's avatar
dmattek committed
211
        'Interval between two time points:',
212 213 214 215 216 217
        min = 1,
        step = 1,
        width = '100%',
        value = 1
      )
    }
218
  })
dmattek's avatar
dmattek committed
219
  
dmattek's avatar
dmattek committed
220
  # This is the main field to select plot facet grouping
dmattek's avatar
dmattek committed
221
  # It's typically a column with the entire experimental description,
dmattek's avatar
dmattek committed
222 223
  # e.g.1 Stim_All_Ch or Stim_All_S.
  # e.g.2 a combination of 3 columns called Stimulation_...
dmattek's avatar
dmattek committed
224
  output$varSelGroup = renderUI({
225
    if (DEB)
226
      cat(file = stdout(), 'server:varSelGroup\n')
dmattek's avatar
dmattek committed
227
    
dmattek's avatar
dmattek committed
228 229 230 231 232
    if (input$chBgroup) {
      
      locCols = getDataNucCols()
      
      if (!is.null(locCols)) {
233
        locColSel = locCols[grep('(G|g)roup|(S|s)tim|(S|s)timulation|(S|s)ite', locCols)[1]]
234 235

        #cat('UI varSelGroup::locColSel ', locColSel, '\n')
dmattek's avatar
dmattek committed
236 237
        selectInput(
          'inSelGroup',
dmattek's avatar
dmattek committed
238
          'Group column:',
dmattek's avatar
dmattek committed
239 240 241 242 243
          locCols,
          width = '100%',
          selected = locColSel,
          multiple = TRUE
        )
dmattek's avatar
dmattek committed
244 245 246 247
      }
    }
  })
  
248 249
  # UI for selecting grouping to add to track ID to make 
  # the track ID unique across entire dataset
dmattek's avatar
dmattek committed
250
  output$varSelSite = renderUI({
251
    if (DEB)
252
      cat(file = stdout(), 'server:varSelSite\n')
dmattek's avatar
dmattek committed
253
    
254
    if (input$chBtrackUni) {
dmattek's avatar
Added:  
dmattek committed
255
      locCols = getDataNucCols()
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
256
      locColSel = locCols[grep('(S|s)ite|(S|s)eries|(F|f)ov|(G|g)roup', locCols)[1]] # index 1 at the end in case more matches; select 1st
dmattek's avatar
Added:  
dmattek committed
257 258 259
      
      selectInput(
        'inSelSite',
dmattek's avatar
dmattek committed
260
        'Columns to add to track ID:',
dmattek's avatar
Added:  
dmattek committed
261 262
        locCols,
        width = '100%',
263 264
        selected = locColSel,
        multiple = T
dmattek's avatar
Added:  
dmattek committed
265 266
      )
    }
dmattek's avatar
dmattek committed
267 268 269 270
  })
  
  
  output$varSelMeas1 = renderUI({
271
    if (DEB)
272
      cat(file = stdout(), 'server:varSelMeas1\n')
dmattek's avatar
dmattek committed
273 274 275
    locCols = getDataNucCols()
    
    if (!is.null(locCols)) {
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
276
      locColSel = locCols[grep('(R|r)atio|(I|i)ntensity|(Y|y)|(M|m)eas', locCols)[1]] # index 1 at the end in case more matches; select 1st
dmattek's avatar
dmattek committed
277

dmattek's avatar
dmattek committed
278 279
      selectInput(
        'inSelMeas1',
dmattek's avatar
dmattek committed
280
        'Column with 1st measurement:',
dmattek's avatar
dmattek committed
281 282 283 284 285 286 287 288 289
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
  })
  
  
  output$varSelMeas2 = renderUI({
290
    if (DEB)
291
      cat(file = stdout(), 'server:varSelMeas2\n')
292
    
dmattek's avatar
dmattek committed
293 294 295 296
    locCols = getDataNucCols()
    
    if (!is.null(locCols) &&
        !(input$inSelMath %in% c('', '1 / '))) {
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
297
      locColSel = locCols[grep('(R|r)atio|(I|i)ntensity|(Y|y)|(M|m)eas', locCols)[1]] # index 1 at the end in case more matches; select 1st
dmattek's avatar
dmattek committed
298

dmattek's avatar
dmattek committed
299 300
      selectInput(
        'inSelMeas2',
dmattek's avatar
dmattek committed
301
        'Column with 2nd measurement',
dmattek's avatar
dmattek committed
302 303 304 305 306 307 308
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
  })
  
dmattek's avatar
dmattek committed
309
  # UI-side-panel-trim x-axis (time) ----
dmattek's avatar
dmattek committed
310
  output$uiSlTimeTrim = renderUI({
311
    if (DEB)
312
      cat(file = stdout(), 'server:uiSlTimeTrim\n')
dmattek's avatar
dmattek committed
313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333
    
    if (input$chBtimeTrim) {
      locTpts  = getDataTpts()
      
      if(is.null(locTpts))
        return(NULL)
      
      locRTmin = min(locTpts)
      locRTmax = max(locTpts)
      
      sliderInput(
        'slTimeTrim',
        label = 'Time range to include',
        min = locRTmin,
        max = locRTmax,
        value = c(locRTmin, locRTmax),
        step = 1
      )
      
    }
  })
dmattek's avatar
dmattek committed
334
  
dmattek's avatar
dmattek committed
335
  # UI-side-panel-normalization ----
336 337 338 339
  
  # select normalisation method
  # - fold-change calculates fold change with respect to the mean
  # - z-score calculates z-score of the selected regione of the time series
dmattek's avatar
dmattek committed
340
  output$uiChBnorm = renderUI({
341
    if (DEB)
342
      cat(file = stdout(), 'server:uiChBnorm\n')
dmattek's avatar
dmattek committed
343 344
    
    if (input$chBnorm) {
345
      tagList(
dmattek's avatar
dmattek committed
346 347 348
      radioButtons(
        'rBnormMeth',
        label = 'Select method',
349 350 351
        choices = list('fold-change' = 'mean', 'z-score' = 'z.score'),
        width = "40%"
      ),
dmattek's avatar
dmattek committed
352
      bsTooltip('rBnormMeth', helpText.server[12], placement = "top", trigger = "hover", options = NULL)
dmattek's avatar
dmattek committed
353 354 355 356
      )
    }
  })
  
357
  # select the region of the time series for normalisation
dmattek's avatar
dmattek committed
358
  output$uiSlNorm = renderUI({
359
    if (DEB)
360
      cat(file = stdout(), 'server:uiSlNorm\n')
dmattek's avatar
dmattek committed
361 362 363 364 365 366 367 368 369 370
    
    if (input$chBnorm) {
      locTpts  = getDataTpts()
      
      if(is.null(locTpts))
        return(NULL)
      
      locRTmin = min(locTpts)
      locRTmax = max(locTpts)
      
371
      tagList(
dmattek's avatar
dmattek committed
372 373
      sliderInput(
        'slNormRtMinMax',
374
        label = 'Time span',
dmattek's avatar
dmattek committed
375 376
        min = locRTmin,
        max = locRTmax,
dmattek's avatar
dmattek committed
377 378
        value = c(locRTmin, 0.1 * locRTmax), 
        step = 1
379
      ),
dmattek's avatar
dmattek committed
380
      bsTooltip('slNormRtMinMax', helpText.server[13], placement = "top", trigger = "hover", options = NULL)
dmattek's avatar
dmattek committed
381 382 383 384
      )
    }
  })
  
385
  # use robust stats (median instead of mean, mad instead of sd)
dmattek's avatar
dmattek committed
386
  output$uiChBnormRobust = renderUI({
387
    if (DEB)
388
      cat(file = stdout(), 'server:uiChBnormRobust\n')
dmattek's avatar
dmattek committed
389 390
    
    if (input$chBnorm) {
391
      tagList(
dmattek's avatar
dmattek committed
392 393
      checkboxInput('chBnormRobust',
                    label = 'Robust stats',
394 395
                    FALSE, 
                    width = "40%"),
dmattek's avatar
dmattek committed
396
      bsTooltip('chBnormRobust', helpText.server[14], placement = "top", trigger = "hover", options = NULL)
397
      )
dmattek's avatar
dmattek committed
398 399 400
    }
  })
  
401
  # choose whether normalisation should be calculated for the entire dataset, group, or trajectory
dmattek's avatar
dmattek committed
402
  output$uiChBnormGroup = renderUI({
403
    if (DEB)
404
      cat(file = stdout(), 'server:uiChBnormGroup\n')
dmattek's avatar
dmattek committed
405 406
    
    if (input$chBnorm) {
407
      tagList(
dmattek's avatar
dmattek committed
408
      radioButtons('chBnormGroup',
dmattek's avatar
Mod:  
dmattek committed
409
                   label = 'Normalisation grouping',
410 411
                   choices = list('Entire dataset' = 'none', 'Per group' = 'group', 'Per trajectory' = 'id'), 
                   width = "40%"),
dmattek's avatar
dmattek committed
412
      bsTooltip('chBnormGroup', helpText.server[15], placement = "top", trigger = "hover", options = NULL)
413
      )
dmattek's avatar
dmattek committed
414 415 416 417
    }
  })
  
  
418 419 420 421 422 423
  # Pop-overs ----
  addPopover(session, 
             "alDataFormat",
             title = "Data format",
             content = helpText.server[["alDataFormat"]],
             trigger = "click", )
dmattek's avatar
dmattek committed
424
  
dmattek's avatar
dmattek committed
425

dmattek's avatar
dmattek committed
426
  # Processing-data ----
dmattek's avatar
dmattek committed
427
  
428 429 430 431 432 433 434 435 436 437 438 439
  dataInBoth <- reactive({
    # Without direct references to inDataGen1,2 and inFileLoad, inDataGen2
    #    does not trigger running this reactive once inDataGen1 is used.
    # This is one of the more nuanced areas of reactive programming in shiny
    #    due to the if else logic, it isn't fetched once inDataGen1 is available
    # The morale is use direct retrieval of inputs to guarantee they are available
    #    for if else logic checks!
    
    locInGen1 = input$inDataGen1
    locInLoadNuc = input$inButLoadNuc
    #locInLoadStim = input$inButLoadStim
    
440
    # Don't wrap around if(DEB) !!!
441
    cat(
442
      "server:dataInBoth\n   inGen1: ",
443
      locInGen1,
444
      "      prev=",
445
      isolate(counter$dataGen1),
446
      "\n   inDataNuc: ",
447 448 449 450 451 452 453 454 455 456
      locInLoadNuc,
      "   prev=",
      isolate(counter$dataLoadNuc),
      # "\ninDataStim: ",
      # locInLoadStim,
      # "   prev=",
      # isolate(counter$dataLoadStim),
      "\n"
    )
    
457
    # isolate the checks of the counter reactiveValues
458 459
    # as we set the values in this same reactive
    if (locInGen1 != isolate(counter$dataGen1)) {
460
      cat("server:dataInBoth if inDataGen1\n")
461 462 463 464
      dm = dataGen1()
      # no need to isolate updating the counter reactive values!
      counter$dataGen1 <- locInGen1
    } else if (locInLoadNuc != isolate(counter$dataLoadNuc)) {
465
      cat("server:dataInBoth if inDataLoadNuc\n")
466
      dm = dataLoadNuc()
467 468 469
      
      # convert to long format if radio box set to "wide"
      # the input data in long format should contain:
470
      # - the first row with a header: group, track id, time points as columns with numeric header
471 472
      # - consecutive rows with time series, where columns are time points
      if (input$inRbutLongWide == 1) {
473 474 475 476 477 478 479 480 481 482 483 484
        print(length(names(dm)))
        
        # data in wide format requires at least 3 columns: grouping, track id, 1 time point
        if (length(names(dm)) < 3) {
          dm = NULL
          
          createAlert(session, "alertAnchorSidePanelDataFormat", "alertWideTooFewColumns", 
                      title = "Error",
                      content = helpText.server[["alertWideTooFewColumns"]], 
                      append = FALSE,
                      style = "danger")
          
485

486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518
        } else {
          closeAlert(session, "alertWideTooFewColumns")

          # obtain column headers from the wide format data
          # headers for grouping and track id columns
          loc.cols.idvars = names(dm)[1:2]
          
          # headers for time columns
          loc.cols.time = names(dm)[c(-1, -2)]
          
          # check if time columns are numeric
          # from https://stackoverflow.com/a/21154566/1898713
          loc.cols.time.numres = grepl("[-]?[0-9]+[.]?[0-9]*|[-]?[0-9]+[L]?|[-]?[0-9]+[.]?[0-9]*[eE][0-9]+", loc.cols.time)
          
          # melt the table only if time columns are numeric
          if (sum(!loc.cols.time.numres) == 0) {
            closeAlert(session, "alertWideMissesNumericTime")
            
            # long to wide
            dm = melt(dm, id.vars = loc.cols.idvars, variable.name = COLRT, value.name = COLY)
            
            # convert column names with time points to a number
            dm[, (COLRT) := as.numeric(levels(get(COLRT)))[get(COLRT)]]
            
          } else {
            dm = NULL

            createAlert(session, "alertAnchorSidePanelDataFormat", "alertWideMissesNumericTime", title = "Error",
                        content = helpText.server[["alertWideMissesNumericTime"]], 
                        append = FALSE,
                        style = "danger")
          }
        }
519 520
      }
      
521 522 523
      # no need to isolate updating the counter reactive values!
      counter$dataLoadNuc <- locInLoadNuc
    } else {
524
      cat("server:dataInBoth else\n")
525 526
      dm = NULL
    }
527
    
528 529 530 531
    return(dm)
  })
  
  # return column names of the main dt
dmattek's avatar
dmattek committed
532
  getDataNucCols <- reactive({
533
    if (DEB)
534
      cat(file = stdout(), 'server:getDataNucCols: in\n')
535
    
536 537 538 539 540 541 542 543 544 545
    loc.dt = dataInBoth()
    
    if (is.null(loc.dt))
      return(NULL)
    else
      return(colnames(loc.dt))
  })
  
  # return dt with an added column with unique track object label
  dataMod <- reactive({
546
    if (DEB)
547
      cat(file = stdout(), 'server:dataMod\n')
548
    
549 550
    loc.dt = dataInBoth()
    
dmattek's avatar
dmattek committed
551
    if (is.null(loc.dt))
552 553
      return(NULL)
    
554
    if (input$chBtrackUni) {
555
      # create unique track ID based on columns specified in input$inSelSite field and combine with input$inSelTrackLabel
556
      loc.dt[, (COLIDUNI) := do.call(paste, c(.SD, sep = "_")), .SDcols = c(input$inSelSite, input$inSelTrackLabel) ]
dmattek's avatar
Added:  
dmattek committed
557
    } else {
558
      # stay with track ID provided in the loaded dataset; has to be unique
559
      loc.dt[, (COLIDUNI) := get(input$inSelTrackLabel)]
dmattek's avatar
Added:  
dmattek committed
560 561
    }
    
dmattek's avatar
dmattek committed
562
    
dmattek's avatar
Added:  
dmattek committed
563 564
    # remove trajectories based on uploaded csv
    if (input$chBtrajRem) {
565
      if (DEB)
566
        cat(file = stdout(), 'server:dataMod: trajRem not NULL\n')
dmattek's avatar
Added:  
dmattek committed
567 568
      
      loc.dt.rem = dataLoadTrajRem()
dmattek's avatar
dmattek committed
569
      loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
dmattek's avatar
Added:  
dmattek committed
570 571
    }
    
dmattek's avatar
dmattek committed
572 573 574
    # check if NAs present
    
    
575 576 577
    return(loc.dt)
  })
  
dmattek's avatar
dmattek committed
578 579 580
  # return all unique track object labels (created in dataMod)
  # This will be used to display in UI for trajectory highlighting
  getDataTrackObjLabUni <- reactive({
581
    if (DEB)
582
      cat(file = stdout(), 'server:getDataTrackObjLabUni\n')
583
    
dmattek's avatar
dmattek committed
584
    loc.dt = dataMod()
585
    
dmattek's avatar
dmattek committed
586 587 588 589
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt$trackObjectsLabelUni))
590 591
  })
  
dmattek's avatar
Mod:  
dmattek committed
592
  
dmattek's avatar
dmattek committed
593 594 595
  # 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
dmattek's avatar
dmattek committed
596
  getDataTpts <- reactive({
597
    if (DEB)
598
      cat(file = stdout(), 'server:getDataTpts\n')
599
    
dmattek's avatar
dmattek committed
600
    loc.dt = dataMod()
601
    
dmattek's avatar
dmattek committed
602 603 604 605
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt[[input$inSelTime]]))
606 607
  })
  
dmattek's avatar
dmattek committed
608
  
609 610 611
  
  # prepare data for plotting time courses
  # returns dt with these columns:
dmattek's avatar
dmattek committed
612
  #    realtime - selected from input
dmattek's avatar
dmattek committed
613
  #    y        - measurement selected from input
dmattek's avatar
dmattek committed
614
  #               (can be a single column or result of an operation on two cols)
615 616
  #    id       - trackObjectsLabelUni; created in dataMod based on TrackObjects_Label
  #               and FOV column such as Series or Site (if TrackObjects_Label not unique across entire dataset)
dmattek's avatar
dmattek committed
617 618
  #    group    - grouping variable for facetting from input
  #    mid.in   - column with trajectory selection status from the input file or
619 620 621 622
  #               highlight status from UI 
  #               (column created if mid.in present in uploaded data or tracks are selected in the UI)
  #    obj.num  - created if ObjectNumber column present in the input data 
  #    pos.x,y  - created if columns with x and y positions present in the input data
623
  data4trajPlot <- reactive({
624
    if (DEB)
625
      cat(file = stdout(), 'server:data4trajPlot\n')
626 627
    
    loc.dt = dataMod()
dmattek's avatar
dmattek committed
628
    if (is.null(loc.dt))
629 630
      return(NULL)
    
631
    # create expression for 'y' column based on measurements and math operations selected in UI
dmattek's avatar
dmattek committed
632
    if (input$inSelMath == '')
633 634 635 636 637 638
      loc.s.y = input$inSelMeas1
    else if (input$inSelMath == '1 / ')
      loc.s.y = paste0(input$inSelMath, input$inSelMeas1)
    else
      loc.s.y = paste0(input$inSelMeas1, input$inSelMath, input$inSelMeas2)
    
639
    # create expression for 'group' column
640 641
    # creates a merged column based on other columns from input
    # used for grouping of plot facets
dmattek's avatar
dmattek committed
642 643 644 645 646 647 648 649 650 651 652
    if (input$chBgroup) {
      if(length(input$inSelGroup) == 0)
        return(NULL)
      
      loc.s.gr = sprintf("paste(%s, sep=';')",
                         paste(input$inSelGroup, sep = '', collapse = ','))
    } else {
      # if no grouping required, fill 'group' column with 0
      # because all the plotting relies on the presence of the group column
      loc.s.gr = "paste('0')"
    }
653
    
dmattek's avatar
dmattek committed
654 655

    # column name with time
656 657
    loc.s.rt = input$inSelTime
    
dmattek's avatar
dmattek committed
658 659
    # Assign tracks selected for highlighting in UI
    loc.tracks.highlight = input$inSelHighlight
660
    locButHighlight = input$chBhighlightTraj
dmattek's avatar
dmattek committed
661
    
dmattek's avatar
Added:  
dmattek committed
662 663
    
    # Find column names with position
664
    loc.s.pos.x = names(loc.dt)[grep('(L|l)ocation.*X|(P|p)os.x|(P|p)osx', names(loc.dt))[1]]
665
    loc.s.pos.y = names(loc.dt)[grep('(L|l)ocation.*Y|(P|p)os.y|(P|p)osy', names(loc.dt))[1]]
dmattek's avatar
Added:  
dmattek committed
666
    
667
    if (DEB)
668
      cat('server:data4trajPlot:\n   Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n')
669 670
    
    if (!is.na(loc.s.pos.x) & !is.na(loc.s.pos.y))
dmattek's avatar
Added:  
dmattek committed
671 672 673 674
      locPos = TRUE
    else
      locPos = FALSE
    
675 676 677 678
    
    # Find column names with ObjectNumber
    # This is different from TrackObject_Label and is handy to keep
    # because labels on segmented images are typically ObjectNumber
679 680 681 682 683 684
    loc.s.objnum = names(loc.dt)[grep('(O|o)bject(N|n)umber', names(loc.dt))[1]]
    #cat('data4trajPlot::loc.s.objnum ', loc.s.objnum, '\n')
    if (is.na(loc.s.objnum)) {
      locObjNum = FALSE
    }
    else {
dmattek's avatar
dmattek committed
685
      loc.s.objnum = loc.s.objnum[1]
686
      locObjNum = TRUE
dmattek's avatar
dmattek committed
687
    }
688 689
    
    
690 691
    # if dataset contains column mid.in with trajectory filtering status,
    # then, include it in plotting
dmattek's avatar
dmattek committed
692
    if (sum(names(loc.dt) %in% COLIN) > 0)
693 694 695 696 697 698
      locMidIn = TRUE
    else
      locMidIn = FALSE
    
    ## Build expression for selecting columns from loc.dt
    # Core columns
dmattek's avatar
dmattek committed
699 700 701 702
    s.colexpr = paste0('.(',  COLY, ' = ', loc.s.y,
                       ', ', COLID, ' = ', COLIDUNI, 
                       ', ', COLGR, ' = ', loc.s.gr,
                       ', ', COLRT, ' = ', loc.s.rt)
703 704
    
    # account for the presence of 'mid.in' column in uploaded data
dmattek's avatar
dmattek committed
705
    # future: choose this column in UI
706 707
    if(locMidIn)
      s.colexpr = paste0(s.colexpr, 
dmattek's avatar
dmattek committed
708
                         ',', COLIN, ' = ', COLIN)
709 710 711 712
    
    # include position x,y columns in uploaded data
    if(locPos)
      s.colexpr = paste0(s.colexpr, 
dmattek's avatar
dmattek committed
713 714
                         ', ', COLPOSX, '= ', loc.s.pos.x,
                         ', ', COLPOSY, '= ', loc.s.pos.y)
715 716 717 718
    
    # include ObjectNumber column
    if(locObjNum)
      s.colexpr = paste0(s.colexpr, 
dmattek's avatar
dmattek committed
719
                         ', ', COLOBJN, ' = ', loc.s.objnum)
720 721 722 723 724 725 726
    
    # close bracket, finish the expression
    s.colexpr = paste0(s.colexpr, ')')
    
    # create final dt for output based on columns selected above
    loc.out = loc.dt[, eval(parse(text = s.colexpr))]
    
727 728 729 730 731
    # Convert track ID to a factor.
    # This is necessary for, e.g. merging data with cluster assignments.
    # If input dataset has track ID as a number, such a merge would fail.
    loc.out[, (COLID) := as.factor(get(COLID))]
    
732 733 734 735 736 737
    
    # if track selection ON
    if (locButHighlight){
      # add a 3rd level with status of track selection
      # to a column with trajectory filtering status in the uploaded file
      if(locMidIn)
dmattek's avatar
dmattek committed
738
        loc.out[, mid.in := ifelse(get(COLID) %in% loc.tracks.highlight, 'SELECTED', get(COLIN))]
739
      else
dmattek's avatar
Mod:  
dmattek committed
740
        # add a column with status of track selection
dmattek's avatar
dmattek committed
741
        loc.out[, mid.in := ifelse(get(COLID) %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')]
742
    }
743
      
dmattek's avatar
dmattek committed
744

745
    ## Interpolate missing data and NA data points
746
    # From: https://stackoverflow.com/questions/28073752/r-how-to-add-rows-for-missing-values-for-unique-group-sequences
747
    # Tracks are interpolated only within first and last time points of every track id
748 749
    # Datasets can have different realtime frequency (e.g. every 1', 2', etc),
    # or the frame number metadata can be missing, as is the case for tCourseSelected files that already have realtime column.
750
    # Therefore, we cannot rely on that info to get time frequency; user must provide this number!
751
    
dmattek's avatar
dmattek committed
752 753 754 755 756 757 758 759 760
    # check if NA's present
    if (sum(is.na(loc.out[[COLY]])))
      createAlert(session, "alertAnchorSidePanelNAsPresent", "alertNAsPresent", title = "Warning",
                  content = helpText.server[["alertNAsPresent"]], 
                  append = FALSE,
                  style = "warning")
    else
      closeAlert(session, "alertNAsPresent")
    
761
    setkeyv(loc.out, c(COLGR, COLID, COLRT))
762

763 764
    if (input$chBtrajInter) {
      # here we fill missing data with NA's
dmattek's avatar
dmattek committed
765
      loc.out = loc.out[setkeyv(loc.out[, .(seq(min(get(COLRT), na.rm = T), max(get(COLRT), na.rm = T), input$inSelTimeFreq)), by = c(COLGR, COLID)], c(COLGR, COLID, 'V1'))]
766 767
      
      # x-check: print all rows with NA's
768
      if (DEB) {
769
        cat(file = stdout(), 'server:data4trajPlot: Rows with NAs:\n')
770 771
        print(loc.out[rowSums(is.na(loc.out)) > 0, ])
      }
772 773 774 775
      
      # NA's may be already present in the dataset'.
      # Interpolate (linear) them with na.interpolate as well
      if(locPos)
dmattek's avatar
dmattek committed
776
        s.cols = c(COLY, COLPOSX, COLPOSY)
777
      else
dmattek's avatar
dmattek committed
778
        s.cols = c(COLY)
779
      
780 781 782 783 784 785 786 787
      # Interpolated columns should be of type numeric (float)
      # This is to ensure that interpolated columns are of porper type.
      
      # Apparently the loop is faster than lapply+SDcols
      for(col in s.cols) {
        #loc.out[, (col) := as.numeric(get(col))]
        data.table::set(loc.out, j = col, value = as.numeric(loc.out[[col]]))

dmattek's avatar
dmattek committed
788
        loc.out[, (col) := na_interpolation(get(col)), by = c(COLID)]        
789 790 791
      }
      
      # loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = c(COLID), .SDcols = s.cols]
792 793 794 795 796 797 798 799 800 801 802 803 804 805
      
      
      # !!! Current issue with interpolation:
      # The column mid.in is not taken into account.
      # If a trajectory is selected in the UI,
      # the mid.in column is added (if it doesn't already exist in the dataset),
      # and for the interpolated point, it will still be NA. Not really an issue.
      #
      # Also, think about the current option of having mid.in column in the uploaded dataset.
      # Keep it? Expand it?
      # Create a UI filed for selecting the column with mid.in data.
      # What to do with that column during interpolation (see above)
      
    }    
dmattek's avatar
Mod:  
dmattek committed
806
    
807
    ## Trim x-axis (time)
dmattek's avatar
dmattek committed
808
    if(input$chBtimeTrim) {
dmattek's avatar
dmattek committed
809
      loc.out = loc.out[get(COLRT) >= input$slTimeTrim[[1]] & get(COLRT) <= input$slTimeTrim[[2]] ]
dmattek's avatar
dmattek committed
810
    }
dmattek's avatar
dmattek committed
811
    
812
    ## Normalization
dmattek's avatar
dmattek committed
813
    # F-n normTraj adds additional column with .norm suffix
dmattek's avatar
dmattek committed
814
    if (input$chBnorm) {
dmattek's avatar
dmattek committed
815
      loc.out = LOCnormTraj(
dmattek's avatar
dmattek committed
816
        in.dt = loc.out,
dmattek's avatar
dmattek committed
817 818
        in.meas.col = COLY,
        in.rt.col = COLRT,
dmattek's avatar
dmattek committed
819 820 821 822 823 824 825
        in.rt.min = input$slNormRtMinMax[1],
        in.rt.max = input$slNormRtMinMax[2],
        in.type = input$rBnormMeth,
        in.robust = input$chBnormRobust,
        in.by.cols = if(input$chBnormGroup %in% 'none') NULL else input$chBnormGroup
      )
      
dmattek's avatar
dmattek committed
826 827
      # Column with normalized data is renamed to the original name
      # Further code assumes column name y produced by data4trajPlot
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
828 829
      
      loc.out[, c(COLY) := NULL]
dmattek's avatar
dmattek committed
830
      setnames(loc.out, 'y.norm', COLY)
dmattek's avatar
dmattek committed
831 832 833
    }
    
    return(loc.out)
dmattek's avatar
dmattek committed
834 835
  })
  
dmattek's avatar
dmattek committed
836 837
  
  # prepare data for clustering
dmattek's avatar
dmattek committed
838
  # convert from long to wide; return a matrix with:
dmattek's avatar
dmattek committed
839 840 841
  # cells as columns
  # time points as rows
  data4clust <- reactive({
842
    if (DEB)  
843
      cat(file = stdout(), 'server:data4clust\n')
dmattek's avatar
dmattek committed
844
    
dmattek's avatar
dmattek committed
845
    loc.dt = data4trajPlotNoOut()
dmattek's avatar
dmattek committed
846 847 848
    if (is.null(loc.dt))
      return(NULL)
    
849 850 851 852
    # convert from long to wide format
    loc.dt.wide = dcast(loc.dt, 
                    reformulate(response = COLID, termlabels = COLRT), 
                    value.var = COLY)
dmattek's avatar
dmattek committed
853
    
854 855
    # store row names for later
    loc.rownames = loc.dt.wide[[COLID]]
dmattek's avatar
Mod:  
dmattek committed
856
    
857 858
    # omit first column that contains row names
    loc.m.out = as.matrix(loc.dt.wide[, -1])
dmattek's avatar
Added:  
dmattek committed
859
    
860 861
    # assign row names to the matrix
    rownames(loc.m.out) = loc.rownames
dmattek's avatar
Added:  
dmattek committed
862
    
863
    return(loc.m.out)
dmattek's avatar
Mod:  
dmattek committed
864
  }) 
dmattek's avatar
dmattek committed
865
  
dmattek's avatar
dmattek committed
866
  
867 868 869
  # prepare data with stimulation pattern
  # this dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment
  data4stimPlot <- reactive({
870
    if (DEB)  
871
      cat(file = stdout(), 'server:data4stimPlot\n')
872 873
    
    if (input$chBstim) {
874
      if (DEB)  
875
        cat(file = stdout(), 'server:data4stimPlot: stim not NULL\n')
876 877 878 879
      
      loc.dt.stim = dataLoadStim()
      return(loc.dt.stim)
    } else {
880
      if (DEB)  
881
        cat(file = stdout(), 'server:data4stimPlot: stim is NULL\n')
882
      
883 884 885 886
      return(NULL)
    }
  })
  
dmattek's avatar
dmattek committed
887 888 889 890 891 892 893 894 895 896
  # prepare y-axis label in time series plots, depending on UI setting
  
  createYaxisLabel = reactive({
    locLabel = input$inSelMeas1
    
    
    
    return(locLabel)
  })
  
dmattek's avatar
Added:  
dmattek committed
897 898 899
  # download data as prepared for plotting
  # after all modification
  output$downloadDataClean <- downloadHandler(
dmattek's avatar
dmattek committed
900
    filename = FCSVTCCLEAN,
dmattek's avatar
Added:  
dmattek committed
901
    content = function(file) {
dmattek's avatar
dmattek committed
902
      write.csv(data4trajPlotNoOut(), file, row.names = FALSE)
dmattek's avatar
Added:  
dmattek committed
903 904 905
    }
  )
  
dmattek's avatar
dmattek committed
906 907 908
  # Plotting-trajectories ----

  # UI for selecting trajectories
909
  # The output data table of data4trajPlot is modified based on inSelHighlight field
dmattek's avatar
dmattek committed
910
  output$varSelHighlight = renderUI({
911
    if (DEB)  
912
      cat(file = stdout(), 'server:varSelHighlight\n')
dmattek's avatar
dmattek committed
913
    
dmattek's avatar
dmattek committed
914 915 916
    locBut = input$chBhighlightTraj
    if (!locBut)
      return(NULL)
dmattek's avatar
dmattek committed
917
    
dmattek's avatar
dmattek committed
918
    loc.v = getDataTrackObjLabUni()
dmattek's avatar
dmattek committed
919
    if (!is.null(loc.v)) {
920
      selectInput(
dmattek's avatar
dmattek committed
921
        'inSelHighlight',
922
        'Select one or more trajectories:',
dmattek's avatar
dmattek committed
923
        loc.v,
924
        width = '100%',
dmattek's avatar
dmattek committed
925
        multiple = TRUE
926
      )
dmattek's avatar
dmattek committed
927 928 929
    }
  })
  
dmattek's avatar
dmattek committed
930 931 932
  # Taking out outliers 
  data4trajPlotNoOut = callModule(modSelOutliers, 'returnOutlierIDs', data4trajPlot)
  
dmattek's avatar
dmattek committed
933 934
  # Trajectory plotting - ribbon
  callModule(modTrajRibbonPlot, 'modTrajRibbon', 
dmattek's avatar
dmattek committed
935
             in.data = data4trajPlotNoOut,
dmattek's avatar
dmattek committed
936
             in.data.stim = data4stimPlot,
dmattek's avatar
dmattek committed
937
             in.fname = function() return(FPDFTCMEAN))
dmattek's avatar
dmattek committed
938
  
dmattek's avatar
dmattek committed
939
  # Trajectory plotting - individual
dmattek's avatar
dmattek committed
940
  callModule(modTrajPlot, 'modTrajPlot', 
dmattek's avatar
dmattek committed
941
             in.data = data4trajPlotNoOut, 
dmattek's avatar
dmattek committed
942
             in.data.stim = data4stimPlot,
dmattek's avatar
dmattek committed
943 944
             in.fname = function() {return(FPDFTCSINGLE)},
             in.ylab = createYaxisLabel)
dmattek's avatar
dmattek committed
945
  
946 947 948 949 950
  # Trajectory plotting - PSD
  callModule(modPSDPlot, 'modPSDPlot',
             in.data = data4trajPlotNoOut,
             in.fname = function() {return(FPDFTCPSD)})
  
dmattek's avatar
dmattek committed
951 952
  
  # Tabs ----
953
  ###### AUC calculation and plotting
dmattek's avatar
dmattek committed
954
  callModule(tabAUCplot, 'tabAUC', data4trajPlotNoOut, in.fname = function() return(FPDFBOXAUC))
dmattek's avatar
Added:  
dmattek committed
955
  
dmattek's avatar
Added:  
dmattek committed
956
  ###### Box-plot
dmattek's avatar
dmattek committed
957
  callModule(tabDistPlot, 'tabDistPlot', data4trajPlotNoOut, in.fname = function() return(FPDFBOXTP))
dmattek's avatar
dmattek committed
958
  
dmattek's avatar
dmattek committed
959
  ###### Scatter plot
dmattek's avatar
dmattek committed
960
  callModule(tabScatterPlot, 'tabScatter', data4trajPlotNoOut, in.fname = function() return(FPDFSCATTER))
dmattek's avatar
dmattek committed
961