server.R 31.5 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
dmattek committed
143
144
145
146
        accept = c("text/csv", 
                   "text/comma-separated-values,text/plain", 
                   "application/gzip", 
                   "application/bz2"), 
dmattek's avatar
Added:    
dmattek committed
147
148
149
150
      )
  })
  
  output$uiButLoadTrajRem = renderUI({
151
    if (DEB)
152
      cat(file = stdout(), 'server:uiButLoadTrajRem\n')
dmattek's avatar
Added:    
dmattek committed
153
154
155
156
157
    
    if(input$chBtrajRem)
      actionButton("inButLoadTrajRem", "Load Data")
  })

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

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

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

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

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

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

dmattek's avatar
dmattek committed
453
  # Processing-data ----
dmattek's avatar
dmattek committed
454
  
455
  # Obtain data either from an upload or by generating a synthetic dataset
456
457
458
459
460
461
462
463
464
465
466
467
  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
    
468
    # Don't wrap around if(DEB) !!!
469
    cat(
470
      "server:dataInBoth\n   inGen1: ",
471
      locInGen1,
472
      "      prev=",
473
      isolate(counter$dataGen1),
474
      "\n   inDataNuc: ",
475
476
477
478
479
480
481
482
483
484
      locInLoadNuc,
      "   prev=",
      isolate(counter$dataLoadNuc),
      # "\ninDataStim: ",
      # locInLoadStim,
      # "   prev=",
      # isolate(counter$dataLoadStim),
      "\n"
    )
    
485
    # isolate the checks of the counter reactiveValues
486
487
    # as we set the values in this same reactive
    if (locInGen1 != isolate(counter$dataGen1)) {
488
      cat("server:dataInBoth if inDataGen1\n")
489
490
491
492
      dm = dataGen1()
      # no need to isolate updating the counter reactive values!
      counter$dataGen1 <- locInGen1
    } else if (locInLoadNuc != isolate(counter$dataLoadNuc)) {
493
      cat("server:dataInBoth if inDataLoadNuc\n")
494
      dm = dataLoadNuc()
495
496
497
      
      # convert to long format if radio box set to "wide"
      # the input data in long format should contain:
498
      # - the first row with a header: group, track id, time points as columns with numeric header
499
500
      # - consecutive rows with time series, where columns are time points
      if (input$inRbutLongWide == 1) {
501
502
503
504
505
506
507
508
509
510
511
512
        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")
          
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
541
542
543
544
545
546
        } 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")
          }
        }
547
548
      }
      
549
550
551
      # no need to isolate updating the counter reactive values!
      counter$dataLoadNuc <- locInLoadNuc
    } else {
552
      cat("server:dataInBoth else\n")
553
554
      dm = NULL
    }
555
    
556
557
558
    return(dm)
  })
  
559
560
561
  # 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
562
  dataMod <- reactive({
563
    if (DEB)
564
      cat(file = stdout(), 'server:dataMod\n')
565
    
566
567
    loc.dt = dataInBoth()
    
dmattek's avatar
dmattek committed
568
    if (is.null(loc.dt))
569
570
      return(NULL)
    
571
    if (input$chBtrackUni) {
572
      # create unique track ID based on columns specified in input$inSelSite field and combine with input$inSelTrackLabel
573
      loc.dt[, (COLIDUNI) := do.call(paste, c(.SD, sep = "_")), .SDcols = c(input$inSelSite, input$inSelTrackLabel) ]
dmattek's avatar
Added:    
dmattek committed
574
    } else {
575
      # Leave track ID provided in the loaded dataset; has to be unique
576
      loc.dt[, (COLIDUNI) := get(input$inSelTrackLabel)]
dmattek's avatar
Added:    
dmattek committed
577
578
    }
    
dmattek's avatar
Added:    
dmattek committed
579
580
    # remove trajectories based on uploaded csv
    if (input$chBtrajRem) {
581
      if (DEB)
582
        cat(file = stdout(), 'server:dataMod: trajRem not NULL\n')
dmattek's avatar
Added:    
dmattek committed
583
584
      
      loc.dt.rem = dataLoadTrajRem()
dmattek's avatar
dmattek committed
585
      loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
dmattek's avatar
Added:    
dmattek committed
586
587
    }
    
588
589
590
591
592
    return(loc.dt)
  })
  
  # prepare data for plotting time courses
  # returns dt with these columns:
dmattek's avatar
dmattek committed
593
  #    realtime - selected from input
dmattek's avatar
dmattek committed
594
  #    y        - measurement selected from input
dmattek's avatar
dmattek committed
595
  #               (can be a single column or result of an operation on two cols)
596
597
  #    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
598
599
  #    group    - grouping variable for facetting from input
  #    mid.in   - column with trajectory selection status from the input file or
600
601
602
603
  #               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
604
  dataLong <- reactive({
605
    if (DEB)
606
      cat(file = stdout(), 'server:dataLong\n')
607
608
    
    loc.dt = dataMod()
dmattek's avatar
dmattek committed
609
    if (is.null(loc.dt))
610
611
      return(NULL)
    
612
    # create expression for 'y' column based on measurements and math operations selected in UI
dmattek's avatar
dmattek committed
613
    if (input$inSelMath == '')
614
615
616
617
618
619
      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)
    
620
    # create expression for 'group' column
621
622
    # creates a merged column based on other columns from input
    # used for grouping of plot facets
dmattek's avatar
dmattek committed
623
624
625
626
627
628
629
630
631
632
633
    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')"
    }
634
    
dmattek's avatar
dmattek committed
635
636

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

726
    ## Interpolate missing data and NA data points
727
    # From: https://stackoverflow.com/questions/28073752/r-how-to-add-rows-for-missing-values-for-unique-group-sequences
728
    # Tracks are interpolated only within first and last time points of every track id
729
730
    # 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.
731
    # Therefore, we cannot rely on that info to get time frequency; user must provide this number!
732
    
733
734
    # 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
735
736
737
738
739
740
741
742
    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")
    
743
    setkeyv(loc.out, c(COLGR, COLID, COLRT))
744

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