server.R 25.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
10
11
#

library(shiny)
library(shinyjs) #http://deanattali.com/shinyjs/
library(data.table)
library(ggplot2)
dmattek's avatar
dmattek committed
12
library(gplots) # for heatmap.2
dmattek's avatar
dmattek committed
13
library(plotly)
dmattek's avatar
dmattek committed
14
15
library(d3heatmap) # for interactive heatmap
library(dendextend) # for color_branches
16
library(colorspace) # for palettes (used to colour dendrogram)
dmattek's avatar
dmattek committed
17
library(RColorBrewer)
dmattek's avatar
dmattek committed
18
library(sparcl) # sparse hierarchical and k-means
dmattek's avatar
dmattek committed
19
library(scales) # for percentages on y scale
dmattek's avatar
Added:    
dmattek committed
20
21
library(dtw) # for dynamic time warping
library(imputeTS) # for interpolating NAs
dmattek's avatar
dmattek committed
22

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

dmattek's avatar
dmattek committed
27
# Server logic ----
dmattek's avatar
dmattek committed
28
shinyServer(function(input, output, session) {
29
  useShinyjs()
dmattek's avatar
dmattek committed
30
  
31
  # This is only set at session start
dmattek's avatar
dmattek committed
32
  # We use this as a way to determine which input was
33
34
  # clicked in the dataInBoth reactive
  counter <- reactiveValues(
dmattek's avatar
dmattek committed
35
36
37
    # The value of actionButton is the number of times the button is pressed
    dataGen1        = isolate(input$inDataGen1),
    dataLoadNuc     = isolate(input$inButLoadNuc),
38
39
    dataLoadTrajRem = isolate(input$inButLoadTrajRem),
    dataLoadStim    = isolate(input$inButLoadStim)
dmattek's avatar
dmattek committed
40
  )
dmattek's avatar
dmattek committed
41
42
43
44
45
46
47
48
49

  nCellsCounter <- reactiveValues(
    nCellsOrig = 0,
    nCellsAfterOutlierTrim = 0
  )
    
  myReactVals = reactiveValues(
    outlierIDs = NULL
  )
dmattek's avatar
dmattek committed
50
  
dmattek's avatar
dmattek committed
51
  # UI-side-panel-data-load ----
dmattek's avatar
dmattek committed
52
  
dmattek's avatar
dmattek committed
53
  # Generate random dataset
54
55
56
  dataGen1 <- eventReactive(input$inDataGen1, {
    cat("dataGen1\n")
    
dmattek's avatar
dmattek committed
57
    return(LOCgenTraj(in.nwells = 3, in.addout = 3))
58
59
  })
  
dmattek's avatar
dmattek committed
60
  # Load main data file
61
62
63
64
65
66
67
68
69
70
71
72
73
  dataLoadNuc <- eventReactive(input$inButLoadNuc, {
    cat("dataLoadNuc\n")
    locFilePath = input$inFileLoadNuc$datapath
    
    counter$dataLoadNuc <- input$inButLoadNuc - 1
    
    if (is.null(locFilePath) || locFilePath == '')
      return(NULL)
    else {
      return(fread(locFilePath))
    }
  })
  
dmattek's avatar
dmattek committed
74
75
76
77
  # This button will reset the inFileLoad
  observeEvent(input$butReset, {
    reset("inFileLoadNuc")  # reset is a shinyjs function
  })
78

dmattek's avatar
dmattek committed
79
  # Load data with trajectories to remove
80
81
82
83
84
85
86
87
88
89
90
91
  dataLoadTrajRem <- eventReactive(input$inButLoadTrajRem, {
    cat(file = stderr(), "dataLoadTrajRem\n")
    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
92
  
dmattek's avatar
dmattek committed
93
  # Load data with stimulation pattern
94
95
96
97
98
99
100
101
102
103
104
105
106
107
  dataLoadStim <- eventReactive(input$inButLoadStim, {
    cat(file = stderr(), "dataLoadStim\n")
    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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
  # UI for loading csv with cell IDs for trajectory removal
  output$uiFileLoadTrajRem = renderUI({
    cat(file = stderr(), 'UI uiFileLoadTrajRem\n')
    
    if(input$chBtrajRem) 
      fileInput(
        'inFileLoadTrajRem',
        'Select data file (e.g. badTraj.csv) and press "Load Data"',
        accept = c('text/csv', 'text/comma-separated-values,text/plain')
      )
  })
  
  output$uiButLoadTrajRem = renderUI({
    cat(file = stderr(), 'UI uiButLoadTrajRem\n')
    
    if(input$chBtrajRem)
      actionButton("inButLoadTrajRem", "Load Data")
  })

127
128
129
  # UI for loading csv with stimulation pattern
  output$uiFileLoadStim = renderUI({
    cat(file = stderr(), 'UI uiFileLoadStim\n')
dmattek's avatar
Added:    
dmattek committed
130
    
131
132
133
134
135
136
137
138
139
140
    if(input$chBstim) 
      fileInput(
        'inFileLoadStim',
        'Select data file (e.g. stim.csv) and press "Load Data"',
        accept = c('text/csv', 'text/comma-separated-values,text/plain')
      )
  })
  
  output$uiButLoadStim = renderUI({
    cat(file = stderr(), 'UI uiButLoadStim\n')
dmattek's avatar
Added:    
dmattek committed
141
    
142
143
    if(input$chBstim)
      actionButton("inButLoadStim", "Load Data")
dmattek's avatar
Added:    
dmattek committed
144
145
  })
  
146

dmattek's avatar
dmattek committed
147
  
dmattek's avatar
dmattek committed
148
  # UI-side-panel-column-selection ----
dmattek's avatar
dmattek committed
149
150
151
  output$varSelTrackLabel = renderUI({
    cat(file = stderr(), 'UI varSelTrackLabel\n')
    locCols = getDataNucCols()
152
    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
153
154
155
    
    selectInput(
      'inSelTrackLabel',
dmattek's avatar
dmattek committed
156
      'Select Track Label (e.g. objNuc_TrackObjects_Label):',
dmattek's avatar
dmattek committed
157
158
159
160
161
162
163
164
165
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
  
  output$varSelTime = renderUI({
    cat(file = stderr(), 'UI varSelTime\n')
    locCols = getDataNucCols()
166
    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
167
168
169
    
    selectInput(
      'inSelTime',
dmattek's avatar
dmattek committed
170
      'Select time column (e.g. Metadata_T, RealTime):',
dmattek's avatar
dmattek committed
171
172
173
174
175
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
176
177
178
179

  output$varSelTimeFreq = renderUI({
    cat(file = stderr(), 'UI varSelTimeFreq\n')
    
180
181
182
183
184
185
186
187
188
189
    if (input$chBtrajInter) {
      numericInput(
        'inSelTimeFreq',
        'Provide time frequency:',
        min = 1,
        step = 1,
        width = '100%',
        value = 1
      )
    }
190
  })
dmattek's avatar
dmattek committed
191
  
dmattek's avatar
dmattek committed
192
  # This is the main field to select plot facet grouping
dmattek's avatar
dmattek committed
193
  # It's typically a column with the entire experimental description,
dmattek's avatar
dmattek committed
194
195
  # 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
196
197
198
  output$varSelGroup = renderUI({
    cat(file = stderr(), 'UI varSelGroup\n')
    
dmattek's avatar
dmattek committed
199
200
201
202
203
    if (input$chBgroup) {
      
      locCols = getDataNucCols()
      
      if (!is.null(locCols)) {
204
205
206
        locColSel = locCols[grep('(G|g)roup|(S|s)tim_All|(S|s)timulation|(S|s)ite', locCols)[1]]

        #cat('UI varSelGroup::locColSel ', locColSel, '\n')
dmattek's avatar
dmattek committed
207
208
209
210
211
212
213
214
        selectInput(
          'inSelGroup',
          'Select one or more facet groupings (e.g. Site, Well, Channel):',
          locCols,
          width = '100%',
          selected = locColSel,
          multiple = TRUE
        )
dmattek's avatar
dmattek committed
215
216
217
218
219
220
221
      }
    }
  })
  
  output$varSelSite = renderUI({
    cat(file = stderr(), 'UI varSelSite\n')
    
222
    if (input$chBtrackUni) {
dmattek's avatar
Added:    
dmattek committed
223
      locCols = getDataNucCols()
224
      locColSel = locCols[grep('(S|s)ite|(S|s)eries', locCols)[1]] # index 1 at the end in case more matches; select 1st
dmattek's avatar
Added:    
dmattek committed
225
226
227
228
229
230
231
232
233
      
      selectInput(
        'inSelSite',
        'Select FOV (e.g. Metadata_Site or Metadata_Series):',
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
dmattek's avatar
dmattek committed
234
235
236
237
238
239
240
241
  })
  
  
  output$varSelMeas1 = renderUI({
    cat(file = stderr(), 'UI varSelMeas1\n')
    locCols = getDataNucCols()
    
    if (!is.null(locCols)) {
242
      locColSel = locCols[grep('objCyto_Intensity_MeanIntensity_imErkCor|(R|r)atio|(I|i)ntensity|y', locCols)[1]] # index 1 at the end in case more matches; select 1st
dmattek's avatar
dmattek committed
243

dmattek's avatar
dmattek committed
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
      selectInput(
        'inSelMeas1',
        'Select 1st measurement:',
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
  })
  
  
  output$varSelMeas2 = renderUI({
    cat(file = stderr(), 'UI varSelMeas2\n')
    locCols = getDataNucCols()
    
    if (!is.null(locCols) &&
        !(input$inSelMath %in% c('', '1 / '))) {
261
      locColSel = locCols[grep('objNuc_Intensity_MeanIntensity_imErkCor', locCols)[1]] # index 1 at the end in case more matches; select 1st
dmattek's avatar
dmattek committed
262

dmattek's avatar
dmattek committed
263
264
265
266
267
268
269
270
271
272
      selectInput(
        'inSelMeas2',
        'Select 2nd measurement',
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
  })
  
dmattek's avatar
dmattek committed
273
  # UI-side-panel-trim x-axis (time) ----
dmattek's avatar
dmattek committed
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
  output$uiSlTimeTrim = renderUI({
    cat(file = stderr(), 'UI uiSlTimeTrim\n')
    
    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
297
  
dmattek's avatar
dmattek committed
298
  # UI-side-panel-normalization ----
dmattek's avatar
dmattek committed
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
  output$uiChBnorm = renderUI({
    cat(file = stderr(), 'UI uiChBnorm\n')
    
    if (input$chBnorm) {
      radioButtons(
        'rBnormMeth',
        label = 'Select method',
        choices = list('fold-change' = 'mean', 'z-score' = 'z.score')
      )
    }
  })
  
  output$uiSlNorm = renderUI({
    cat(file = stderr(), 'UI uiSlNorm\n')
    
    if (input$chBnorm) {
      locTpts  = getDataTpts()
      
      if(is.null(locTpts))
        return(NULL)
      
      locRTmin = min(locTpts)
      locRTmax = max(locTpts)
      
      sliderInput(
        'slNormRtMinMax',
        label = 'Time range for norm.',
        min = locRTmin,
        max = locRTmax,
dmattek's avatar
dmattek committed
328
329
        value = c(locRTmin, 0.1 * locRTmax), 
        step = 1
dmattek's avatar
dmattek committed
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
      )
    }
  })
  
  output$uiChBnormRobust = renderUI({
    cat(file = stderr(), 'UI uiChBnormRobust\n')
    
    if (input$chBnorm) {
      checkboxInput('chBnormRobust',
                    label = 'Robust stats',
                    FALSE)
    }
  })
  
  output$uiChBnormGroup = renderUI({
    cat(file = stderr(), 'UI uiChBnormGroup\n')
    
    if (input$chBnorm) {
      radioButtons('chBnormGroup',
dmattek's avatar
Mod:    
dmattek committed
349
                   label = 'Normalisation grouping',
350
                   choices = list('Entire dataset' = 'none', 'Per facet' = 'group', 'Per trajectory' = 'id'))
dmattek's avatar
dmattek committed
351
352
353
354
    }
  })
  
  
dmattek's avatar
dmattek committed
355
  # UI-main-tab-remove-outliers ----
dmattek's avatar
dmattek committed
356
357
358
359
  output$uiSlOutliers = renderUI({
    cat(file = stderr(), 'UI uiSlOutliers\n')
    
    if (input$chBoutliers) {
dmattek's avatar
Mod:    
dmattek committed
360
      
dmattek's avatar
dmattek committed
361
362
363
364
365
      sliderInput(
        'slOutliersPerc',
        label = 'Percentage of middle data',
        min = 90,
        max = 100,
dmattek's avatar
Fixed:    
dmattek committed
366
        value = 99.5, 
dmattek's avatar
dmattek committed
367
368
        step = 0.1
      )
dmattek's avatar
dmattek committed
369
      
dmattek's avatar
Mod:    
dmattek committed
370
      
dmattek's avatar
dmattek committed
371
372
373
    }
  })
  
dmattek's avatar
dmattek committed
374
375
376
377
378
379
380
381
382
383
384
385
386
387
  output$uiTxtOutliers = renderUI({
    cat(file = stderr(), 'UI uiTxtOutliers\n')
    
    if (input$chBoutliers) {
      htmlOutput(
        'txtOutliersPerc'
      )
    }
  })
  
  output$txtOutliersPerc <- renderText({ 
    sprintf('<b>#tracks: %d <br>#outliers: %d</b>', 
            nCellsCounter[['nCellsOrig']], 
            nCellsCounter[['nCellsOrig']] - nCellsCounter[['nCellsAfterOutlierTrim']])  })
dmattek's avatar
dmattek committed
388
  
dmattek's avatar
dmattek committed
389

dmattek's avatar
dmattek committed
390
  # Processing-data ----
dmattek's avatar
dmattek committed
391
  
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
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
    
    cat(
      "dataInBoth\ninGen1: ",
      locInGen1,
      "   prev=",
      isolate(counter$dataGen1),
      "\ninDataNuc: ",
      locInLoadNuc,
      "   prev=",
      isolate(counter$dataLoadNuc),
      # "\ninDataStim: ",
      # locInLoadStim,
      # "   prev=",
      # isolate(counter$dataLoadStim),
      "\n"
    )
    
    # isolate the checks of counter reactiveValues
    # as we set the values in this same reactive
    if (locInGen1 != isolate(counter$dataGen1)) {
      cat("dataInBoth if inDataGen1\n")
      dm = dataGen1()
      # no need to isolate updating the counter reactive values!
      counter$dataGen1 <- locInGen1
    } else if (locInLoadNuc != isolate(counter$dataLoadNuc)) {
      cat("dataInBoth if inDataLoadNuc\n")
      dm = dataLoadNuc()
      # no need to isolate updating the counter reactive values!
      counter$dataLoadNuc <- locInLoadNuc
    } else {
      cat("dataInBoth else\n")
      dm = NULL
    }
    return(dm)
  })
  
  # return column names of the main dt
dmattek's avatar
dmattek committed
440
  getDataNucCols <- reactive({
441
442
443
444
445
446
447
448
449
450
451
    cat(file = stderr(), 'getDataNucCols: in\n')
    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({
dmattek's avatar
dmattek committed
452
    cat(file = stderr(), 'dataMod\n')
453
454
    loc.dt = dataInBoth()
    
dmattek's avatar
dmattek committed
455
    if (is.null(loc.dt))
456
457
      return(NULL)
    
458
    if (input$chBtrackUni) {
dmattek's avatar
Added:    
dmattek committed
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
      loc.types = lapply(loc.dt, class)
      if(loc.types[[input$inSelTrackLabel]] %in% c('numeric', 'integer') & loc.types[[input$inSelSite]] %in% c('numeric', 'integer'))
      {
        loc.dt[, trackObjectsLabelUni := paste(sprintf("%03d", get(input$inSelSite)),
                                               sprintf("%04d", get(input$inSelTrackLabel)),
                                               sep = "_")]
      } else if(loc.types[[input$inSelTrackLabel]] %in% c('numeric', 'integer')) {
        loc.dt[, trackObjectsLabelUni := paste(sprintf("%s", get(input$inSelSite)),
                                               sprintf("%04d", get(input$inSelTrackLabel)),
                                               sep = "_")]
      } else if(loc.types[[input$inSelSite]] %in% c('numeric', 'integer')) {
        loc.dt[, trackObjectsLabelUni := paste(sprintf("%03d", get(input$inSelSite)),
                                               sprintf("%s", get(input$inSelTrackLabel)),
                                               sep = "_")]
      } else {
        loc.dt[, trackObjectsLabelUni := paste(sprintf("%s", get(input$inSelSite)),
                                               sprintf("%s", get(input$inSelTrackLabel)),
                                               sep = "_")]
      }
dmattek's avatar
Added:    
dmattek committed
478
    } else {
dmattek's avatar
Added:    
dmattek committed
479
      loc.dt[, trackObjectsLabelUni := get(input$inSelTrackLabel)]
dmattek's avatar
Added:    
dmattek committed
480
481
    }
    
dmattek's avatar
dmattek committed
482
    
dmattek's avatar
Added:    
dmattek committed
483
484
485
486
487
488
    # remove trajectories based on uploaded csv

    if (input$chBtrajRem) {
      cat(file = stderr(), 'dataMod: trajRem not NULL\n')
      
      loc.dt.rem = dataLoadTrajRem()
dmattek's avatar
dmattek committed
489
      loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
dmattek's avatar
Added:    
dmattek committed
490
491
    }
    
492
493
494
    return(loc.dt)
  })
  
dmattek's avatar
dmattek committed
495
496
497
498
499
  # return all unique track object labels (created in dataMod)
  # This will be used to display in UI for trajectory highlighting
  getDataTrackObjLabUni <- reactive({
    cat(file = stderr(), 'getDataTrackObjLabUni\n')
    loc.dt = dataMod()
500
    
dmattek's avatar
dmattek committed
501
502
503
504
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt$trackObjectsLabelUni))
505
506
  })
  
dmattek's avatar
Mod:    
dmattek committed
507
  
dmattek's avatar
dmattek committed
508
509
510
  # 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
511
512
513
  getDataTpts <- reactive({
    cat(file = stderr(), 'getDataTpts\n')
    loc.dt = dataMod()
514
    
dmattek's avatar
dmattek committed
515
516
517
518
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt[[input$inSelTime]]))
519
520
  })
  
dmattek's avatar
dmattek committed
521
  
522
523
524
  
  # prepare data for plotting time courses
  # returns dt with these columns:
dmattek's avatar
dmattek committed
525
  #    realtime - selected from input
dmattek's avatar
dmattek committed
526
  #    y        - measurement selected from input
dmattek's avatar
dmattek committed
527
  #               (can be a single column or result of an operation on two cols)
528
529
  #    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
530
531
  #    group    - grouping variable for facetting from input
  #    mid.in   - column with trajectory selection status from the input file or
532
533
534
535
  #               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
536
  data4trajPlot <- reactive({
dmattek's avatar
dmattek committed
537
    cat(file = stderr(), 'data4trajPlot\n')
538
539
    
    loc.dt = dataMod()
dmattek's avatar
dmattek committed
540
    if (is.null(loc.dt))
541
542
      return(NULL)
    
543
    # create expression for 'y' column based on measurements and math operations selected in UI
dmattek's avatar
dmattek committed
544
    if (input$inSelMath == '')
545
546
547
548
549
550
      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)
    
551
    # create expression for 'group' column
552
553
    # creates a merged column based on other columns from input
    # used for grouping of plot facets
dmattek's avatar
dmattek committed
554
555
556
557
558
559
560
561
562
563
564
    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')"
    }
565
    
dmattek's avatar
dmattek committed
566
567

    # column name with time
568
569
    loc.s.rt = input$inSelTime
    
dmattek's avatar
dmattek committed
570
571
    # Assign tracks selected for highlighting in UI
    loc.tracks.highlight = input$inSelHighlight
572
    locButHighlight = input$chBhighlightTraj
dmattek's avatar
dmattek committed
573
    
dmattek's avatar
Added:    
dmattek committed
574
575
    
    # Find column names with position
576
    loc.s.pos.x = names(loc.dt)[grep('(L|l)ocation.*X|(P|p)os.x|(P|p)osx', names(loc.dt))[1]]
577
    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
578
    
579
    cat('Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n')
580
581
    
    if (!is.na(loc.s.pos.x) & !is.na(loc.s.pos.y))
dmattek's avatar
Added:    
dmattek committed
582
583
584
585
      locPos = TRUE
    else
      locPos = FALSE
    
586
587
588
589
    
    # Find column names with ObjectNumber
    # This is different from TrackObject_Label and is handy to keep
    # because labels on segmented images are typically ObjectNumber
590
591
592
593
594
595
    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
596
      loc.s.objnum = loc.s.objnum[1]
597
      locObjNum = TRUE
dmattek's avatar
dmattek committed
598
    }
599
600
    
    
601
602
    # if dataset contains column mid.in with trajectory filtering status,
    # then, include it in plotting
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
    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))]
    
    
    # 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
645
        # add a column with status of track selection
646
        loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')]
647
    }
648
      
dmattek's avatar
dmattek committed
649

650
    ## Interpolate missing data and NA data points
651
    # From: https://stackoverflow.com/questions/28073752/r-how-to-add-rows-for-missing-values-for-unique-group-sequences
652
653
654
    # Tracks are interpolated only within first and last time points of every cell id
    # 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.
655
    # Therefore, we cannot rely on that info to get time frequency; user provides this number!
656
    
657
658
    setkey(loc.out, group, id, realtime)

659
660
    if (input$chBtrajInter) {
      # here we fill missing data with NA's
dmattek's avatar
dmattek committed
661
      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'))]
662
663
664
665
666
667
668
669
      
      # x-check: print all rows with NA's
      print('Rows with NAs:')
      print(loc.out[rowSums(is.na(loc.out)) > 0, ])
      
      # NA's may be already present in the dataset'.
      # Interpolate (linear) them with na.interpolate as well
      if(locPos)
dmattek's avatar
dmattek committed
670
        s.cols = c(COLY, COLPOSX, COLPOSY)
671
      else
dmattek's avatar
dmattek committed
672
        s.cols = c(COLY)
673
      
dmattek's avatar
dmattek committed
674
      loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = c(COLID), .SDcols = s.cols]
675
676
677
678
679
680
681
682
683
684
685
686
687
688
      
      
      # !!! 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
689
    
690
    ## Trim x-axis (time)
dmattek's avatar
dmattek committed
691
    if(input$chBtimeTrim) {
dmattek's avatar
dmattek committed
692
      loc.out = loc.out[get(COLRT) >= input$slTimeTrim[[1]] & get(COLRT) <= input$slTimeTrim[[2]] ]
dmattek's avatar
dmattek committed
693
    }
dmattek's avatar
dmattek committed
694
    
695
    ## Normalization
dmattek's avatar
dmattek committed
696
    # F-n normTraj adds additional column with .norm suffix
dmattek's avatar
dmattek committed
697
    if (input$chBnorm) {
dmattek's avatar
dmattek committed
698
      loc.out = LOCnormTraj(
dmattek's avatar
dmattek committed
699
        in.dt = loc.out,
dmattek's avatar
dmattek committed
700
701
        in.meas.col = COLY,
        in.rt.col = COLRT,
dmattek's avatar
dmattek committed
702
703
704
705
706
707
708
        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
709
710
      # Column with normalized data is renamed to the original name
      # Further code assumes column name y produced by data4trajPlot
dmattek's avatar
dmattek committed
711
712
      loc.out[, get(COLY) := NULL]
      setnames(loc.out, 'y.norm', COLY)
dmattek's avatar
dmattek committed
713
714
715
    }
    
    return(loc.out)
dmattek's avatar
dmattek committed
716
717
  })
  
dmattek's avatar
dmattek committed
718
719
720
721
722
723
724
725
  
  # prepare data for clustering
  # return a matrix with:
  # cells as columns
  # time points as rows
  data4clust <- reactive({
    cat(file = stderr(), 'data4clust\n')
    
dmattek's avatar
dmattek committed
726
    loc.dt = data4trajPlotNoOut()
dmattek's avatar
dmattek committed
727
728
729
    if (is.null(loc.dt))
      return(NULL)
    
dmattek's avatar
Added:    
dmattek committed
730
    #print(loc.dt)
dmattek's avatar
dmattek committed
731
    loc.out = dcast(loc.dt, id ~ realtime, value.var = 'y')
dmattek's avatar
Added:    
dmattek committed
732
    #print(loc.out)
dmattek's avatar
dmattek committed
733
734
    loc.rownames = loc.out$id
    
dmattek's avatar
Mod:    
dmattek committed
735
    
dmattek's avatar
dmattek committed
736
737
    loc.out = as.matrix(loc.out[, -1])
    rownames(loc.out) = loc.rownames
dmattek's avatar
Added:    
dmattek committed
738
    
739
740
    # This might be removed entirely because all NA treatment happens in data4trajPlot
    # Clustering should work with NAs present. These might result from data itself or from missing time point rows that were turned into NAs when dcast-ing from long format.
dmattek's avatar
Added:    
dmattek committed
741
742
743
744
    # Remove NA's
    # na.interpolation from package imputeTS works with multidimensional data
    # but imputation is performed for each column independently
    # The matrix for clustering contains time series in rows, hence transposing it twice
745
    # loc.out = t(na.interpolation(t(loc.out)))
dmattek's avatar
Added:    
dmattek committed
746
    
dmattek's avatar
dmattek committed
747
    return(loc.out)
dmattek's avatar
Mod:    
dmattek committed
748
  }) 
dmattek's avatar
dmattek committed
749
  
dmattek's avatar
dmattek committed
750
  
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
  # prepare data with stimulation pattern
  # this dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment
  data4stimPlot <- reactive({
    cat(file = stderr(), 'data4stimPlot\n')
    
    if (input$chBstim) {
      cat(file = stderr(), 'data4stimPlot: stim not NULL\n')
      
      loc.dt.stim = dataLoadStim()
      return(loc.dt.stim)
    } else {
      cat(file = stderr(), 'data4stimPlot: stim is NULL\n')
      return(NULL)
    }
  })
  
dmattek's avatar
Added:    
dmattek committed
767
768
769
  # download data as prepared for plotting
  # after all modification
  output$downloadDataClean <- downloadHandler(
dmattek's avatar
dmattek committed
770
    filename = FCSVTCCLEAN,
dmattek's avatar
Added:    
dmattek committed
771
    content = function(file) {
dmattek's avatar
dmattek committed
772
      write.csv(data4trajPlotNoOut(), file, row.names = FALSE)
dmattek's avatar
Added:    
dmattek committed
773
774
775
    }
  )
  
dmattek's avatar
dmattek committed
776
777
778
  # Plotting-trajectories ----

  # UI for selecting trajectories
779
  # The output data table of data4trajPlot is modified based on inSelHighlight field
dmattek's avatar
dmattek committed
780
781
  output$varSelHighlight = renderUI({
    cat(file = stderr(), 'UI varSelHighlight\n')
dmattek's avatar
dmattek committed
782
    
dmattek's avatar
dmattek committed
783
784
785
    locBut = input$chBhighlightTraj
    if (!locBut)
      return(NULL)
dmattek's avatar
dmattek committed
786
    
dmattek's avatar
dmattek committed
787
    loc.v = getDataTrackObjLabUni()
dmattek's avatar
dmattek committed
788
    if (!is.null(loc.v)) {
789
      selectInput(
dmattek's avatar
dmattek committed
790
791
792
        'inSelHighlight',
        'Select one or more rajectories:',
        loc.v,
793
        width = '100%',
dmattek's avatar
dmattek committed
794
        multiple = TRUE
795
      )
dmattek's avatar
dmattek committed
796
797
798
    }
  })
  
dmattek's avatar
dmattek committed
799
800
801
  # Taking out outliers 
  data4trajPlotNoOut = callModule(modSelOutliers, 'returnOutlierIDs', data4trajPlot)
  
dmattek's avatar
dmattek committed
802
803
  # Trajectory plotting - ribbon
  callModule(modTrajRibbonPlot, 'modTrajRibbon', 
dmattek's avatar
dmattek committed
804
             in.data = data4trajPlotNoOut,
dmattek's avatar
dmattek committed
805
             in.data.stim = data4stimPlot,
dmattek's avatar
dmattek committed
806
             in.fname = function() return(FPDFTCMEAN))
dmattek's avatar
dmattek committed
807
  
dmattek's avatar
dmattek committed
808
  # Trajectory plotting - individual
dmattek's avatar
dmattek committed
809
  callModule(modTrajPlot, 'modTrajPlot', 
dmattek's avatar
dmattek committed
810
             in.data = data4trajPlotNoOut, 
dmattek's avatar
dmattek committed
811
             in.data.stim = data4stimPlot,
dmattek's avatar
dmattek committed
812
             in.fname = function() {return(FPDFTCSINGLE)})
dmattek's avatar
dmattek committed
813
814
815
  
  
  # Tabs ----
816
  ###### AUC calculation and plotting
dmattek's avatar
dmattek committed
817
  callModule(modAUCplot, 'tabAUC', data4trajPlotNoOut, in.fname = function() return(FPDFBOXAUC))
dmattek's avatar
Added:    
dmattek committed
818
  
dmattek's avatar
Added:    
dmattek committed
819
  ###### Box-plot
dmattek's avatar
dmattek committed
820
  callModule(tabBoxPlot, 'tabBoxPlot', data4trajPlotNoOut, in.fname = function() return(FPDFBOXTP))
dmattek's avatar
dmattek committed
821
  
dmattek's avatar
dmattek committed
822
  ###### Scatter plot
dmattek's avatar
dmattek committed
823
  callModule(tabScatterPlot, 'tabScatter', data4trajPlotNoOut, in.fname = function() return(FPDFSCATTER))
dmattek's avatar
dmattek committed
824
  
dmattek's avatar
dmattek committed
825
  ##### Hierarchical clustering
dmattek's avatar
dmattek committed
826
  callModule(clustHier, 'tabClHier', data4clust, data4trajPlotNoOut, data4stimPlot)
dmattek's avatar
dmattek committed
827
828
  
  ##### Sparse hierarchical clustering using sparcl
dmattek's avatar
dmattek committed
829
  callModule(clustHierSpar, 'tabClHierSpar', data4clust, data4trajPlotNoOut, data4stimPlot)
dmattek's avatar
dmattek committed
830

dmattek's avatar
Mod:    
dmattek committed
831
  
dmattek's avatar
dmattek committed
832
})