tabClHier.R 23.1 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
dmattek committed
6

dmattek's avatar
dmattek committed
7 8
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."),
dmattek's avatar
dmattek committed
9 10
                    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."),
majpark21's avatar
majpark21 committed
11 12 13
                    alLearnMore = paste0("<p><a href=\"https://en.wikipedia.org/wiki/Hierarchical_clustering\" target=\"_blank\" title=\"External link\">Agglomerative hierarchical clustering</a> ",
                                         "initially assumes that all time series are forming their own clusters. It then grows a clustering dendrogram thanks to 2 inputs:<p>",
                                         "First, a <b>dissimilarity matrix</b> between all pairs ",
dmattek's avatar
dmattek committed
14 15 16 17
                                         "of time series is calculated with one of the metrics, such as ",
                                         "Euclidean (<a href=\"https://en.wikipedia.org/wiki/Euclidean_distance\" target=\"_blank\" title=\"External link\">L2 norm</a>) ",
                                         "or Manhattan (<a href=\"https://en.wikipedia.org/wiki/Taxicab_geometry\" target=\"_blank\" title=\"External link\">L1 norm</a>) distance. ",
                                         "<a href=\"https://en.wikipedia.org/wiki/Dynamic_time_warping\" target=\"_blank\" title=\"External link\">Dynamic Time Warping</a> (DTW) ",
majpark21's avatar
majpark21 committed
18 19 20
                                         "is another distance metric that does not only compare series point by point but also tries to align them such that shapes between the 2 series are matched. ",
                                         "This makes DTW a good quantification of similarity when signals are similar but shifted in time.</p>",
                                         "<p>In the second step, clusters are successively built and merged together. The distance between the newly formed clusters is determined by the <b>linkage criterion</b> ",
dmattek's avatar
dmattek committed
21
                                         "using one of <a href=\"https://en.wikipedia.org/wiki/Hierarchical_clustering\" target=\"_blank\" title=\"External link\">linkage methods</a>.</p>"))
dmattek's avatar
dmattek committed
22 23


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

dmattek's avatar
dmattek committed
208
# SERVER ----
209
clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataStim) {
dmattek's avatar
dmattek committed
210
  
dmattek's avatar
dmattek committed
211 212
  ns <- session$ns
  
213 214 215 216 217 218 219
  # 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
220
  output$uiPlotHierClAss = renderUI({
dmattek's avatar
dmattek committed
221

222 223
    if(input$chBPlotHierClAss) {
      selectInput(ns('inPlotHierClAss'), 'Assign cluster order', 
224
                  choices = seq(1, returnNclust(), 1),
225
                  multiple = TRUE, 
226
                  selected = seq(1, returnNclust(), 1))
227 228 229
    }
  })
  
dmattek's avatar
dmattek committed
230
  output$uiPlotHierClSel = renderUI({
dmattek's avatar
dmattek committed
231 232

      if(input$chBPlotHierClSel) {
dmattek's avatar
dmattek committed
233
      selectInput(ns('inPlotHierClSel'), 'Select clusters to display', 
234
                  choices = seq(1, returnNclust(), 1),
dmattek's avatar
dmattek committed
235 236 237 238
                  multiple = TRUE, 
                  selected = 1)
    }
  })
dmattek's avatar
dmattek committed
239
  
240 241
  
  
242
  # UI for setting lower and upper bounds for heat map colour scale  
243
  output$uiSetColBoundsLow = renderUI({
dmattek's avatar
dmattek committed
244

245
    if(input$chBsetColBounds) {
dmattek's avatar
dmattek committed
246
      
247 248 249
      loc.dt = in.dataLong()
      if (is.null(loc.dt))
        return(NULL)
dmattek's avatar
dmattek committed
250
      
251 252 253 254
      numericInput(
        ns('inSetColBoundsLow'),
        label = 'Lower',
        step = 0.1, 
255
        value = signif(min(loc.dt[['y']], na.rm = T), digits = 3)
256 257 258 259 260 261
      )
    }
  })
  
  
  output$uiSetColBoundsHigh = renderUI({
dmattek's avatar
dmattek committed
262

263
    if(input$chBsetColBounds) {
dmattek's avatar
dmattek committed
264
      
265 266 267
      loc.dt = in.dataLong()
      if (is.null(loc.dt))
        return(NULL)
268 269 270 271 272
      
      numericInput(
        ns('inSetColBoundsHigh'),
        label = 'Upper',
        step = 0.1, 
273
        value = signif(max(loc.dt[['y']], na.rm = T), digits = 3)
274 275 276 277
      )
    }
  })
  
278
  
dmattek's avatar
dmattek committed
279 280 281 282 283
  # calculate distance matrix for further clustering
  # time series arranged in rows with columns corresponding to time points
  userFitDistHier <- reactive({
    cat(file = stderr(), 'userFitDistHier \n')
    
284
    loc.dm = in.dataWide()
dmattek's avatar
dmattek committed
285
    
286
    if (is.null(loc.dm)) {
dmattek's avatar
dmattek committed
287 288 289
      return(NULL)
    }
    
290 291 292 293 294 295 296
    # 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
297 298
        createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresentClDTW", title = "Error",
                    content = helpText.clHier[["alertNAsPresentClDTW"]], 
299 300
                    append = FALSE,
                    style = "danger")
dmattek's avatar
dmattek committed
301
        closeAlert(session, 'alertNAsPresentCl')
302 303 304 305
        
        return(NULL)
        
      } else {
dmattek's avatar
dmattek committed
306 307
        createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresentCl", title = "Warning",
                    content = helpText.clHier[["alertNAsPresentCl"]], 
308 309
                    append = FALSE, 
                    style = "warning")
dmattek's avatar
dmattek committed
310
        closeAlert(session, 'alertNAsPresentClDTW')
311 312
      }
    } else {
dmattek's avatar
dmattek committed
313 314
      closeAlert(session, 'alertNAsPresentClDTW')
      closeAlert(session, 'alertNAsPresentCl')
315 316 317
    }
    
    
318
    #pr_DB$set_entry(FUN = fastDTW, names = c("fastDTW"))
319
    cl.dist = proxy::dist(loc.dm, method = input$selectPlotHierDiss)
dmattek's avatar
dmattek committed
320 321 322 323 324 325 326 327 328
    
    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')
    
329 330
    # calculate distance matrix
    loc.dm.dist = userFitDistHier()
dmattek's avatar
dmattek committed
331
    
332
    if (is.null(loc.dm.dist)) {
dmattek's avatar
dmattek committed
333 334 335
      return(NULL)
    }
    
336
    loc.cl.hc = hclust(loc.dm.dist, method = input$selectPlotHierLinkage)
dmattek's avatar
dmattek committed
337
    
dmattek's avatar
dmattek committed
338
    # number of clusters at which dendrogram is cut
339
    loc.k = returnNclust()
340 341
    
    # make a palette with the amount of colours equal to the number of clusters
dmattek's avatar
dmattek committed
342 343 344
    #loc.col = get(input$selectPlotHierPaletteDend)(n = loc.k)
    loc.col = ggthemes::tableau_color_pal(input$selectPlotHierPaletteDend)(n = loc.k)
    
345
    # take into account manual assignment of cluster numbers
dmattek's avatar
dmattek committed
346 347 348 349
    # NOT USED AT THE MOMENT
    #if (input$chBPlotHierClAss) {
    #  loc.col = loc.col[as.numeric(input$inPlotHierClAss)]
    #}
350
    
351
    loc.dend <- as.dendrogram(loc.cl.hc)
dmattek's avatar
dmattek committed
352 353 354
    loc.dend <- dendextend::color_branches(loc.dend, 
                                           col = loc.col, 
                                           k = loc.k)
dmattek's avatar
dmattek committed
355
    
356 357
    return(loc.dend)
  }) 
dmattek's avatar
dmattek committed
358
  
dmattek's avatar
dmattek committed
359
  
360 361 362 363
  # Returns a table prepared with f-n getClCol
  # for hierarchical clustering.
  # The table contains colours assigned to clusters.
  # Colours are obtained from the dendrogram using dendextend::get_leaves_branches_col
dmattek's avatar
dmattek committed
364 365 366 367 368 369 370
  getClColHier <- reactive({
    cat(file = stderr(), 'getClColHier \n')
    
    loc.dend = userFitDendHier()
    if (is.null(loc.dend))
      return(NULL)
    
371 372
    # obtain relations between cluster and colors from the dendrogram
    loc.dt = LOCgetClCol(loc.dend, returnNclust())
373 374 375 376
    
    # Display clusters specified in the inPlotHierClSel field
    # Data is ordered according to the order of clusters specified in this field
    if(input$chBPlotHierClSel) {
377 378 379
      # kepp only clusters specified in input$inPlotHierClSel
      loc.dt = loc.dt[gr.no %in% input$inPlotHierClSel]
      loc.dt[, gr.no := factor(gr.no, levels = input$inPlotHierClSel)]
380
    }
381 382 383

    # set the key to allow subsetting
    setkey(loc.dt, gr.no)
384 385
    
    return(loc.dt)
dmattek's avatar
dmattek committed
386 387 388 389
  })
  
  
  
390
  # Return all unique track object labels (created in dataMod)
dmattek's avatar
dmattek committed
391 392 393
  # This will be used to display in UI for trajectory highlighting
  getDataTrackObjLabUni_afterTrim <- reactive({
    cat(file = stderr(), 'getDataTrackObjLabUni_afterTrim\n')
394
    loc.dt = in.dataLong()
dmattek's avatar
dmattek committed
395 396 397 398 399 400 401 402 403 404 405
    
    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')
406
    loc.dt = in.dataLong()
dmattek's avatar
dmattek committed
407 408 409 410 411 412 413 414 415 416 417 418 419 420
    
    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')
    
421
    loc.dt = in.dataLong()
dmattek's avatar
dmattek committed
422 423 424 425 426 427 428 429 430
    
    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
431
    loc.dt.cl = getDataCl(userFitDendHier(), returnNclust())
432 433 434
    
    # add the column with cluster assignemnt to the main dataset
    loc.dt = merge(loc.dt, loc.dt.cl, by = COLID)
dmattek's avatar
dmattek committed
435
    
436 437 438
    # 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
dmattek committed
439
      loc.dt = loc.dt[cl %in% input$inPlotHierClSel]
440 441 442
      loc.dt[, cl := factor(cl, levels = input$inPlotHierClSel)]
      setkey(loc.dt, cl)
    }
dmattek's avatar
dmattek committed
443 444 445 446
    
    return(loc.dt)    
  })
  
447 448 449
  data4stimPlotCl <- reactive({
    cat(file = stderr(), 'data4stimPlotCl: in\n')
    
450
    loc.dt = in.dataStim()
451 452 453 454 455 456 457 458 459 460
    
    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
dmattek committed
461 462 463 464
  # download a list of cellIDs with cluster assignments
  output$downCellCl <- downloadHandler(
    filename = function() {
      paste0('clust_hierch_data_',
465
             input$selectPlotHierDiss,
dmattek's avatar
dmattek committed
466
             '_',
467
             input$selectPlotHierLinkage, '.csv')
dmattek's avatar
dmattek committed
468 469 470
    },
    
    content = function(file) {
471
      write.csv(x = getDataCl(userFitDendHier(), returnNclust()), file = file, row.names = FALSE)
dmattek's avatar
dmattek committed
472 473 474 475 476 477 478 479 480 481 482 483 484 485
    }
  )
  
  # 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
486
    # get cell id's with associated cluster numbers
487
    loc.dt.cl = getDataCl(loc.dend, returnNclust())
488 489 490 491
    if (is.null(loc.dt.cl)) {
      cat(file = stderr(), 'plotClDist: loc.dt.cl is NULL\n')
      return(NULL)
    }
dmattek's avatar
dmattek committed
492 493 494 495 496 497 498 499
    
    # 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)
    }
    
500
    # add grouping to clusters+ids
501
    loc.dt = merge(loc.dt.cl, loc.dt.gr, by = COLID)
dmattek's avatar
dmattek committed
502
    
503 504 505
    # count number of time series per group, per cluster
    loc.dt.aggr = loc.dt[, .(xxx = .N), by = c(COLGR, COLCL)]
    setnames(loc.dt.aggr, "xxx", COLNTRAJ)
dmattek's avatar
dmattek committed
506
    
507 508 509 510
    # 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]
511 512
      loc.dt.aggr[, (COLCL) := factor(get(COLCL), levels = input$inPlotHierClSel)]
      setkeyv(loc.dt.aggr, COLCL)
513
    }
dmattek's avatar
dmattek committed
514 515 516 517 518 519 520 521
    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() {
522
    cat(file = stderr(), 'plotHier: in\n')
dmattek's avatar
dmattek committed
523
    
524 525
    # make the f-n dependent on the button click
    locBut = input$butPlotHierHeatMap
dmattek's avatar
dmattek committed
526
    
527 528 529 530 531 532 533
    # 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
534
      need(!is.null(loc.dend), "Could not create dendrogram")
535
    )
dmattek's avatar
dmattek committed
536
    
537 538 539
    # Dummy dependency to redraw the heatmap without clicking Plot
    # when changing the number of clusters to highlight
    loc.k = returnNclust()
dmattek's avatar
dmattek committed
540
    
541 542
    loc.col.bounds = NULL
    if (input$chBsetColBounds)
543 544
      loc.col.bounds = c(input$inSetColBoundsLow, 
                         input$inSetColBoundsHigh)
545 546 547 548
    else 
      loc.col.bounds = NULL
    
    
dmattek's avatar
dmattek committed
549
    loc.p = LOCplotHeatmap(loc.dm,
dmattek's avatar
dmattek committed
550 551 552 553 554 555 556 557 558 559 560 561 562
                           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: ",
563
                             input$selectPlotHierDiss,
dmattek's avatar
dmattek committed
564
                             "\nLinkage method: ",
565
                             input$selectPlotHierLinkage
dmattek's avatar
dmattek committed
566
                           ))
dmattek's avatar
dmattek committed
567 568 569 570 571
    
    return(loc.p)
  }
  
  
dmattek's avatar
dmattek committed
572
  
dmattek's avatar
dmattek committed
573 574 575 576
  #  Hierarchical - display heatmap
  getPlotHierHeatMapHeight <- function() {
    return (input$inPlotHierHeatMapHeight)
  }
dmattek's avatar
dmattek committed
577
  
dmattek's avatar
dmattek committed
578 579 580 581 582
  output$outPlotHier <- renderPlot({
    
    plotHier()
  }, height = getPlotHierHeatMapHeight)
  
583 584 585
  createFnameHeatMap = reactive({
    
    paste0('clust_hierch_heatMap_',
586
           input$selectPlotHierDiss,
587
           '_',
588
           input$selectPlotHierLinkage,
589 590 591 592 593 594
           '.png')
  })
  
  createFnameTrajPlot = reactive({
    
    paste0('clust_hierch_tCourses_',
595
           input$selectPlotHierDiss,
596
           '_',
597
           input$selectPlotHierLinkage, 
598 599 600 601 602 603
           '.pdf')
  })
  
  createFnameRibbonPlot = reactive({
    
    paste0('clust_hierch_tCoursesMeans_',
604
           input$selectPlotHierDiss,
605
           '_',
606
           input$selectPlotHierLinkage, 
607 608 609
           '.pdf')
  })
  
610 611 612
  createFnamePsdPlot = reactive({
    
    paste0('clust_hierch_tCoursesPsd_',
613
           input$selectPlotHierDiss,
614
           '_',
615
           input$selectPlotHierLinkage, 
616 617 618
           '.pdf')
  })
  
619 620 621
  createFnameDistPlot = reactive({
    
    paste0('clust_hierch_clDist_',
622
           input$selectPlotHierDiss,
623
           '_',
624
           input$selectPlotHierLinkage, '.pdf')  
625
  })
626
  
dmattek's avatar
dmattek committed
627 628
  
  #  Hierarchical - Heat Map - download pdf
629
  callModule(downPlot, "downPlotHier", createFnameHeatMap, plotHier)
dmattek's avatar
dmattek committed
630
  
631
  # plot individual trajectories withina cluster  
dmattek's avatar
dmattek committed
632 633
  callModule(modTrajPlot, 'modPlotHierTraj', 
             in.data = data4trajPlotCl, 
634
             in.data.stim = data4stimPlotCl,
635
             in.facet = COLCL,  
dmattek's avatar
dmattek committed
636
             in.facet.color = getClColHier,
637
             in.fname = createFnameTrajPlot)
dmattek's avatar
dmattek committed
638
  
639
  # plot cluster means
dmattek's avatar
dmattek committed
640 641
  callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon', 
             in.data = data4trajPlotCl, 
642
             in.data.stim = data4stimPlotCl,
643 644
             in.group = COLCL,  
             in.group.color = getClColHier,
645
             in.fname = createFnameRibbonPlot)
dmattek's avatar
dmattek committed
646
  
647 648 649
  # plot cluster PSD
  callModule(modPSDPlot, 'modPlotHierPsd',
             in.data = data4trajPlotCl,
650
             in.facet = COLCL,
651 652
             in.facet.color = getClColHier,
             in.fname = createFnamePsdPlot)
dmattek's avatar
dmattek committed
653
  
654
  # plot distribution barplot
dmattek's avatar
dmattek committed
655 656
  callModule(modClDistPlot, 'hierClDistPlot', 
             in.data = data4clDistPlot,
657
             in.colors = getClColHier,
658
             in.fname = createFnameDistPlot)
dmattek's avatar
dmattek committed
659 660 661 662 663 664 665

    # Pop-overs ----
  addPopover(session, 
             ns("alLearnMore"),
             title = "Hierarchical clustering",
             content = helpText.clHier[["alLearnMore"]],
             trigger = "click")
dmattek's avatar
dmattek committed
666
  
dmattek's avatar
dmattek committed
667 668
  
}