tabClHier.R 20.4 KB
Newer Older
dmattek's avatar
dmattek committed
1
2
3
4
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
dmattek's avatar
dmattek committed
5
# This module is a tab for hierarchical clustering (base R hclust + dist)
dmattek's avatar
Added:    
dmattek committed
6

dmattek's avatar
dmattek committed
7
8
9
helpText.clHier = c(alertNAsPresentClDTW = paste0("NAs (still) present. DTW cannot calculate the distance. ",
                                                "If interpolation is active in the left panel, missing data can be due to removed outlier time points."),
                    alertNAsPresentCl = paste0("NAs (still) present, caution recommended. If interpolation is active in the left panel, missing data can be due to removed outlier time points."))
dmattek's avatar
dmattek committed
10
11


dmattek's avatar
dmattek committed
12
# UI ----
13
clustHierUI <- function(id, label = "Hierarchical Clustering") {
dmattek's avatar
Added:    
dmattek committed
14
15
16
  ns <- NS(id)
  
  tagList(
dmattek's avatar
dmattek committed
17
    h4('Hierarchical clustering'),
dmattek's avatar
dmattek committed
18
    p("Standard approach using R's ",
19
20
21
      a("dist", 
        href = "https://stat.ethz.ch/R-manual/R-devel/library/stats/html/dist.html",
        title="External link"),
dmattek's avatar
dmattek committed
22
      " and ",
23
24
25
      a("hclust", 
        href = "https://stat.ethz.ch/R-manual/R-devel/library/stats/html/hclust.html",
        title="External link"),
dmattek's avatar
dmattek committed
26
      " functions."),
dmattek's avatar
Added:    
dmattek committed
27
28
    br(),
    fluidRow(
29
      column(3,
dmattek's avatar
Added:    
dmattek committed
30
31
             selectInput(
               ns("selectPlotHierDiss"),
32
33
34
35
36
37
               label = ("Dissimilarity measure"),
               choices = list("Euclidean" = "euclidean",
                              "Manhattan" = "manhattan",
                              "Maximum"   = "maximum",
                              "Canberra"  = "canberra",
                              "DTW"       = "DTW"),
dmattek's avatar
Added:    
dmattek committed
38
               selected = 1
dmattek's avatar
dmattek committed
39
             ),
dmattek's avatar
dmattek committed
40
             bsAlert("alertAnchorClHierNAsPresent"),
dmattek's avatar
dmattek committed
41
42
             selectInput(
               ns("selectPlotHierLinkage"),
43
               label = ("Linkage method"),
dmattek's avatar
dmattek committed
44
               choices = list(
45
46
47
48
49
50
51
                 "Average"  = "average",
                 "Complete" = "complete",
                 "Single"   = "single",
                 "Centroid" = "centroid",
                 "Ward"     = "ward.D",
                 "Ward D2"  = "ward.D2",
                 "McQuitty" = "mcquitty"
dmattek's avatar
dmattek committed
52
               ),
53
               selected = 1
dmattek's avatar
Added:    
dmattek committed
54
55
             )
      ),
56
      column(6,
dmattek's avatar
Added:    
dmattek committed
57
             sliderInput(
58
               ns('slPlotHierNclust'),
59
               'Number of dendrogram branches to cut',
dmattek's avatar
Added:    
dmattek committed
60
61
62
63
64
65
66
               min = 1,
               max = 20,
               value = 1,
               step = 1,
               ticks = TRUE,
               round = TRUE
             ),
dmattek's avatar
dmattek committed
67
             
68
             # These two lines are to manually assign colours to clusters; it doesn't really work well, so skip
dmattek's avatar
dmattek committed
69
             # NOT USED AT THE MOMENT!
70
71
             #checkboxInput(ns('chBPlotHierClAss'), 'Manually assign cluster colours'),
             #uiOutput(ns('uiPlotHierClAss')),
dmattek's avatar
dmattek committed
72
             
dmattek's avatar
Added:    
dmattek committed
73
74
             checkboxInput(ns('chBPlotHierClSel'), 'Manually select clusters to display'),
             uiOutput(ns('uiPlotHierClSel')),
dmattek's avatar
dmattek committed
75
             downloadButton(ns('downCellCl'), 'Download CSV with cluster assignments')
dmattek's avatar
Added:    
dmattek committed
76
77
78
79
      )
    ),
    
    br(),
dmattek's avatar
dmattek committed
80
    
dmattek's avatar
Added:    
dmattek committed
81
    tabsetPanel(
dmattek's avatar
dmattek committed
82
83
      tabPanel('Heatmap',
               br(),
dmattek's avatar
Added:    
dmattek committed
84
85
86
               fluidRow(
                 column(3,
                        selectInput(
dmattek's avatar
dmattek committed
87
88
89
90
                          ns("selectPlotHierPalette"),
                          label = "Heatmap\'s colour palette",
                          choices = l.col.pal,
                          selected = 'Spectral'
dmattek's avatar
Added:    
dmattek committed
91
                        ),
dmattek's avatar
dmattek committed
92
                        checkboxInput(ns('inPlotHierRevPalette'), 'Reverse heatmap\'s colour palette', TRUE),
93
94
95
96
                        checkboxInput(ns('selectPlotHierKey'), 'Plot colour key', TRUE),
                        checkboxInput(ns('chBsetColBounds'), 'Set bounds for colour scale', FALSE),
                        
                        fluidRow(
97
                          column(5,
98
99
                                 uiOutput(ns('uiSetColBoundsLow'))
                          ),
100
                          column(5,
101
102
103
                                 uiOutput(ns('uiSetColBoundsHigh'))
                          )
                        )
dmattek's avatar
Added:    
dmattek committed
104
105
                 ),
                 column(3,
106
                        selectInput(
dmattek's avatar
dmattek committed
107
108
109
110
                          ns("selectPlotHierPaletteDend"),
                          label = "Dendrogram\'s colour palette",
                          choices = l.col.pal.dend.2,
                          selected = 'Color Blind'
111
                        ),
dmattek's avatar
dmattek committed
112
                        checkboxInput(ns('selectPlotHierDend'), 'Plot dendrogram and re-order samples', TRUE),
dmattek's avatar
Added:    
dmattek committed
113
114
                        sliderInput(
                          ns('inPlotHierNAcolor'),
dmattek's avatar
dmattek committed
115
                          'Shade of grey for NA values',
dmattek's avatar
Added:    
dmattek committed
116
117
118
119
120
                          min = 0,
                          max = 1,
                          value = 0.8,
                          step = .1,
                          ticks = TRUE
121
                        )
dmattek's avatar
dmattek committed
122
                        
123
                 ),
dmattek's avatar
dmattek committed
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
                 column(3,
                        numericInput(
                          ns('inPlotHierMarginX'),
                          'Bottom margin',
                          5,
                          min = 1,
                          width = "120px"
                        ),
                        numericInput(
                          ns('inPlotHierFontY'),
                          'Font size column labels',
                          1,
                          min = 0,
                          width = "180px",
                          step = 0.1
                        ),
dmattek's avatar
Added:    
dmattek committed
140
141
142
143
                        numericInput(ns('inPlotHierHeatMapHeight'), 
                                     'Display plot height [px]', 
                                     value = 600, 
                                     min = 100,
dmattek's avatar
dmattek committed
144
145
                                     step = 100,
                                     width = "180px")
146
                        
dmattek's avatar
Added:    
dmattek committed
147
                 ),
dmattek's avatar
dmattek committed
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
                 column(3,
                        numericInput(
                          ns('inPlotHierMarginY'),
                          'Right margin',
                          20,
                          min = 1,
                          width = "120px"
                        ),
                        numericInput(
                          ns('inPlotHierFontX'),
                          'Font size row labels',
                          1,
                          min = 0,
                          width = "180px",
                          step = 0.1
                        )
dmattek's avatar
Added:    
dmattek committed
164
165
166
                 )
               ),
               
dmattek's avatar
dmattek committed
167
               actionButton(ns('butPlotHierHeatMap'), 'Plot!'),
dmattek's avatar
dmattek committed
168
               downPlotUI(ns('downPlotHier'), "Download Plot"),
dmattek's avatar
dmattek committed
169
               withSpinner(plotOutput(ns('outPlotHier')))
dmattek's avatar
Added:    
dmattek committed
170
      ),
dmattek's avatar
dmattek committed
171
      
dmattek's avatar
dmattek committed
172
      tabPanel('Averages',
dmattek's avatar
dmattek committed
173
               br(),
dmattek's avatar
dmattek committed
174
175
               modTrajRibbonPlotUI(ns('modPlotHierTrajRibbon'))),
      
dmattek's avatar
dmattek committed
176
177
      tabPanel('Time series',
               br(),
178
179
               modTrajPlotUI(ns('modPlotHierTraj'))),
      
180
      tabPanel('PSD',
dmattek's avatar
dmattek committed
181
               br(),
182
183
               modPSDPlotUI(ns('modPlotHierPsd'))),
      
dmattek's avatar
dmattek committed
184
185
      tabPanel('Cluster distribution',
               br(),
dmattek's avatar
Added:    
dmattek committed
186
187
188
189
190
191
               modClDistPlotUI(ns('hierClDistPlot'), 'xxx'))
      
    )
  )
}

dmattek's avatar
dmattek committed
192
# SERVER ----
193
clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataStim) {
dmattek's avatar
Added:    
dmattek committed
194
  
195
196
197
198
199
200
201
  # Return the number of clusters from the slider 
  # and delay by a constant in milliseconds defined in auxfunc.R
  returnNclust = reactive({
    return(input$slPlotHierNclust)
  }) %>% debounce(MILLIS)
  
  # not functional; see th note in UI
202
203
204
205
206
  output$uiPlotHierClAss = renderUI({
    ns <- session$ns
    
    if(input$chBPlotHierClAss) {
      selectInput(ns('inPlotHierClAss'), 'Assign cluster order', 
207
                  choices = seq(1, returnNclust(), 1),
208
                  multiple = TRUE, 
209
                  selected = seq(1, returnNclust(), 1))
210
211
212
    }
  })
  
dmattek's avatar
Added:    
dmattek committed
213
214
215
216
217
  output$uiPlotHierClSel = renderUI({
    ns <- session$ns
    
    if(input$chBPlotHierClSel) {
      selectInput(ns('inPlotHierClSel'), 'Select clusters to display', 
218
                  choices = seq(1, returnNclust(), 1),
dmattek's avatar
Added:    
dmattek committed
219
220
221
222
                  multiple = TRUE, 
                  selected = 1)
    }
  })
dmattek's avatar
dmattek committed
223
  
224
225
  
  
226
  # UI for setting lower and upper bounds for heat map colour scale  
227
228
229
230
  output$uiSetColBoundsLow = renderUI({
    ns <- session$ns
    
    if(input$chBsetColBounds) {
dmattek's avatar
dmattek committed
231
      
232
233
234
      loc.dt = in.dataLong()
      if (is.null(loc.dt))
        return(NULL)
dmattek's avatar
dmattek committed
235
      
236
237
238
239
      numericInput(
        ns('inSetColBoundsLow'),
        label = 'Lower',
        step = 0.1, 
240
        value = signif(min(loc.dt[['y']], na.rm = T), digits = 3)
241
242
243
244
245
246
247
248
249
      )
    }
  })
  
  
  output$uiSetColBoundsHigh = renderUI({
    ns <- session$ns
    
    if(input$chBsetColBounds) {
dmattek's avatar
dmattek committed
250
      
251
252
253
      loc.dt = in.dataLong()
      if (is.null(loc.dt))
        return(NULL)
254
255
256
257
258
      
      numericInput(
        ns('inSetColBoundsHigh'),
        label = 'Upper',
        step = 0.1, 
259
        value = signif(max(loc.dt[['y']], na.rm = T), digits = 3)
260
261
262
263
      )
    }
  })
  
264
  
dmattek's avatar
Added:    
dmattek committed
265
266
267
268
269
  # calculate distance matrix for further clustering
  # time series arranged in rows with columns corresponding to time points
  userFitDistHier <- reactive({
    cat(file = stderr(), 'userFitDistHier \n')
    
270
    loc.dm = in.dataWide()
dmattek's avatar
dmattek committed
271
    
272
    if (is.null(loc.dm)) {
dmattek's avatar
Added:    
dmattek committed
273
274
275
      return(NULL)
    }
    
276
277
278
279
280
281
282
    # Throw some warnings if NAs present in the dataset.
    # DTW cannot compute distance when NA's are preset.
    # Other distance measures can be calculated but caution is required with interpretation.
    # NAs in the wide format can result from explicit NAs in the measurment column or
    # from missing rows that cause NAs to appear when convertinf from long to wide (dcast)
    if(sum(is.na(loc.dm)) > 0) {
      if (input$selectPlotHierDiss == "DTW") {
dmattek's avatar
dmattek committed
283
284
        createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresentClDTW", title = "Error",
                    content = helpText.clHier[["alertNAsPresentClDTW"]], 
285
286
                    append = FALSE,
                    style = "danger")
dmattek's avatar
dmattek committed
287
        closeAlert(session, 'alertNAsPresentCl')
288
289
290
291
        
        return(NULL)
        
      } else {
dmattek's avatar
dmattek committed
292
293
        createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresentCl", title = "Warning",
                    content = helpText.clHier[["alertNAsPresentCl"]], 
294
295
                    append = FALSE, 
                    style = "warning")
dmattek's avatar
dmattek committed
296
        closeAlert(session, 'alertNAsPresentClDTW')
297
298
      }
    } else {
dmattek's avatar
dmattek committed
299
300
      closeAlert(session, 'alertNAsPresentClDTW')
      closeAlert(session, 'alertNAsPresentCl')
301
302
303
    }
    
    
304
    #pr_DB$set_entry(FUN = fastDTW, names = c("fastDTW"))
305
    cl.dist = proxy::dist(loc.dm, method = input$selectPlotHierDiss)
dmattek's avatar
Added:    
dmattek committed
306
307
308
309
310
311
312
313
314
    
    return(cl.dist)
  })
  
  # perform hierarchical clustering and return dendrogram coloured according to cutree
  # branch coloring performed using dendextend package
  userFitDendHier <- reactive({
    cat(file = stderr(), 'userFitDendHier \n')
    
315
316
    # calculate distance matrix
    loc.dm.dist = userFitDistHier()
dmattek's avatar
Added:    
dmattek committed
317
    
318
    if (is.null(loc.dm.dist)) {
dmattek's avatar
Added:    
dmattek committed
319
320
321
      return(NULL)
    }
    
322
    loc.cl.hc = hclust(loc.dm.dist, method = input$selectPlotHierLinkage)
dmattek's avatar
dmattek committed
323
    
dmattek's avatar
dmattek committed
324
    # number of clusters at which dendrogram is cut
325
    loc.k = returnNclust()
326
327
    
    # make a palette with the amount of colours equal to the number of clusters
dmattek's avatar
dmattek committed
328
329
330
    #loc.col = get(input$selectPlotHierPaletteDend)(n = loc.k)
    loc.col = ggthemes::tableau_color_pal(input$selectPlotHierPaletteDend)(n = loc.k)
    
331
    # take into account manual assignment of cluster numbers
dmattek's avatar
dmattek committed
332
333
334
335
    # NOT USED AT THE MOMENT
    #if (input$chBPlotHierClAss) {
    #  loc.col = loc.col[as.numeric(input$inPlotHierClAss)]
    #}
336
    
337
    loc.dend <- as.dendrogram(loc.cl.hc)
dmattek's avatar
dmattek committed
338
339
340
    loc.dend <- dendextend::color_branches(loc.dend, 
                                           col = loc.col, 
                                           k = loc.k)
dmattek's avatar
Added:    
dmattek committed
341
    
342
343
    return(loc.dend)
  }) 
dmattek's avatar
Added:    
dmattek committed
344
  
dmattek's avatar
dmattek committed
345
  
dmattek's avatar
Added:    
dmattek committed
346
347
348
349
350
351
352
353
354
  # returns table prepared with f-n getClCol
  # for hierarchical clustering
  getClColHier <- reactive({
    cat(file = stderr(), 'getClColHier \n')
    
    loc.dend = userFitDendHier()
    if (is.null(loc.dend))
      return(NULL)
    
355
    loc.dt = getClCol(loc.dend, returnNclust())
356
357
358
359
360
361
362
363
364
365
    
    # Display clusters specified in the inPlotHierClSel field
    # Data is ordered according to the order of clusters specified in this field
    if(input$chBPlotHierClSel) {
      loc.dt = loc.dt[cl.no %in% input$inPlotHierClSel]
      loc.dt[, cl.no := factor(cl.no, levels = input$inPlotHierClSel)]
      setkey(loc.dt, cl.no)
    }
    
    return(loc.dt)
dmattek's avatar
Added:    
dmattek committed
366
367
368
369
  })
  
  
  
370
  # Return all unique track object labels (created in dataMod)
dmattek's avatar
Added:    
dmattek committed
371
372
373
  # This will be used to display in UI for trajectory highlighting
  getDataTrackObjLabUni_afterTrim <- reactive({
    cat(file = stderr(), 'getDataTrackObjLabUni_afterTrim\n')
374
    loc.dt = in.dataLong()
dmattek's avatar
Added:    
dmattek committed
375
376
377
378
379
380
381
382
383
384
385
    
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt$id))
  })
  
  # return dt with cell IDs and their corresponding condition name
  # The condition is the column defined by facet groupings
  getDataCond <- reactive({
    cat(file = stderr(), 'getDataCond\n')
386
    loc.dt = in.dataLong()
dmattek's avatar
Added:    
dmattek committed
387
388
389
390
391
392
393
394
395
396
397
398
399
400
    
    if (is.null(loc.dt))
      return(NULL)
    else
      return(unique(loc.dt[, .(id, group)]))
    
  })
  
  # prepare data for plotting trajectories per cluster
  # outputs dt as data4trajPlot but with an additional column 'cl' that holds cluster numbers
  # additionally some clusters are omitted according to manual selection
  data4trajPlotCl <- reactive({
    cat(file = stderr(), 'data4trajPlotCl: in\n')
    
401
    loc.dt = in.dataLong()
dmattek's avatar
Added:    
dmattek committed
402
403
404
405
406
407
408
409
410
    
    if (is.null(loc.dt)) {
      cat(file = stderr(), 'data4trajPlotCl: dt is NULL\n')
      return(NULL)
    }
    
    cat(file = stderr(), 'data4trajPlotCl: dt not NULL\n')
    
    # get cellIDs with cluster assignments based on dendrogram cut
411
    loc.dt.cl = getDataCl(userFitDendHier(), returnNclust())
dmattek's avatar
dmattek committed
412
413
414
    
    # add the column with cluster assignemnt to the main dataset
    loc.dt = merge(loc.dt, loc.dt.cl, by = COLID)
dmattek's avatar
Added:    
dmattek committed
415
    
416
417
418
    # Display clusters specified in the inPlotHierClSel field
    # Data is ordered according to the order of clusters specified in this field
    if(input$chBPlotHierClSel) {
dmattek's avatar
Added:    
dmattek committed
419
      loc.dt = loc.dt[cl %in% input$inPlotHierClSel]
420
421
422
      loc.dt[, cl := factor(cl, levels = input$inPlotHierClSel)]
      setkey(loc.dt, cl)
    }
dmattek's avatar
Added:    
dmattek committed
423
424
425
426
    
    return(loc.dt)    
  })
  
427
428
429
  data4stimPlotCl <- reactive({
    cat(file = stderr(), 'data4stimPlotCl: in\n')
    
430
    loc.dt = in.dataStim()
431
432
433
434
435
436
437
438
439
440
    
    if (is.null(loc.dt)) {
      cat(file = stderr(), 'data4stimPlotCl: dt is NULL\n')
      return(NULL)
    }
    
    cat(file = stderr(), 'data4stimPlotCl: dt not NULL\n')
    return(loc.dt)
  })
  
dmattek's avatar
Added:    
dmattek committed
441
442
443
444
  # download a list of cellIDs with cluster assignments
  output$downCellCl <- downloadHandler(
    filename = function() {
      paste0('clust_hierch_data_',
445
             input$selectPlotHierDiss,
dmattek's avatar
Added:    
dmattek committed
446
             '_',
447
             input$selectPlotHierLinkage, '.csv')
dmattek's avatar
Added:    
dmattek committed
448
449
450
    },
    
    content = function(file) {
451
      write.csv(x = getDataCl(userFitDendHier(), returnNclust()), file = file, row.names = FALSE)
dmattek's avatar
Added:    
dmattek committed
452
453
454
455
456
457
458
459
460
461
462
463
464
465
    }
  )
  
  # prepare data for barplot with distribution of items per condition  
  data4clDistPlot <- reactive({
    cat(file = stderr(), 'data4clDistPlot: in\n')
    
    # get cell IDs with cluster assignments depending on dendrogram cut
    loc.dend <- userFitDendHier()
    if (is.null(loc.dend)) {
      cat(file = stderr(), 'plotClDist: loc.dend is NULL\n')
      return(NULL)
    }
    
dmattek's avatar
dmattek committed
466
    # get cell id's with associated cluster numbers
467
    loc.dt.cl = getDataCl(loc.dend, returnNclust())
dmattek's avatar
Added:    
dmattek committed
468
469
470
471
472
473
474
475
    
    # get cellIDs with condition name
    loc.dt.gr = getDataCond()
    if (is.null(loc.dt.gr)) {
      cat(file = stderr(), 'plotClDist: loc.dt.gr is NULL\n')
      return(NULL)
    }
    
dmattek's avatar
dmattek committed
476
    loc.dt = merge(loc.dt.cl, loc.dt.gr, by = COLID)
dmattek's avatar
Added:    
dmattek committed
477
    
dmattek's avatar
dmattek committed
478
    
dmattek's avatar
Added:    
dmattek committed
479
480
    loc.dt.aggr = loc.dt[, .(nCells = .N), by = .(group, cl)]
    
481
482
483
484
485
486
487
    # Display clusters specified in the inPlotHierClSel field
    # Data is ordered according to the order of clusters specified in this field
    if(input$chBPlotHierClSel) {
      loc.dt.aggr = loc.dt.aggr[cl %in% input$inPlotHierClSel]
      loc.dt.aggr[, cl := factor(cl, levels = input$inPlotHierClSel)]
      setkey(loc.dt.aggr, cl)
    }
dmattek's avatar
Added:    
dmattek committed
488
489
490
491
492
493
494
495
    return(loc.dt.aggr)
    
  })
  
  # Function instead of reactive as per:
  # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
  # This function is used to plot and to downoad a pdf
  plotHier <- function() {
496
    cat(file = stderr(), 'plotHier: in\n')
dmattek's avatar
Added:    
dmattek committed
497
    
498
499
    # make the f-n dependent on the button click
    locBut = input$butPlotHierHeatMap
dmattek's avatar
Added:    
dmattek committed
500
    
501
502
503
504
505
506
507
    # Check if main data exists
    # Thanks to solate all mods in the left panel are delayed 
    # until clicking the Plot button
    loc.dm = isolate(in.dataWide())
    loc.dend = isolate(userFitDendHier())
    validate(
      need(!is.null(loc.dm), "Nothing to plot. Load data first!"),
dmattek's avatar
dmattek committed
508
      need(!is.null(loc.dend), "Could not create dendrogram")
509
    )
dmattek's avatar
dmattek committed
510
    
511
512
513
    # Dummy dependency to redraw the heatmap without clicking Plot
    # when changing the number of clusters to highlight
    loc.k = returnNclust()
dmattek's avatar
Added:    
dmattek committed
514
    
515
516
    loc.col.bounds = NULL
    if (input$chBsetColBounds)
517
518
      loc.col.bounds = c(input$inSetColBoundsLow, 
                         input$inSetColBoundsHigh)
519
520
521
522
    else 
      loc.col.bounds = NULL
    
    
dmattek's avatar
dmattek committed
523
    loc.p = LOCplotHeatmap(loc.dm,
dmattek's avatar
dmattek committed
524
525
526
527
528
529
530
531
532
533
534
535
536
                           loc.dend, 
                           palette.arg = input$selectPlotHierPalette, 
                           palette.rev.arg = input$inPlotHierRevPalette, 
                           dend.show.arg = input$selectPlotHierDend, 
                           key.show.arg = input$selectPlotHierKey, 
                           margin.x.arg = input$inPlotHierMarginX, 
                           margin.y.arg = input$inPlotHierMarginY, 
                           nacol.arg = input$inPlotHierNAcolor, 
                           font.row.arg = input$inPlotHierFontX, 
                           font.col.arg = input$inPlotHierFontY, 
                           breaks.arg = loc.col.bounds,
                           title.arg = paste0(
                             "Distance measure: ",
537
                             input$selectPlotHierDiss,
dmattek's avatar
dmattek committed
538
                             "\nLinkage method: ",
539
                             input$selectPlotHierLinkage
dmattek's avatar
dmattek committed
540
                           ))
dmattek's avatar
Added:    
dmattek committed
541
542
543
544
545
    
    return(loc.p)
  }
  
  
dmattek's avatar
dmattek committed
546
  
dmattek's avatar
Added:    
dmattek committed
547
548
549
550
  #  Hierarchical - display heatmap
  getPlotHierHeatMapHeight <- function() {
    return (input$inPlotHierHeatMapHeight)
  }
dmattek's avatar
dmattek committed
551
  
dmattek's avatar
Added:    
dmattek committed
552
553
554
555
556
  output$outPlotHier <- renderPlot({
    
    plotHier()
  }, height = getPlotHierHeatMapHeight)
  
557
558
559
  createFnameHeatMap = reactive({
    
    paste0('clust_hierch_heatMap_',
560
           input$selectPlotHierDiss,
561
           '_',
562
           input$selectPlotHierLinkage,
563
564
565
566
567
568
           '.png')
  })
  
  createFnameTrajPlot = reactive({
    
    paste0('clust_hierch_tCourses_',
569
           input$selectPlotHierDiss,
570
           '_',
571
           input$selectPlotHierLinkage, 
572
573
574
575
576
577
           '.pdf')
  })
  
  createFnameRibbonPlot = reactive({
    
    paste0('clust_hierch_tCoursesMeans_',
578
           input$selectPlotHierDiss,
579
           '_',
580
           input$selectPlotHierLinkage, 
581
582
583
           '.pdf')
  })
  
584
585
586
  createFnamePsdPlot = reactive({
    
    paste0('clust_hierch_tCoursesPsd_',
587
           input$selectPlotHierDiss,
588
           '_',
589
           input$selectPlotHierLinkage, 
590
591
592
           '.pdf')
  })
  
593
594
595
  createFnameDistPlot = reactive({
    
    paste0('clust_hierch_clDist_',
596
           input$selectPlotHierDiss,
597
           '_',
598
           input$selectPlotHierLinkage, '.pdf')  
599
  })
600
  
dmattek's avatar
Added:    
dmattek committed
601
602
  
  #  Hierarchical - Heat Map - download pdf
603
  callModule(downPlot, "downPlotHier", createFnameHeatMap, plotHier)
dmattek's avatar
dmattek committed
604
  
605
  # plot individual trajectories withina cluster  
dmattek's avatar
Added:    
dmattek committed
606
607
  callModule(modTrajPlot, 'modPlotHierTraj', 
             in.data = data4trajPlotCl, 
608
             in.data.stim = data4stimPlotCl,
dmattek's avatar
Added:    
dmattek committed
609
610
             in.facet = 'cl',  
             in.facet.color = getClColHier,
611
             in.fname = createFnameTrajPlot)
dmattek's avatar
Added:    
dmattek committed
612
  
613
  # plot cluster means
dmattek's avatar
dmattek committed
614
615
  callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon', 
             in.data = data4trajPlotCl, 
616
             in.data.stim = data4stimPlotCl,
dmattek's avatar
dmattek committed
617
618
             in.facet = 'cl',  
             in.facet.color = getClColHier,
619
             in.fname = createFnameRibbonPlot)
dmattek's avatar
dmattek committed
620
  
621
622
623
624
625
626
  # plot cluster PSD
  callModule(modPSDPlot, 'modPlotHierPsd',
             in.data = data4trajPlotCl,
             in.facet = 'cl',
             in.facet.color = getClColHier,
             in.fname = createFnamePsdPlot)
dmattek's avatar
dmattek committed
627
  
628
  # plot distribution barplot
dmattek's avatar
Added:    
dmattek committed
629
630
631
  callModule(modClDistPlot, 'hierClDistPlot', 
             in.data = data4clDistPlot,
             in.cols = getClColHier,
632
             in.fname = createFnameDistPlot)
dmattek's avatar
dmattek committed
633
  
dmattek's avatar
Added:    
dmattek committed
634
635
  
}