server.R 26.7 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
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
22 23

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

dmattek's avatar
dmattek committed
30

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

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

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

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

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

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

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

dmattek's avatar
dmattek committed
169
  
dmattek's avatar
dmattek committed
170
  # UI-side-panel-column-selection ----
dmattek's avatar
dmattek committed
171
  output$varSelTrackLabel = renderUI({
172
    if (DEB)
173
      cat(file = stdout(), 'server:varSelTrackLabel\n')
174
    
dmattek's avatar
dmattek committed
175
    locCols = getDataNucCols()
176
    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
177 178 179
    
    selectInput(
      'inSelTrackLabel',
dmattek's avatar
dmattek committed
180
      'Select ID:',
dmattek's avatar
dmattek committed
181 182 183 184 185 186 187
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
  
  output$varSelTime = renderUI({
188
    if (DEB)
189
      cat(file = stdout(), 'server:varSelTime\n')
190
    
dmattek's avatar
dmattek committed
191
    locCols = getDataNucCols()
192
    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
193 194 195
    
    selectInput(
      'inSelTime',
196
      'Select time column:',
dmattek's avatar
dmattek committed
197 198 199 200 201
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
202 203

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

        #cat('UI varSelGroup::locColSel ', locColSel, '\n')
dmattek's avatar
dmattek committed
235 236
        selectInput(
          'inSelGroup',
237
          'Select columns for plot grouping:',
dmattek's avatar
dmattek committed
238 239 240 241 242
          locCols,
          width = '100%',
          selected = locColSel,
          multiple = TRUE
        )
dmattek's avatar
dmattek committed
243 244 245 246
      }
    }
  })
  
247 248
  # UI for selecting grouping to add to track ID to make 
  # the track ID unique across entire dataset
dmattek's avatar
dmattek committed
249
  output$varSelSite = renderUI({
250
    if (DEB)
251
      cat(file = stdout(), 'server:varSelSite\n')
dmattek's avatar
dmattek committed
252
    
253
    if (input$chBtrackUni) {
dmattek's avatar
Added:  
dmattek committed
254
      locCols = getDataNucCols()
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
255
      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
256 257 258
      
      selectInput(
        'inSelSite',
259
        'Select grouping columns to add to track label:',
dmattek's avatar
Added:  
dmattek committed
260 261
        locCols,
        width = '100%',
262 263
        selected = locColSel,
        multiple = T
dmattek's avatar
Added:  
dmattek committed
264 265
      )
    }
dmattek's avatar
dmattek committed
266 267 268 269
  })
  
  
  output$varSelMeas1 = renderUI({
270
    if (DEB)
271
      cat(file = stdout(), 'server:varSelMeas1\n')
dmattek's avatar
dmattek committed
272 273 274
    locCols = getDataNucCols()
    
    if (!is.null(locCols)) {
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
275
      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
276

dmattek's avatar
dmattek committed
277 278
      selectInput(
        'inSelMeas1',
279
        'Select 1st meas.:',
dmattek's avatar
dmattek committed
280 281 282 283 284 285 286 287 288
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
  })
  
  
  output$varSelMeas2 = renderUI({
289
    if (DEB)
290
      cat(file = stdout(), 'server:varSelMeas2\n')
291
    
dmattek's avatar
dmattek committed
292 293 294 295
    locCols = getDataNucCols()
    
    if (!is.null(locCols) &&
        !(input$inSelMath %in% c('', '1 / '))) {
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
296
      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
297

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

dmattek's avatar
dmattek committed
419
  # Processing-data ----
dmattek's avatar
dmattek committed
420
  
421 422 423 424 425 426 427 428 429 430 431 432
  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
    
433
    # Don't wrap around if(DEB) !!!
434
    cat(
435
      "server:dataInBoth\n   inGen1: ",
436
      locInGen1,
437
      "      prev=",
438
      isolate(counter$dataGen1),
439
      "\n   inDataNuc: ",
440 441 442 443 444 445 446 447 448 449
      locInLoadNuc,
      "   prev=",
      isolate(counter$dataLoadNuc),
      # "\ninDataStim: ",
      # locInLoadStim,
      # "   prev=",
      # isolate(counter$dataLoadStim),
      "\n"
    )
    
450
    # isolate the checks of the counter reactiveValues
451 452
    # as we set the values in this same reactive
    if (locInGen1 != isolate(counter$dataGen1)) {
453
      cat("server:dataInBoth if inDataGen1\n")
454 455 456 457
      dm = dataGen1()
      # no need to isolate updating the counter reactive values!
      counter$dataGen1 <- locInGen1
    } else if (locInLoadNuc != isolate(counter$dataLoadNuc)) {
458
      cat("server:dataInBoth if inDataLoadNuc\n")
459
      dm = dataLoadNuc()
460 461 462 463 464 465 466 467 468 469 470 471 472
      
      # convert to long format if radio box set to "wide"
      # the input data in long format should contain:
      # - the first row with a header: ID, 1, 2, 3...
      # - consecutive rows with time series, where columns are time points
      if (input$inRbutLongWide == 1) {
        # long to wide
        dm = melt(dm, id.vars = names(dm)[1], variable.name = COLRT, value.name = COLY)

        # convert column names with time points to a number
        dm[, (COLRT) := as.numeric(levels(get(COLRT)))[get(COLRT)]]
      }
      
473 474 475
      # no need to isolate updating the counter reactive values!
      counter$dataLoadNuc <- locInLoadNuc
    } else {
476
      cat("server:dataInBoth else\n")
477 478 479 480 481 482
      dm = NULL
    }
    return(dm)
  })
  
  # return column names of the main dt
dmattek's avatar
dmattek committed
483
  getDataNucCols <- reactive({
484
    if (DEB)
485
      cat(file = stdout(), 'server:getDataNucCols: in\n')
486
    
487 488 489 490 491 492 493 494 495 496
    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({
497
    if (DEB)
498
      cat(file = stdout(), 'server:dataMod\n')
499
    
500 501
    loc.dt = dataInBoth()
    
dmattek's avatar
dmattek committed
502
    if (is.null(loc.dt))
503 504
      return(NULL)
    
505
    if (input$chBtrackUni) {
506
      # create unique track ID based on columns specified in input$inSelSite field and combine with input$inSelTrackLabel
507
      loc.dt[, (COLIDUNI) := do.call(paste, c(.SD, sep = "_")), .SDcols = c(input$inSelSite, input$inSelTrackLabel) ]
dmattek's avatar
Added:  
dmattek committed
508
    } else {
509
      # stay with track ID provided in the loaded dataset; has to be unique
510
      loc.dt[, (COLIDUNI) := get(input$inSelTrackLabel)]
dmattek's avatar
Added:  
dmattek committed
511 512
    }
    
dmattek's avatar
dmattek committed
513
    
dmattek's avatar
Added:  
dmattek committed
514 515 516
    # remove trajectories based on uploaded csv

    if (input$chBtrajRem) {
517
      if (DEB)
518
        cat(file = stdout(), 'server:dataMod: trajRem not NULL\n')
dmattek's avatar
Added:  
dmattek committed
519 520
      
      loc.dt.rem = dataLoadTrajRem()
dmattek's avatar
dmattek committed
521
      loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
dmattek's avatar
Added:  
dmattek committed
522 523
    }
    
524 525 526
    return(loc.dt)
  })
  
dmattek's avatar
dmattek committed
527 528 529
  # return all unique track object labels (created in dataMod)
  # This will be used to display in UI for trajectory highlighting
  getDataTrackObjLabUni <- reactive({
530
    if (DEB)
531
      cat(file = stdout(), 'server:getDataTrackObjLabUni\n')
532
    
dmattek's avatar
dmattek committed
533
    loc.dt = dataMod()
534
    
dmattek's avatar
dmattek committed
535 536 537 538
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt$trackObjectsLabelUni))
539 540
  })
  
dmattek's avatar
Mod:  
dmattek committed
541
  
dmattek's avatar
dmattek committed
542 543 544
  # 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
545
  getDataTpts <- reactive({
546
    if (DEB)
547
      cat(file = stdout(), 'server:getDataTpts\n')
548
    
dmattek's avatar
dmattek committed
549
    loc.dt = dataMod()
550
    
dmattek's avatar
dmattek committed
551 552 553 554
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt[[input$inSelTime]]))
555 556
  })
  
dmattek's avatar
dmattek committed
557
  
558 559 560
  
  # prepare data for plotting time courses
  # returns dt with these columns:
dmattek's avatar
dmattek committed
561
  #    realtime - selected from input
dmattek's avatar
dmattek committed
562
  #    y        - measurement selected from input
dmattek's avatar
dmattek committed
563
  #               (can be a single column or result of an operation on two cols)
564 565
  #    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
566 567
  #    group    - grouping variable for facetting from input
  #    mid.in   - column with trajectory selection status from the input file or
568 569 570 571
  #               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
572
  data4trajPlot <- reactive({
573
    if (DEB)
574
      cat(file = stdout(), 'server:data4trajPlot\n')
575 576
    
    loc.dt = dataMod()
dmattek's avatar
dmattek committed
577
    if (is.null(loc.dt))
578 579
      return(NULL)
    
580
    # create expression for 'y' column based on measurements and math operations selected in UI
dmattek's avatar
dmattek committed
581
    if (input$inSelMath == '')
582 583 584 585 586 587
      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)
    
588
    # create expression for 'group' column
589 590
    # creates a merged column based on other columns from input
    # used for grouping of plot facets
dmattek's avatar
dmattek committed
591 592 593 594 595 596 597 598 599 600 601
    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')"
    }
602
    
dmattek's avatar
dmattek committed
603 604

    # column name with time
605 606
    loc.s.rt = input$inSelTime
    
dmattek's avatar
dmattek committed
607 608
    # Assign tracks selected for highlighting in UI
    loc.tracks.highlight = input$inSelHighlight
609
    locButHighlight = input$chBhighlightTraj
dmattek's avatar
dmattek committed
610
    
dmattek's avatar
Added:  
dmattek committed
611 612
    
    # Find column names with position
613
    loc.s.pos.x = names(loc.dt)[grep('(L|l)ocation.*X|(P|p)os.x|(P|p)osx', names(loc.dt))[1]]
614
    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
615
    
616
    if (DEB)
617
      cat('server:data4trajPlot:\n   Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n')
618 619
    
    if (!is.na(loc.s.pos.x) & !is.na(loc.s.pos.y))
dmattek's avatar
Added:  
dmattek committed
620 621 622 623
      locPos = TRUE
    else
      locPos = FALSE
    
624 625 626 627
    
    # Find column names with ObjectNumber
    # This is different from TrackObject_Label and is handy to keep
    # because labels on segmented images are typically ObjectNumber
628 629 630 631 632 633
    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
634
      loc.s.objnum = loc.s.objnum[1]
635
      locObjNum = TRUE
dmattek's avatar
dmattek committed
636
    }
637 638
    
    
639 640
    # if dataset contains column mid.in with trajectory filtering status,
    # then, include it in plotting
641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674
    if (sum(names(loc.dt) %in% 'mid.in') > 0)
      locMidIn = TRUE
    else
      locMidIn = FALSE
    
    ## Build expression for selecting columns from loc.dt
    # Core columns
    s.colexpr = paste0('.(y = ', loc.s.y,
                       ', id = trackObjectsLabelUni', 
                       ', group = ', loc.s.gr,
                       ', realtime = ', loc.s.rt)
    
    # account for the presence of 'mid.in' column in uploaded data
    if(locMidIn)
      s.colexpr = paste0(s.colexpr, 
                         ', mid.in = mid.in')
    
    # include position x,y columns in uploaded data
    if(locPos)
      s.colexpr = paste0(s.colexpr, 
                         ', pos.x = ', loc.s.pos.x,
                         ', pos.y = ', loc.s.pos.y)
    
    # include ObjectNumber column
    if(locObjNum)
      s.colexpr = paste0(s.colexpr, 
                         ', obj.num = ', loc.s.objnum)
    
    # 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))]
    
675 676 677 678 679
    # 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))]
    
680 681 682 683 684 685 686 687
    
    # 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)
        loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', mid.in)]
      else
dmattek's avatar
Mod:  
dmattek committed
688
        # add a column with status of track selection
689
        loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')]
690
    }
691
      
dmattek's avatar
dmattek committed
692

693
    ## Interpolate missing data and NA data points
694
    # From: https://stackoverflow.com/questions/28073752/r-how-to-add-rows-for-missing-values-for-unique-group-sequences
695
    # Tracks are interpolated only within first and last time points of every track id
696 697
    # 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.
698
    # Therefore, we cannot rely on that info to get time frequency; user must provide this number!
699
    
700
    setkeyv(loc.out, c(COLGR, COLID, COLRT))
701

702 703
    if (input$chBtrajInter) {
      # here we fill missing data with NA's
dmattek's avatar
dmattek committed
704
      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'))]
705 706
      
      # x-check: print all rows with NA's
707
      if (DEB) {
708
        cat(file = stdout(), 'server:data4trajPlot: Rows with NAs:\n')
709 710
        print(loc.out[rowSums(is.na(loc.out)) > 0, ])
      }
711 712 713 714
      
      # NA's may be already present in the dataset'.
      # Interpolate (linear) them with na.interpolate as well
      if(locPos)
dmattek's avatar
dmattek committed
715
        s.cols = c(COLY, COLPOSX, COLPOSY)
716
      else
dmattek's avatar
dmattek committed
717
        s.cols = c(COLY)
718
      
719 720 721 722 723 724 725 726 727 728 729 730
      # 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]]))

        loc.out[, (col) := na.interpolation(get(col)), by = c(COLID)]        
      }
      
      # loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = c(COLID), .SDcols = s.cols]
731 732 733 734 735 736 737 738 739 740 741 742 743 744
      
      
      # !!! 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
745
    
746
    ## Trim x-axis (time)
dmattek's avatar
dmattek committed
747
    if(input$chBtimeTrim) {
dmattek's avatar
dmattek committed
748
      loc.out = loc.out[get(COLRT) >= input$slTimeTrim[[1]] & get(COLRT) <= input$slTimeTrim[[2]] ]
dmattek's avatar
dmattek committed
749
    }
dmattek's avatar
dmattek committed
750
    
751
    ## Normalization
dmattek's avatar
dmattek committed
752
    # F-n normTraj adds additional column with .norm suffix
dmattek's avatar
dmattek committed
753
    if (input$chBnorm) {
dmattek's avatar
dmattek committed
754
      loc.out = LOCnormTraj(
dmattek's avatar
dmattek committed
755
        in.dt = loc.out,
dmattek's avatar
dmattek committed
756 757
        in.meas.col = COLY,
        in.rt.col = COLRT,
dmattek's avatar
dmattek committed
758 759 760 761 762 763 764
        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
765 766
      # 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
767 768
      
      loc.out[, c(COLY) := NULL]
dmattek's avatar
dmattek committed
769
      setnames(loc.out, 'y.norm', COLY)
dmattek's avatar
dmattek committed
770 771 772
    }
    
    return(loc.out)
dmattek's avatar
dmattek committed
773 774
  })
  
dmattek's avatar
dmattek committed
775 776 777 778 779 780
  
  # prepare data for clustering
  # return a matrix with:
  # cells as columns
  # time points as rows
  data4clust <- reactive({
781
    if (DEB)  
782
      cat(file = stdout(), 'server:data4clust\n')
dmattek's avatar
dmattek committed
783
    
dmattek's avatar
dmattek committed
784
    loc.dt = data4trajPlotNoOut()
dmattek's avatar
dmattek committed
785 786 787
    if (is.null(loc.dt))
      return(NULL)
    
788 789 790 791
    # 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
792
    
793 794
    # store row names for later
    loc.rownames = loc.dt.wide[[COLID]]
dmattek's avatar
Mod:  
dmattek committed
795
    
796 797
    # omit first column that contains row names
    loc.m.out = as.matrix(loc.dt.wide[, -1])
dmattek's avatar
Added:  
dmattek committed
798
    
799 800
    # assign row names to the matrix
    rownames(loc.m.out) = loc.rownames
dmattek's avatar
Added:  
dmattek committed
801
    
802
    return(loc.m.out)
dmattek's avatar
Mod:  
dmattek committed
803
  }) 
dmattek's avatar
dmattek committed
804
  
dmattek's avatar
dmattek committed
805
  
806 807 808
  # prepare data with stimulation pattern
  # this dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment
  data4stimPlot <- reactive({
809
    if (DEB)  
810
      cat(file = stdout(), 'server:data4stimPlot\n')
811 812
    
    if (input$chBstim) {
813
      if (DEB)  
814
        cat(file = stdout(), 'server:data4stimPlot: stim not NULL\n')
815 816 817 818
      
      loc.dt.stim = dataLoadStim()
      return(loc.dt.stim)
    } else {
819
      if (DEB)  
820
        cat(file = stdout(), 'server:data4stimPlot: stim is NULL\n')
821
      
822 823 824 825
      return(NULL)
    }
  })
  
dmattek's avatar
Added:  
dmattek committed
826 827 828
  # download data as prepared for plotting
  # after all modification
  output$downloadDataClean <- downloadHandler(
dmattek's avatar
dmattek committed
829
    filename = FCSVTCCLEAN,
dmattek's avatar
Added:  
dmattek committed
830
    content = function(file) {
dmattek's avatar
dmattek committed
831
      write.csv(data4trajPlotNoOut(), file, row.names = FALSE)
dmattek's avatar
Added:  
dmattek committed
832 833 834
    }
  )
  
dmattek's avatar
dmattek committed
835 836 837
  # Plotting-trajectories ----

  # UI for selecting trajectories
838
  # The output data table of data4trajPlot is modified based on inSelHighlight field
dmattek's avatar
dmattek committed
839
  output$varSelHighlight = renderUI({
840
    if (DEB)  
841
      cat(file = stdout(), 'server:varSelHighlight\n')
dmattek's avatar
dmattek committed
842
    
dmattek's avatar
dmattek committed
843 844 845
    locBut = input$chBhighlightTraj
    if (!locBut)
      return(NULL)
dmattek's avatar
dmattek committed
846
    
dmattek's avatar
dmattek committed
847
    loc.v = getDataTrackObjLabUni()
dmattek's avatar
dmattek committed
848
    if (!is.null(loc.v)) {
849
      selectInput(
dmattek's avatar
dmattek committed
850
        'inSelHighlight',
851
        'Select one or more trajectories:',
dmattek's avatar
dmattek committed
852
        loc.v,
853
        width = '100%',
dmattek's avatar
dmattek committed
854
        multiple = TRUE
855
      )
dmattek's avatar
dmattek committed
856 857 858
    }
  })
  
dmattek's avatar
dmattek committed
859 860 861
  # Taking out outliers 
  data4trajPlotNoOut = callModule(modSelOutliers, 'returnOutlierIDs', data4trajPlot)
  
dmattek's avatar
dmattek committed
862 863
  # Trajectory plotting - ribbon
  callModule(modTrajRibbonPlot, 'modTrajRibbon', 
dmattek's avatar
dmattek committed
864
             in.data = data4trajPlotNoOut,
dmattek's avatar
dmattek committed
865
             in.data.stim = data4stimPlot,
dmattek's avatar
dmattek committed
866
             in.fname = function() return(FPDFTCMEAN))
dmattek's avatar
dmattek committed
867
  
dmattek's avatar
dmattek committed
868
  # Trajectory plotting - individual
dmattek's avatar
dmattek committed
869
  callModule(modTrajPlot, 'modTrajPlot', 
dmattek's avatar
dmattek committed
870
             in.data = data4trajPlotNoOut, 
dmattek's avatar
dmattek committed
871
             in.data.stim = data4stimPlot,
dmattek's avatar
dmattek committed
872
             in.fname = function() {return(FPDFTCSINGLE)})
dmattek's avatar
dmattek committed
873
  
majpark21's avatar