server.R 31.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
library(dtw) # for dynamic time warping
dmattek's avatar
dmattek committed
26
library(factoextra) # extract and visualize the output of multivariate data analyses 
dmattek's avatar
Added:    
dmattek committed
27
library(imputeTS) # for interpolating NAs
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
28
29
library(robust) # for robust linear regression
library(MASS)
dmattek's avatar
dmattek committed
30
31
library(pracma) # for trapz used in AUC calculation

Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
32

dmattek's avatar
dmattek committed
33

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

dmattek's avatar
dmattek committed
38
39
40
41
42
# Important when joining, grouping or ordering numeric (i.e. double, POSIXct) columns.
# https://stackoverflow.com/questions/58230619/xy-join-of-keyed-data-table-fails-when-key-on-numeric-column-and-data-fread-fr
setNumericRounding(2)


dmattek's avatar
dmattek committed
43
44
45
# colour of loader spinner (shinycssloaders)
options(spinner.color="#00A8AA")

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

  nCellsCounter <- reactiveValues(
    nCellsOrig = 0,
    nCellsAfterOutlierTrim = 0
  )
    
  myReactVals = reactiveValues(
    outlierIDs = NULL
  )
dmattek's avatar
dmattek committed
69
  
dmattek's avatar
dmattek committed
70
  # UI-side-panel-data-load ----
dmattek's avatar
dmattek committed
71
  
dmattek's avatar
dmattek committed
72
  # Generate random dataset
73
  dataGen1 <- eventReactive(input$inDataGen1, {
74
    if (DEB)
75
      cat("server:dataGen1\n")
76
    
dmattek's avatar
dmattek committed
77
    return(LOCgenTraj2(n_perGroup = 20, sd_noise = 0.01, sampleFreq = 0.4, endTime = 40))
78
79
  })
  
dmattek's avatar
dmattek committed
80
  # Load main data file
81
  dataLoadNuc <- eventReactive(input$inButLoadNuc, {
82
    if (DEB)
83
      cat("server:dataLoadNuc\n")
84

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

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

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

dmattek's avatar
dmattek committed
177
  
dmattek's avatar
dmattek committed
178
  # UI-side-panel-column-selection ----
dmattek's avatar
dmattek committed
179
  output$varSelTrackLabel = renderUI({
180
    if (DEB)
181
      cat(file = stdout(), 'server:varSelTrackLabel\n')
182
    
dmattek's avatar
dmattek committed
183
    locCols = getDataNucCols()
184
    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
185
186
187
    
    selectInput(
      'inSelTrackLabel',
dmattek's avatar
dmattek committed
188
      'Track ID column',
dmattek's avatar
dmattek committed
189
190
191
192
193
194
195
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
  
  output$varSelTime = renderUI({
196
    if (DEB)
197
      cat(file = stdout(), 'server:varSelTime\n')
198
    
dmattek's avatar
dmattek committed
199
    locCols = getDataNucCols()
200
    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
201
202
203
    
    selectInput(
      'inSelTime',
dmattek's avatar
dmattek committed
204
      'Time column',
dmattek's avatar
dmattek committed
205
206
207
208
209
      locCols,
      width = '100%',
      selected = locColSel
    )
  })
210
211

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

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

dmattek's avatar
dmattek committed
285
286
      selectInput(
        'inSelMeas1',
dmattek's avatar
dmattek committed
287
        '1st measurement column',
dmattek's avatar
dmattek committed
288
289
290
291
292
293
294
295
296
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
  })
  
  
  output$varSelMeas2 = renderUI({
297
    if (DEB)
298
      cat(file = stdout(), 'server:varSelMeas2\n')
299
    
dmattek's avatar
dmattek committed
300
301
302
303
    locCols = getDataNucCols()
    
    if (!is.null(locCols) &&
        !(input$inSelMath %in% c('', '1 / '))) {
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
304
      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
305

dmattek's avatar
dmattek committed
306
307
      selectInput(
        'inSelMeas2',
dmattek's avatar
dmattek committed
308
        '2nd measurement column',
dmattek's avatar
dmattek committed
309
310
311
312
313
314
315
        locCols,
        width = '100%',
        selected = locColSel
      )
    }
  })
  
dmattek's avatar
dmattek committed
316
  # UI-side-panel-trim x-axis (time) ----
317
  
dmattek's avatar
dmattek committed
318
  output$uiSlTimeTrim = renderUI({
319
    if (DEB)
320
      cat(file = stdout(), 'server:uiSlTimeTrim\n')
dmattek's avatar
dmattek committed
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',
dmattek's avatar
dmattek committed
333
        label = 'Use time range',
dmattek's avatar
dmattek committed
334
335
336
337
338
339
340
        min = locRTmin,
        max = locRTmax,
        value = c(locRTmin, locRTmax),
        step = 1
      )
      
    }
341
342
343
344
345
346
347
  }) 
  
  # Return the value of slider for trimming time; 
  # output delayed by MILLIS
  returnValSlTimeTrim = reactive({
    return(input$slTimeTrim)
  }) %>% debounce(MILLIS)
dmattek's avatar
dmattek committed
348
  
dmattek's avatar
dmattek committed
349
  # UI-side-panel-normalization ----
350
351
352
353
  
  # 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
354
  output$uiChBnorm = renderUI({
355
    if (DEB)
356
      cat(file = stdout(), 'server:uiChBnorm\n')
dmattek's avatar
dmattek committed
357
358
    
    if (input$chBnorm) {
359
      tagList(
dmattek's avatar
dmattek committed
360
361
362
      radioButtons(
        'rBnormMeth',
        label = 'Select method',
363
364
365
        choices = list('fold-change' = 'mean', 'z-score' = 'z.score'),
        width = "40%"
      ),
dmattek's avatar
dmattek committed
366
      bsTooltip('rBnormMeth', helpText.server[["rBnormMeth"]], placement = "top", trigger = "hover", options = NULL)
dmattek's avatar
dmattek committed
367
368
369
370
      )
    }
  })
  
371
  # select the region of the time series for normalisation
dmattek's avatar
dmattek committed
372
  output$uiSlNorm = renderUI({
373
    if (DEB)
374
      cat(file = stdout(), 'server:uiSlNorm\n')
dmattek's avatar
dmattek committed
375
376
377
378
379
380
381
382
383
384
    
    if (input$chBnorm) {
      locTpts  = getDataTpts()
      
      if(is.null(locTpts))
        return(NULL)
      
      locRTmin = min(locTpts)
      locRTmax = max(locTpts)
      
385
      tagList(
dmattek's avatar
dmattek committed
386
387
      sliderInput(
        'slNormRtMinMax',
388
        label = 'Time span',
dmattek's avatar
dmattek committed
389
390
        min = locRTmin,
        max = locRTmax,
dmattek's avatar
dmattek committed
391
392
        value = c(locRTmin, 0.1 * locRTmax), 
        step = 1
393
      ),
dmattek's avatar
dmattek committed
394
      bsTooltip('slNormRtMinMax', helpText.server[["slNormRtMinMax"]], placement = "top", trigger = "hover", options = NULL)
dmattek's avatar
dmattek committed
395
396
397
398
      )
    }
  })
  
399
400
401
402
403
404
405
  # Return the value of slider for normalisation time; 
  # output delayed by MILLIS
  returnValSlNormRtMinMax = reactive({
    return(input$slNormRtMinMax)
  }) %>% debounce(MILLIS)
  
  
406
  # use robust stats (median instead of mean, mad instead of sd)
dmattek's avatar
dmattek committed
407
  output$uiChBnormRobust = renderUI({
408
    if (DEB)
409
      cat(file = stdout(), 'server:uiChBnormRobust\n')
dmattek's avatar
dmattek committed
410
411
    
    if (input$chBnorm) {
412
      tagList(
dmattek's avatar
dmattek committed
413
414
      checkboxInput('chBnormRobust',
                    label = 'Robust stats',
415
416
                    FALSE, 
                    width = "40%"),
dmattek's avatar
dmattek committed
417
      bsTooltip('chBnormRobust', helpText.server[["chBnormRobust"]], placement = "top", trigger = "hover", options = NULL)
418
      )
dmattek's avatar
dmattek committed
419
420
421
    }
  })
  
422
  # choose whether normalisation should be calculated for the entire dataset, group, or trajectory
dmattek's avatar
dmattek committed
423
  output$uiChBnormGroup = renderUI({
424
    if (DEB)
425
      cat(file = stdout(), 'server:uiChBnormGroup\n')
dmattek's avatar
dmattek committed
426
427
    
    if (input$chBnorm) {
428
      tagList(
dmattek's avatar
dmattek committed
429
      radioButtons('chBnormGroup',
dmattek's avatar
Mod:    
dmattek committed
430
                   label = 'Normalisation grouping',
431
432
                   choices = list('Entire dataset' = 'none', 'Per group' = 'group', 'Per trajectory' = 'id'), 
                   width = "40%"),
dmattek's avatar
dmattek committed
433
      bsTooltip('chBnormGroup', helpText.server[["chBnormGroup"]], placement = "top", trigger = "hover", options = NULL)
434
      )
dmattek's avatar
dmattek committed
435
436
437
438
    }
  })
  
  
439
440
441
442
443
  # Pop-overs ----
  addPopover(session, 
             "alDataFormat",
             title = "Data format",
             content = helpText.server[["alDataFormat"]],
dmattek's avatar
dmattek committed
444
             trigger = "click")
dmattek's avatar
dmattek committed
445
  
dmattek's avatar
dmattek committed
446

dmattek's avatar
dmattek committed
447
  # Processing-data ----
dmattek's avatar
dmattek committed
448
  
449
  # Obtain data either from an upload or by generating a synthetic dataset
450
451
452
453
454
455
456
457
458
459
460
461
  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
    
462
    # Don't wrap around if(DEB) !!!
463
    cat(
464
      "server:dataInBoth\n   inGen1: ",
465
      locInGen1,
466
      "      prev=",
467
      isolate(counter$dataGen1),
468
      "\n   inDataNuc: ",
469
470
471
472
473
474
475
476
477
478
      locInLoadNuc,
      "   prev=",
      isolate(counter$dataLoadNuc),
      # "\ninDataStim: ",
      # locInLoadStim,
      # "   prev=",
      # isolate(counter$dataLoadStim),
      "\n"
    )
    
479
    # isolate the checks of the counter reactiveValues
480
481
    # as we set the values in this same reactive
    if (locInGen1 != isolate(counter$dataGen1)) {
482
      cat("server:dataInBoth if inDataGen1\n")
483
484
485
486
      dm = dataGen1()
      # no need to isolate updating the counter reactive values!
      counter$dataGen1 <- locInGen1
    } else if (locInLoadNuc != isolate(counter$dataLoadNuc)) {
487
      cat("server:dataInBoth if inDataLoadNuc\n")
488
      dm = dataLoadNuc()
489
490
491
      
      # convert to long format if radio box set to "wide"
      # the input data in long format should contain:
492
      # - the first row with a header: group, track id, time points as columns with numeric header
493
494
      # - consecutive rows with time series, where columns are time points
      if (input$inRbutLongWide == 1) {
495
496
497
498
499
500
501
502
503
504
505
506
        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")
          
507

508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
        } 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")
          }
        }
541
542
      }
      
543
544
545
      # no need to isolate updating the counter reactive values!
      counter$dataLoadNuc <- locInLoadNuc
    } else {
546
      cat("server:dataInBoth else\n")
547
548
      dm = NULL
    }
549
    
550
551
552
    return(dm)
  })
  
553
554
555
  # Return a dt with mods depending on UI options::
  # - an added column with unique track object label created from the existing track id and prepended with columns chosen in the UI
  # - removed track IDs based on a separate file uploaded; the file should contain a single column with a header and unique track IDs
556
  dataMod <- reactive({
557
    if (DEB)
558
      cat(file = stdout(), 'server:dataMod\n')
559
    
560
561
    loc.dt = dataInBoth()
    
dmattek's avatar
dmattek committed
562
    if (is.null(loc.dt))
563
564
      return(NULL)
    
565
    if (input$chBtrackUni) {
566
      # create unique track ID based on columns specified in input$inSelSite field and combine with input$inSelTrackLabel
567
      loc.dt[, (COLIDUNI) := do.call(paste, c(.SD, sep = "_")), .SDcols = c(input$inSelSite, input$inSelTrackLabel) ]
dmattek's avatar
Added:    
dmattek committed
568
    } else {
569
      # Leave track ID provided in the loaded dataset; has to be unique
570
      loc.dt[, (COLIDUNI) := get(input$inSelTrackLabel)]
dmattek's avatar
Added:    
dmattek committed
571
572
    }
    
dmattek's avatar
Added:    
dmattek committed
573
574
    # remove trajectories based on uploaded csv
    if (input$chBtrajRem) {
575
      if (DEB)
576
        cat(file = stdout(), 'server:dataMod: trajRem not NULL\n')
dmattek's avatar
Added:    
dmattek committed
577
578
      
      loc.dt.rem = dataLoadTrajRem()
dmattek's avatar
dmattek committed
579
      loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
dmattek's avatar
Added:    
dmattek committed
580
581
    }
    
582
583
584
585
586
    return(loc.dt)
  })
  
  # prepare data for plotting time courses
  # returns dt with these columns:
dmattek's avatar
dmattek committed
587
  #    realtime - selected from input
dmattek's avatar
dmattek committed
588
  #    y        - measurement selected from input
dmattek's avatar
dmattek committed
589
  #               (can be a single column or result of an operation on two cols)
590
591
  #    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
592
593
  #    group    - grouping variable for facetting from input
  #    mid.in   - column with trajectory selection status from the input file or
594
595
596
597
  #               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
598
  dataLong <- reactive({
599
    if (DEB)
600
      cat(file = stdout(), 'server:dataLong\n')
601
602
    
    loc.dt = dataMod()
dmattek's avatar
dmattek committed
603
    if (is.null(loc.dt))
604
605
      return(NULL)
    
606
    # create expression for 'y' column based on measurements and math operations selected in UI
dmattek's avatar
dmattek committed
607
    if (input$inSelMath == '')
608
609
610
611
612
613
      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)
    
614
    # create expression for 'group' column
615
616
    # creates a merged column based on other columns from input
    # used for grouping of plot facets
dmattek's avatar
dmattek committed
617
618
619
620
621
622
623
624
625
626
627
    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')"
    }
628
    
dmattek's avatar
dmattek committed
629
630

    # column name with time
631
632
    loc.s.rt = input$inSelTime
    
dmattek's avatar
dmattek committed
633
634
    # Assign tracks selected for highlighting in UI
    loc.tracks.highlight = input$inSelHighlight
635
    locButHighlight = input$chBhighlightTraj
dmattek's avatar
dmattek committed
636
    
dmattek's avatar
Added:    
dmattek committed
637
638
    
    # Find column names with position
639
    loc.s.pos.x = names(loc.dt)[grep('(L|l)ocation.*X|(P|p)os.x|(P|p)osx', names(loc.dt))[1]]
640
    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
641
    
642
    if (DEB)
643
      cat('server:dataLong:\n   Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n')
644
645
    
    if (!is.na(loc.s.pos.x) & !is.na(loc.s.pos.y))
dmattek's avatar
Added:    
dmattek committed
646
647
648
649
      locPos = TRUE
    else
      locPos = FALSE
    
650
651
652
653
    
    # Find column names with ObjectNumber
    # This is different from TrackObject_Label and is handy to keep
    # because labels on segmented images are typically ObjectNumber
654
    loc.s.objnum = names(loc.dt)[grep('(O|o)bject(N|n)umber', names(loc.dt))[1]]
655
    #cat('dataLong::loc.s.objnum ', loc.s.objnum, '\n')
656
657
658
659
    if (is.na(loc.s.objnum)) {
      locObjNum = FALSE
    }
    else {
dmattek's avatar
dmattek committed
660
      loc.s.objnum = loc.s.objnum[1]
661
      locObjNum = TRUE
dmattek's avatar
dmattek committed
662
    }
663
664
    
    
665
666
    # if dataset contains column mid.in with trajectory filtering status,
    # then, include it in plotting
dmattek's avatar
dmattek committed
667
    if (sum(names(loc.dt) %in% COLIN) > 0)
668
669
670
671
672
673
      locMidIn = TRUE
    else
      locMidIn = FALSE
    
    ## Build expression for selecting columns from loc.dt
    # Core columns
dmattek's avatar
dmattek committed
674
675
676
677
    s.colexpr = paste0('.(',  COLY, ' = ', loc.s.y,
                       ', ', COLID, ' = ', COLIDUNI, 
                       ', ', COLGR, ' = ', loc.s.gr,
                       ', ', COLRT, ' = ', loc.s.rt)
678
679
    
    # account for the presence of 'mid.in' column in uploaded data
dmattek's avatar
dmattek committed
680
    # future: choose this column in UI
681
682
    if(locMidIn)
      s.colexpr = paste0(s.colexpr, 
dmattek's avatar
dmattek committed
683
                         ',', COLIN, ' = ', COLIN)
684
685
686
687
    
    # include position x,y columns in uploaded data
    if(locPos)
      s.colexpr = paste0(s.colexpr, 
dmattek's avatar
dmattek committed
688
689
                         ', ', COLPOSX, '= ', loc.s.pos.x,
                         ', ', COLPOSY, '= ', loc.s.pos.y)
690
691
692
693
    
    # include ObjectNumber column
    if(locObjNum)
      s.colexpr = paste0(s.colexpr, 
dmattek's avatar
dmattek committed
694
                         ', ', COLOBJN, ' = ', loc.s.objnum)
695
696
697
698
699
700
701
    
    # 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))]
    
702
703
704
705
706
    # 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))]
    
707
708
709
710
711
712
    
    # 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
713
        loc.out[, mid.in := ifelse(get(COLID) %in% loc.tracks.highlight, 'SELECTED', get(COLIN))]
714
      else
dmattek's avatar
Mod:    
dmattek committed
715
        # add a column with status of track selection
dmattek's avatar
dmattek committed
716
        loc.out[, mid.in := ifelse(get(COLID) %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')]
717
    }
718
      
dmattek's avatar
dmattek committed
719

720
    ## Interpolate missing data and NA data points
721
    # From: https://stackoverflow.com/questions/28073752/r-how-to-add-rows-for-missing-values-for-unique-group-sequences
722
    # Tracks are interpolated only within first and last time points of every track id
723
724
    # 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.
725
    # Therefore, we cannot rely on that info to get time frequency; user must provide this number!
726
    
727
728
    # Check for explicit NA's in the measurement columns
    # Has to be here (and not in dataMod()) because we need to know the name of the measurement column (COLY)
dmattek's avatar
dmattek committed
729
730
731
732
733
734
735
736
    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")
    
737
    setkeyv(loc.out, c(COLGR, COLID, COLRT))
738

739
    if (input$chBtrajInter) {
dmattek's avatar
dmattek committed
740
741
742
743
744
745
      # here we fill missing rows with NA's
      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'))]
746
747
      
      # x-check: print all rows with NA's
748
      if (DEB) {
749
        cat(file = stdout(), 'server:dataLong: Rows with NAs:\n')
750
751
        print(loc.out[rowSums(is.na(loc.out)) > 0, ])
      }
752
753
754
755
      
      # NA's may be already present in the dataset'.
      # Interpolate (linear) them with na.interpolate as well
      if(locPos)
dmattek's avatar
dmattek committed
756
        s.cols = c(COLY, COLPOSX, COLPOSY)
757
      else
dmattek's avatar
dmattek committed
758
        s.cols = c(COLY)
759
      
760
761
762
763
764
765
766
767
      # 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
768
        loc.out[, (col) := na_interpolation(get(col)), by = c(COLID)]        
769
770
771
      }
      
      # loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = c(COLID), .SDcols = s.cols]
772
773
774
775
776
777
778
779
780
781
782
783
784
785
      
      
      # !!! 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
786
    
787
    ## Trim x-axis (time)
dmattek's avatar
dmattek committed
788
    if(input$chBtimeTrim) {
789
      loc.out = loc.out[get(COLRT) >= returnValSlTimeTrim()[[1]] & get(COLRT) <= returnValSlTimeTrim()[[2]] ]
dmattek's avatar
dmattek committed
790
    }
dmattek's avatar
dmattek committed
791
    
792
    ## Normalization
dmattek's avatar
dmattek committed
793
    # F-n normTraj adds additional column with .norm suffix
dmattek's avatar
dmattek committed
794
    if (input$chBnorm) {
dmattek's avatar
dmattek committed
795
      loc.out = LOCnormTraj(
dmattek's avatar
dmattek committed
796
        in.dt = loc.out,
dmattek's avatar
dmattek committed
797
798
        in.meas.col = COLY,
        in.rt.col = COLRT,
799
800
        in.rt.min = returnValSlNormRtMinMax()[1],
        in.rt.max = returnValSlNormRtMinMax()[2],
dmattek's avatar
dmattek committed
801
802
803
804
805
        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
806
      # Column with normalized data is renamed to the original name
807
      # Further code assumes column name y produced by dataLong
Maciej Dobrzynski's avatar
Maciej Dobrzynski committed
808
809
      
      loc.out[, c(COLY) := NULL]
dmattek's avatar
dmattek committed
810
      setnames(loc.out, 'y.norm', COLY)
dmattek's avatar
dmattek committed
811
812
813
    }
    
    return(loc.out)
dmattek's avatar
dmattek committed
814
815
  })
  
dmattek's avatar
dmattek committed
816
  
817
818
819
820
821
  # Prepare data in wide format, ready for distance calculation in clustering
  # Return a matrix with:
  # - time series as rows
  # - time points as columns
  dataWide <- reactive({
822
    if (DEB)  
823
      cat(file = stdout(), 'server:dataWide\n')
dmattek's avatar
dmattek committed
824
    
825
    loc.dt = dataLongNoOut()
dmattek's avatar
dmattek committed
826
827
828
    if (is.null(loc.dt))
      return(NULL)
    
829
830
831
832
    # 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
833
    
834
835
    # store row names for later
    loc.rownames = loc.dt.wide[[COLID]]
dmattek's avatar
Mod:    
dmattek committed
836
    
837
838
    # omit first column that contains row names
    loc.m.out = as.matrix(loc.dt.wide[, -1])
dmattek's avatar
Added:    
dmattek committed
839
    
840
841
    # assign row names to the matrix
    rownames(loc.m.out) = loc.rownames
dmattek's avatar
Added:    
dmattek committed
842
    
843
844
845
846
847
848
849
850
851
852
853
854
    # Check for missing time points
    # Missing rows in the long format give rise to NAs during dcast
    # Here, we are not checking for explicit NAs in COLY column
    if ((sum(is.na(loc.dt[[COLY]])) == 0) & (sum(is.na(loc.dt.wide)) > 0)) {
      createAlert(session, "alertAnchorSidePanelNAsPresent", "alertNAsPresentLong2WideConv", title = "Warning",
                  content = helpText.server[["alertNAsPresentLong2WideConv"]], 
                  append = FALSE,
                  style = "warning")
    } else {
      closeAlert(session, "alertNAsPresentLong2WideConv")
    }
    
855
    return(loc.m.out)
dmattek's avatar
Mod:    
dmattek committed
856
  }) 
dmattek's avatar
dmattek committed
857
  
dmattek's avatar
dmattek committed
858
  
859
860
861
  # Prepare data with stimulation pattern
  # This dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment
  dataStim <- reactive({
862
    if (DEB)  
863
      cat(file = stdout(), 'server:dataStim\n')
864
865
    
    if (input$chBstim) {
866
      if (DEB)  
867
        cat(file = stdout(), 'server:dataStim: stim not NULL\n')
868
869
870
871
      
      loc.dt.stim = dataLoadStim()
      return(loc.dt.stim)
    } else {
872
      if (DEB)  
873
        cat(file = stdout(), 'server:dataStim: stim is NULL\n')
874
      
875
876
877
878
      return(NULL)
    }
  })
  
879
880
881
882
883
884
885
886
887
888
889
890
891
  # Return all unique track object labels (created in dataMod)
  # Used to display track IDs in UI for trajectory highlighting
  getDataTrackObjLabUni <- reactive({
    if (DEB)
      cat(file = stdout(), 'server:getDataTrackObjLabUni\n')
    
    loc.dt = dataMod()
    
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt[[COLIDUNI]]))
  })
dmattek's avatar
dmattek committed
892
  
893
894
895
896
897
898
899
  
  # Return all unique time points (real time)
  # Used to set limits of sliders for trimming time and for normalisation
  # These timepoints are from the original dt and aren't affected by trimming of x-axis
  getDataTpts <- reactive({
    if (DEB)
      cat(file = stdout(), 'server:getDataTpts\n')
dmattek's avatar
dmattek committed
900
    
901
    loc.dt = dataMod()
dmattek's avatar
dmattek committed
902
    
903
904
905
906
907
908
909
910
911
912
913
914
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt[[input$inSelTime]]))
  })
  
  
  # Return column names of the main dt
  # Used to fill UI input fields with a choice of column names
  getDataNucCols <- reactive({
    if (DEB)
      cat(file = stdout(), 'server:getDataNucCols: in\n')
dmattek's avatar
dmattek committed
915
    
916
917
918
919
920
921
    loc.dt = dataInBoth()
    
    if (is.null(loc.dt))
      return(NULL)
    else
      return(colnames(loc.dt))
dmattek's avatar
dmattek committed
922
923
  })
  
924
925
926
927
928
929
930
  # Unfinished f-n!
  # 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
931