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
helpText.clHier = c(alertNAsPresentDTW = paste0("NAs present. DTW cannot calculate the distance. ",
dmattek's avatar
dmattek committed
8
9
10
                                                "Consider interpolation of NAs and missing data in the left panel."),
                    alertNAsPresent = paste0("NAs present. The selected distance measure will work, ",
                                             "however caution is recommended. Consider interpolation of NAs and missing data the left panel."))
dmattek's avatar
dmattek committed
11
12


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

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