tabClHierSpar.R 21.3 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5 6
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for sparse hierarchical clustering using sparcl package
#
dmattek's avatar
Added:  
dmattek committed
7

dmattek's avatar
dmattek committed
8 9 10 11 12 13 14 15 16 17 18
helpText.clHierSpar = c(alImportance = paste0("<p>Weight factors (WF) calculated during clustering ",
                                              "reflect the importance of time points in the clustering. ",
                                              "The following labels are used to indicate the importance:",
                                              "<li>Black - time point not taken into account</li>",
                                              "<li><p, style=\"color:DodgerBlue;\">* - low, WF∈(0, 0.1]</p></li>",
                                              "<li><p, style=\"color:MediumSeaGreen;\">** - medium, WF∈(0.1, 0.5]</p></li>",
                                              "<li><p, style=\"color:Tomato;\">*** - high, WF∈(0.5, 1.0]</p></li>",
                                              "</p><p>Witten and Tibshirani (2010): ",
                                              "<i>A framework for feature selection in clustering</i>; ",
                                              "Journal of the American Statistical Association 105(490): 713-726.</p>"))

dmattek's avatar
dmattek committed
19
# UI ----
20
clustHierSparUI <- function(id, label = "Sparse Hierarchical Clustering") {
dmattek's avatar
Added:  
dmattek committed
21 22 23
  ns <- NS(id)
  
  tagList(
dmattek's avatar
dmattek committed
24 25
    h4(
      "Sparse hierarchical clustering using ",
26 27
      a("sparcl", 
        href = "https://cran.r-project.org/web/packages/sparcl/",
dmattek's avatar
dmattek committed
28 29
        title="External link",
        target = "_blank")
dmattek's avatar
dmattek committed
30
    ),
dmattek's avatar
dmattek committed
31 32
    p("Columns in the heatmap labeled according to their ",
      actionLink(ns("alImportance"), "importance.")),
dmattek's avatar
Added:  
dmattek committed
33 34 35
    br(),
    fluidRow(
      column(
36
        3,
dmattek's avatar
dmattek committed
37 38
        selectInput(
          ns("selectPlotHierSparDiss"),
39 40 41
          label = ("Dissimilarity measure"),
          choices = list("Euclidean" = "squared.distance",
                         "Manhattan" = "absolute.value"),
dmattek's avatar
dmattek committed
42 43
          selected = 1
        ),
dmattek's avatar
Added:  
dmattek committed
44 45
        selectInput(
          ns("selectPlotHierSparLinkage"),
46
          label = ("Linkage method"),
dmattek's avatar
Added:  
dmattek committed
47
          choices = list(
48 49 50 51
            "Average"  = "average",
            "Complete" = "complete",
            "Single"   = "single",
            "Centroid" = "centroid"
dmattek's avatar
Added:  
dmattek committed
52
          ),
53
          selected = 1
dmattek's avatar
Added:  
dmattek committed
54 55 56 57
        )
      ),
      
      column(
58
        6,
dmattek's avatar
Added:  
dmattek committed
59 60
        sliderInput(
          ns('inPlotHierSparNclust'),
61
          'Number of dendrogram branches to cut',
dmattek's avatar
Added:  
dmattek committed
62 63 64 65 66 67 68 69 70
          min = 1,
          max = 20,
          value = 1,
          step = 1,
          ticks = TRUE,
          round = TRUE
        ),
        checkboxInput(ns('chBPlotHierSparClSel'), 'Manually select clusters to display'),
        uiOutput(ns('uiPlotHierSparClSel')),
dmattek's avatar
dmattek committed
71
        downloadButton(ns('downCellClSpar'), 'Download CSV with cluster assignments')
dmattek's avatar
Added:  
dmattek committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85
      ),
      
      column(
        4,
        checkboxInput(ns('inHierSparAdv'),
                      'Advanced options',
                      FALSE),
        uiOutput(ns('uiPlotHierSparNperms')),
        uiOutput(ns('uiPlotHierSparNiter'))
      )
    ),
    
    
    br(),
dmattek's avatar
dmattek committed
86
    
dmattek's avatar
Added:  
dmattek committed
87
    tabsetPanel(
dmattek's avatar
dmattek committed
88 89
      tabPanel('Heatmap',
               br(),
dmattek's avatar
Added:  
dmattek committed
90 91 92 93
               fluidRow(
                 column(3,
                        selectInput(
                          ns("selectPlotHierSparPalette"),
dmattek's avatar
dmattek committed
94
                          label = "Heatmap\'s colour palette",
dmattek's avatar
Added:  
dmattek committed
95 96 97
                          choices = l.col.pal,
                          selected = 'Spectral'
                        ),
dmattek's avatar
dmattek committed
98
                        checkboxInput(ns('inPlotHierSparRevPalette'), 'Reverse heatmap\'s colour palette', TRUE),
99 100 101 102 103 104 105 106 107 108 109 110
                        checkboxInput(ns('selectPlotHierSparKey'), 'Plot colour key', TRUE),
                        
                        checkboxInput(ns('chBsetColBounds'), 'Set bounds for colour scale', FALSE),
                        
                        fluidRow(
                          column(3,
                                 uiOutput(ns('uiSetColBoundsLow'))
                          ),
                          column(3,
                                 uiOutput(ns('uiSetColBoundsHigh'))
                          )
                        )
dmattek's avatar
Added:  
dmattek committed
111 112
                 ),
                 column(3,
dmattek's avatar
dmattek committed
113 114 115 116 117 118 119
                        selectInput(
                          ns("selectPlotHierSparPaletteDend"),
                          label = "Dendrogram\'s colour palette",
                          choices = l.col.pal.dend.2,
                          selected = 'Color Blind'
                        ),
                        checkboxInput(ns('selectPlotHierSparDend'), 'Plot dendrogram and re-order samples', TRUE),
dmattek's avatar
Added:  
dmattek committed
120 121
                        sliderInput(
                          ns('inPlotHierSparNAcolor'),
dmattek's avatar
dmattek committed
122
                          'Shade of grey for NA values',
dmattek's avatar
Added:  
dmattek committed
123 124 125 126 127
                          min = 0,
                          max = 1,
                          value = 0.8,
                          step = .1,
                          ticks = TRUE
dmattek's avatar
dmattek committed
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
                        )
                        
                 ),
                 column(3,
                        numericInput(
                          ns('inPlotHierSparMarginX'),
                          'Bottom margin',
                          5,
                          min = 1,
                          width = "120px"
                        ),
                        numericInput(
                          ns('inPlotHierSparFontY'),
                          'Font size column labels',
                          1,
                          min = 0,
                          width = "180px",
                          step = 0.1
dmattek's avatar
Added:  
dmattek committed
146 147 148 149 150
                        ),
                        numericInput(ns('inPlotHierSparHeatMapHeight'), 
                                     'Display plot height [px]', 
                                     value = 600, 
                                     min = 100,
dmattek's avatar
dmattek committed
151 152 153
                                     step = 100, 
                                     width = "180px")
                        
dmattek's avatar
Added:  
dmattek committed
154
                 ),
dmattek's avatar
dmattek committed
155 156 157 158 159 160 161
                 column(3,
                        numericInput(
                          ns('inPlotHierSparMarginY'),
                          'Right margin',
                          20,
                          min = 1,
                          width = "120px"
dmattek's avatar
Added:  
dmattek committed
162
                        ),
dmattek's avatar
dmattek committed
163 164 165 166 167 168 169
                        numericInput(
                          ns('inPlotHierSparFontX'),
                          'Font size row labels',
                          1,
                          min = 0,
                          width = "180px",
                          step = 0.1
dmattek's avatar
Added:  
dmattek committed
170 171 172 173 174
                        )
                 )
               ),
               
               br(),
175
               actionButton(ns('butPlot'), 'Plot!'),
dmattek's avatar
dmattek committed
176
               downPlotUI(ns('downPlotHierSparHM'), "Download Plot"),
dmattek's avatar
dmattek committed
177
               withSpinner(plotOutput(ns('outPlotHierSpar')))
dmattek's avatar
dmattek committed
178

dmattek's avatar
Added:  
dmattek committed
179
      ),
dmattek's avatar
dmattek committed
180
      
181
      tabPanel('Averages',
dmattek's avatar
dmattek committed
182
               br(),
183 184
               modTrajRibbonPlotUI(ns('modPlotHierSparTrajRibbon'))),
      
dmattek's avatar
dmattek committed
185 186
      tabPanel('Time series',
               br(),
dmattek's avatar
Added:  
dmattek committed
187
               modTrajPlotUI(ns('modPlotHierSparTraj'))),
188
      
dmattek's avatar
dmattek committed
189 190
      tabPanel('PSD',
               br(),
dmattek's avatar
dmattek committed
191
               modPSDPlotUI(ns('modPlotHierSparPsd'))),
dmattek's avatar
dmattek committed
192 193 194
      
      tabPanel('Cluster distribution',
               br(),
dmattek's avatar
Added:  
dmattek committed
195 196 197 198 199
               modClDistPlotUI(ns('hierClSparDistPlot')))
    )
  )
}

dmattek's avatar
dmattek committed
200
# SERVER ----
dmattek's avatar
dmattek committed
201
clustHierSpar <- function(input, output, session, 
202
                          in.dataWide, 
dmattek's avatar
dmattek committed
203 204 205 206
                          in.data4trajPlot, 
                          in.data4stimPlot) {
  
  ns = session$ns
dmattek's avatar
dmattek committed
207
  
208 209 210 211 212 213
  # Return the number of clusters from the slider 
  # and delay by a constant in milliseconds defined in auxfunc.R
  returnNclust = reactive({
    return(input$inPlotHierSparNclust)
  }) %>% debounce(MILLIS)
  
dmattek's avatar
Added:  
dmattek committed
214 215 216 217 218 219 220 221 222 223 224 225 226 227 228
  # UI for advanced options
  output$uiPlotHierSparNperms = renderUI({
    ns <- session$ns
    if (input$inHierSparAdv)
      sliderInput(
        ns('inPlotHierSparNperms'),
        'Number of permutations',
        min = 1,
        max = 20,
        value = 1,
        step = 1,
        ticks = TRUE
      )
  })
  
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261
  output$uiSetColBoundsLow = renderUI({
    ns <- session$ns
    
    if(input$chBsetColBounds) {
      
      loc.dt = in.data4trajPlot()
      
      numericInput(
        ns('inSetColBoundsLow'),
        label = 'Lower',
        step = 0.1, 
        value = floor(min(loc.dt[['y']], na.rm = T))
      )
    }
  })
  
  
  output$uiSetColBoundsHigh = renderUI({
    ns <- session$ns
    
    if(input$chBsetColBounds) {
      
      loc.dt = in.data4trajPlot()
      
      numericInput(
        ns('inSetColBoundsHigh'),
        label = 'Upper',
        step = 0.1, 
        value = ceil(max(loc.dt[['y']], na.rm = T))
      )
    }
  })
  
dmattek's avatar
Added:  
dmattek committed
262 263 264
  # UI for advanced options
  output$uiPlotHierSparNiter = renderUI({
    ns <- session$ns
dmattek's avatar
dmattek committed
265
    
dmattek's avatar
Added:  
dmattek committed
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
    if (input$inHierSparAdv)
      sliderInput(
        ns('inPlotHierSparNiter'),
        'Number of iterations',
        min = 1,
        max = 50,
        value = 1,
        step = 1,
        ticks = TRUE
      )
  })
  
  
  output$uiPlotHierSparClSel = renderUI({
    ns <- session$ns
dmattek's avatar
dmattek committed
281
    
dmattek's avatar
Added:  
dmattek committed
282 283 284 285 286 287 288
    if(input$chBPlotHierSparClSel) {
      selectInput('inPlotHierSparClSel', 'Select clusters to display', 
                  choices = seq(1, input$inPlotHierSparNclust, 1),
                  multiple = TRUE, 
                  selected = 1)
    }
  })
dmattek's avatar
dmattek committed
289
  
dmattek's avatar
Added:  
dmattek committed
290 291 292
  
  userFitHierSpar <- reactive({
    cat(file = stderr(), 'userFitHierSpar \n')
dmattek's avatar
dmattek committed
293
    
294
    dm.t = in.dataWide()
dmattek's avatar
Added:  
dmattek committed
295 296 297 298
    if (is.null(dm.t)) {
      return()
    }
    
299 300
    #cat('rownames: ', rownames(dm.t), '\n')
    #cat('=============\ndimensions:', dim(dm.t), '\n')
dmattek's avatar
Added:  
dmattek committed
301 302 303 304 305
    
    perm.out <- HierarchicalSparseCluster.permute(
      dm.t,
      wbounds = NULL,
      nperms = ifelse(input$inHierSparAdv, input$inPlotHierSparNperms, 1),
306
      dissimilarity = input$selectPlotHierSparDiss
dmattek's avatar
Added:  
dmattek committed
307 308
    )
    
309
    loc.hc <- HierarchicalSparseCluster(
dmattek's avatar
Added:  
dmattek committed
310 311 312
      dists = perm.out$dists,
      wbound = perm.out$bestw,
      niter = ifelse(input$inHierSparAdv, input$inPlotHierSparNiter, 1),
313 314
      method = input$selectPlotHierSparLinkage,
      dissimilarity = input$selectPlotHierSparDiss
dmattek's avatar
Added:  
dmattek committed
315
    )
dmattek's avatar
dmattek committed
316
    
317 318
    #cat('=============\nloc.hc:\n')
    #print(loc.hc$hc)
dmattek's avatar
dmattek committed
319
    
320
    return(loc.hc)
dmattek's avatar
Added:  
dmattek committed
321 322 323
  })
  
  
dmattek's avatar
dmattek committed
324 325
  
  # return dendrogram colour coded according to the cut level of the dendrogram
dmattek's avatar
Added:  
dmattek committed
326
  userFitDendHierSpar <- reactive({
327 328
    loc.hc = userFitHierSpar()
    if (is.null(loc.hc)) {
dmattek's avatar
Added:  
dmattek committed
329 330
      return()
    }
dmattek's avatar
dmattek committed
331

332
    # number of clusters at which dendrogram is cut
dmattek's avatar
dmattek committed
333
    loc.k = input$inPlotHierSparNclust
dmattek's avatar
Added:  
dmattek committed
334
    
dmattek's avatar
dmattek committed
335 336 337
    # make a palette with the amount of colours equal to the number of clusters
    #loc.col = get(input$selectPlotHierSparPaletteDend)(n = loc.k)
    loc.col = ggthemes::tableau_color_pal(input$selectPlotHierSparPaletteDend)(n = loc.k)
dmattek's avatar
dmattek committed
338 339
    
    
340
    dend <- as.dendrogram(loc.hc$hc)
dmattek's avatar
Added:  
dmattek committed
341
    dend <- color_branches(dend, 
dmattek's avatar
dmattek committed
342 343
                           col = loc.col,
                           k = loc.k)
dmattek's avatar
Added:  
dmattek committed
344 345 346 347
    
    return(dend)
  })
  
348 349 350 351
  # 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
Added:  
dmattek committed
352 353 354 355 356 357 358
  getClColHierSpar <- reactive({
    cat(file = stderr(), 'getClColHierSpar \n')
    
    loc.dend = userFitDendHierSpar()
    if (is.null(loc.dend))
      return(NULL)
    
359 360
    # obtain relations between cluster and colors from the dendrogram
    loc.dt = LOCgetClCol(loc.dend, input$inPlotHierSparNclust)
dmattek's avatar
dmattek committed
361
    
362 363
    # set the key to allow subsetting
    setkey(loc.dt, gr.no)
dmattek's avatar
dmattek committed
364
    
365
    return(loc.dt)
dmattek's avatar
Added:  
dmattek committed
366 367
  })
  
dmattek's avatar
dmattek committed
368
  
dmattek's avatar
Added:  
dmattek committed
369 370 371 372
  # return all unique track object labels (created in dataMod)
  # This will be used to display in UI for trajectory highlighting
  getDataTrackObjLabUni_afterTrim <- reactive({
    cat(file = stderr(), 'getDataTrackObjLabUni_afterTrim\n')
373
    loc.dt = in.dataWide()
dmattek's avatar
Added:  
dmattek committed
374 375 376 377
    
    if (is.null(loc.dt))
      return(NULL)
    else
dmattek's avatar
dmattek committed
378
      return(rownames(loc.dt))
dmattek's avatar
Added:  
dmattek committed
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408
  })
  
  # 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')
    loc.dt = in.data4trajPlot()
    
    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
  data4trajPlotClSpar <- reactive({
    cat(file = stderr(), 'data4trajPlotClSpar: in\n')
    
    loc.dt = in.data4trajPlot()
    
    if (is.null(loc.dt)) {
      cat(file = stderr(), 'data4trajPlotClSpar: dt is NULL\n')
      return(NULL)
    }
    
    cat(file = stderr(), 'data4trajPlotClSpar: dt not NULL\n')
    
409
    #cat('rownames: ', rownames(in.dataWide()), '\n')
dmattek's avatar
dmattek committed
410
    
dmattek's avatar
Added:  
dmattek committed
411
    # get cellIDs with cluster assignments based on dendrogram cut
dmattek's avatar
dmattek committed
412 413 414
    loc.dt.cl = getDataClSpar(userFitDendHierSpar(), 
                              input$inPlotHierSparNclust, 
                              getDataTrackObjLabUni_afterTrim())
dmattek's avatar
dmattek committed
415
    
dmattek's avatar
dmattek committed
416 417 418 419 420
    ####
    ## PROBLEM!!!
    ## the dendrogram from sparse hier clust doesn't contain cellID's
    ## the following merge won't work...
    ## No idea how to solve it
dmattek's avatar
dmattek committed
421
    
422
    loc.dt = merge(loc.dt, loc.dt.cl, by = COLID)
dmattek's avatar
Added:  
dmattek committed
423 424 425 426 427 428 429 430
    
    # display only selected clusters
    if(input$chBPlotHierSparClSel)
      loc.dt = loc.dt[cl %in% input$inPlotHierSparClSel]
    
    return(loc.dt)    
  })
  
431 432 433 434 435 436 437 438 439 440 441 442 443 444
  data4stimPlotClSpar <- reactive({
    cat(file = stderr(), 'data4stimPlotClSpar: in\n')
    
    loc.dt = in.data4stimPlot()
    
    if (is.null(loc.dt)) {
      cat(file = stderr(), 'data4stimPlotClSpar: dt is NULL\n')
      return(NULL)
    }
    
    cat(file = stderr(), 'data4stimPlotClSpar: dt not NULL\n')
    return(loc.dt)
  })
  
dmattek's avatar
Added:  
dmattek committed
445 446 447 448 449
  
  # download a list of cellIDs with cluster assignments
  output$downCellClSpar <- downloadHandler(
    filename = function() {
      paste0('clust_hierchSpar_data_',
majpark21's avatar
majpark21 committed
450
             ifelse(input$selectPlotHierSparDiss == "squared.distance", "euclidean", "manhattan"),
dmattek's avatar
Added:  
dmattek committed
451
             '_',
452
             input$selectPlotHierSparLinkage, '.csv')
dmattek's avatar
Added:  
dmattek committed
453 454 455
    },
    
    content = function(file) {
dmattek's avatar
dmattek committed
456 457 458 459
      write.csv(x = getDataClSpar(userFitDendHierSpar(), 
                                  input$inPlotHierSparNclust, 
                                  getDataTrackObjLabUni_afterTrim()), 
                file = file, row.names = FALSE)
dmattek's avatar
Added:  
dmattek committed
460 461 462 463 464 465 466 467
    }
  )
  
  # prepare data for barplot with distribution of items per condition  
  data4clSparDistPlot <- reactive({
    cat(file = stderr(), 'data4clSparDistPlot: in\n')
    
    # get cell IDs with cluster assignments depending on dendrogram cut
dmattek's avatar
dmattek committed
468
    loc.dend <- userFitDendHierSpar()
dmattek's avatar
Added:  
dmattek committed
469 470 471 472 473
    if (is.null(loc.dend)) {
      cat(file = stderr(), 'plotClSparDist: loc.dend is NULL\n')
      return(NULL)
    }
    
dmattek's avatar
dmattek committed
474 475
    # get cell id's with associated cluster numbers
    loc.dt.cl = getDataClSpar(loc.dend, input$inPlotHierSparNclust, getDataTrackObjLabUni_afterTrim())
dmattek's avatar
Added:  
dmattek committed
476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 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(), 'plotClSparDist: loc.dt.gr is NULL\n')
      return(NULL)
    }
    
    loc.dt = merge(loc.dt.cl, loc.dt.gr, by = 'id')
    
    # display only selected clusters
    if(input$chBPlotHierSparClSel)
      loc.dt = loc.dt[cl %in% input$inPlotHierSparClSel]
    
    loc.dt.aggr = loc.dt[, .(nCells = .N), by = .(group, cl)]
    
    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
  plotHierSpar <- function() {
500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516
    cat(file = stderr(), 'plotHierSpar: in\n')
    
    # make the f-n dependent on the button click
    locBut = input$butPlot
    
    # 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.hc = isolate(userFitHierSpar())
    loc.dend = isolate(userFitDendHierSpar())
    
    validate(
      need(!is.null(loc.dm), "Nothing to plot. Load data first!"),
      need(!is.null(loc.hc), "Did not cluster"),
      need(!is.null(loc.dend), "Did not create dendrogram")
    )
dmattek's avatar
Added:  
dmattek committed
517
    
518 519 520
    # 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
521
    
522 523
    # create column labels according to importance weights
    loc.colnames = paste0(ifelse(loc.hc$ws == 0, "",
dmattek's avatar
Added:  
dmattek committed
524
                                 ifelse(
525
                                   loc.hc$ws <= 0.1,
dmattek's avatar
Added:  
dmattek committed
526
                                   "* ",
527
                                   ifelse(loc.hc$ws <= 0.5, "** ", "*** ")
dmattek's avatar
Added:  
dmattek committed
528 529
                                 )),  colnames(loc.dm))
    
530 531
    # add color to column labels according to importance weights
    loc.colcol   = ifelse(loc.hc$ws == 0,
dmattek's avatar
Added:  
dmattek committed
532 533
                          "black",
                          ifelse(
534
                            loc.hc$ws <= 0.1,
dmattek's avatar
Added:  
dmattek committed
535
                            "blue",
536
                            ifelse(loc.hc$ws <= 0.5, "green", "red")
dmattek's avatar
Added:  
dmattek committed
537 538
                          ))
    
539 540 541 542 543 544 545
    loc.col.bounds = NULL
    if (input$chBsetColBounds)
      loc.col.bounds = c(input$inSetColBoundsLow, input$inSetColBoundsHigh)
    else 
      loc.col.bounds = NULL
    
    
dmattek's avatar
dmattek committed
546
    loc.p = LOCplotHeatmap(loc.dm,
dmattek's avatar
dmattek committed
547 548 549 550 551 552 553 554 555 556 557 558 559 560 561
                           loc.dend, 
                           palette.arg = input$selectPlotHierSparPalette, 
                           palette.rev.arg = input$inPlotHierSparRevPalette, 
                           dend.show.arg = input$selectPlotHierSparDend, 
                           key.show.arg = input$selectPlotHierSparKey, 
                           margin.x.arg = input$inPlotHierSparMarginX, 
                           margin.y.arg = input$inPlotHierSparMarginY, 
                           nacol.arg = input$inPlotHierSparNAcolor, 
                           colCol.arg = loc.colcol,
                           labCol.arg = loc.colnames,
                           font.row.arg = input$inPlotHierSparFontX, 
                           font.col.arg = input$inPlotHierSparFontY, 
                           breaks.arg = loc.col.bounds,
                           title.arg = paste(
                             "Distance measure: ",
562
                             input$selectPlotHierSparDiss,
dmattek's avatar
dmattek committed
563
                             "\nLinkage method: ",
564
                             input$selectPlotHierSparLinkage
dmattek's avatar
dmattek committed
565
                           ))
dmattek's avatar
Added:  
dmattek committed
566 567 568 569 570 571 572 573
    
    return(loc.p)
  }
  
  getPlotHierSparHeatMapHeight <- function() {
    return (input$inPlotHierSparHeatMapHeight)
  }
  
574 575 576
  createFnameHeatMap = reactive({
    
    paste0('clust_hierchSparse_heatMap_',
majpark21's avatar
majpark21 committed
577
           ifelse(input$selectPlotHierSparDiss == "squared.distance", "euclidean", "manhattan"),
578
           '_',
579
           input$selectPlotHierSparLinkage,
580 581 582 583 584 585
           '.png')
  })
  
  createFnameTrajPlot = reactive({
    
    paste0('clust_hierchSparse_tCourses_',
majpark21's avatar
majpark21 committed
586
           ifelse(input$selectPlotHierSparDiss == "squared.distance", "euclidean", "manhattan"),
587
           '_',
588
           input$selectPlotHierSparLinkage, 
589 590 591 592 593 594
           '.pdf')
  })
  
  createFnameRibbonPlot = reactive({
    
    paste0('clust_hierchSparse_tCoursesMeans_',
majpark21's avatar
majpark21 committed
595
           ifelse(input$selectPlotHierSparDiss == "squared.distance", "euclidean", "manhattan"),
596
           '_',
597
           input$selectPlotHierSparLinkage, 
598 599 600
           '.pdf')
  })
  
dmattek's avatar
dmattek committed
601 602 603
  createFnamePsdPlot = reactive({
    
    paste0('clust_hierchSparse_tCoursesPsd_',
majpark21's avatar
majpark21 committed
604
           ifelse(input$selectPlotHierSparDiss == "squared.distance", "euclidean", "manhattan"),
dmattek's avatar
dmattek committed
605
           '_',
606
           input$selectPlotHierSparLinkage, 
dmattek's avatar
dmattek committed
607 608 609
           '.pdf')
  })
  
610 611 612
  createFnameDistPlot = reactive({
    
    paste0('clust_hierchSparse_clDist_',
majpark21's avatar
majpark21 committed
613
           ifelse(input$selectPlotHierSparDiss == "squared.distance", "euclidean", "manhattan"),
614
           '_',
615
           input$selectPlotHierSparLinkage, '.pdf')  })
616 617 618 619 620 621
  
  
  
  # Sparse Hierarchical - Heat Map - download pdf
  callModule(downPlot, "downPlotHierSparHM", createFnameHeatMap, plotHierSpar)
  
622
  # plot individual trajectories withina cluster  
dmattek's avatar
Added:  
dmattek committed
623 624
  callModule(modTrajPlot, 'modPlotHierSparTraj', 
             in.data = data4trajPlotClSpar, 
625
             in.data.stim = data4stimPlotClSpar,
626
             in.facet = COLCL, 
dmattek's avatar
Added:  
dmattek committed
627
             in.facet.color = getClColHierSpar,
628
             in.fname = createFnameTrajPlot)
dmattek's avatar
Added:  
dmattek committed
629
  
630
  # plot cluster means
dmattek's avatar
dmattek committed
631 632
  callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon', 
             in.data = data4trajPlotClSpar, 
633
             in.data.stim = data4stimPlotClSpar,
634 635
             in.group = COLCL,  
             in.group.color = getClColHierSpar,
636
             in.fname = createFnameRibbonPlot)
dmattek's avatar
Added:  
dmattek committed
637
  
dmattek's avatar
dmattek committed
638 639 640
  # plot cluster PSD
  callModule(modPSDPlot, 'modPlotHierSparPsd',
             in.data = data4trajPlotClSpar,
641
             in.facet = COLCL,
dmattek's avatar
dmattek committed
642 643 644
             in.facet.color = getClColHierSpar,
             in.fname = createFnamePsdPlot)
  
645
  # plot distribution barplot
dmattek's avatar
Added:  
dmattek committed
646 647
  callModule(modClDistPlot, 'hierClSparDistPlot', 
             in.data = data4clSparDistPlot,
648
             in.colors = getClColHierSpar,
649
             in.fname = createFnameDistPlot)
dmattek's avatar
Added:  
dmattek committed
650 651 652 653 654 655 656
  
  
  
  # Sparse Hierarchical - display heatmap
  output$outPlotHierSpar <- renderPlot({
    plotHierSpar()
  }, height = getPlotHierSparHeatMapHeight)
dmattek's avatar
dmattek committed
657

658 659
  # Pop-overs ----
  
dmattek's avatar
dmattek committed
660 661 662
  addPopover(session, 
             ns("alImportance"),
             title = "Variable importance",
dmattek's avatar
dmattek committed
663
             content = helpText.clHierSpar[["alImportance"]],
dmattek's avatar
dmattek committed
664 665 666 667 668
             trigger = "click")

}