auxfunc.R 19.3 KB
Newer Older
dmattek's avatar
dmattek committed
1
2
3
4
5
6
7
8
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# These are auxilary functions
#


dmattek's avatar
dmattek committed
9
require(ggplot2)
dmattek's avatar
Mod:    
dmattek committed
10
11
12
require(RColorBrewer)
require(gplots) # for heatmap.2
require(grid) # for modifying grob
dmattek's avatar
dmattek committed
13

dmattek's avatar
dmattek committed
14
# Colour definitions ----
dmattek's avatar
dmattek committed
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
rhg_cols <- c(
  "#771C19",
  "#AA3929",
  "#E25033",
  "#F27314",
  "#F8A31B",
  "#E2C59F",
  "#B6C5CC",
  "#8E9CA3",
  "#556670",
  "#000000"
)

md_cols <- c(
  "#FFFFFF",
  "#F8A31B",
  "#F27314",
  "#E25033",
  "#AA3929",
  "#FFFFCC",
  "#C2E699",
  "#78C679",
  "#238443"
)

40
# list of palettes for the heatmap
dmattek's avatar
dmattek committed
41
42
43
44
45
46
47
48
49
50
l.col.pal = list(
  "White-Orange-Red" = 'OrRd',
  "Yellow-Orange-Red" = 'YlOrRd',
  "Reds" = "Reds",
  "Oranges" = "Oranges",
  "Greens" = "Greens",
  "Blues" = "Blues",
  "Spectral" = 'Spectral'
)

51
52
53
54
55
56
57
58
59
60
# list of palettes for the dendrogram
l.col.pal.dend = list(
  "Rainbow" = 'rainbow_hcl',
  "Sequential" = 'sequential_hcl',
  "Heat" = 'heat_hcl',
  "Terrain" = 'terrain_hcl',
  "Diverge HCL" = 'diverge_hcl',
  "Diverge HSV" = 'diverge_hsv'
)

dmattek's avatar
dmattek committed
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
# Clustering algorithms ----

s.cl.linkage = c("ward.D",
                 "ward.D2",
                 "single",
                 "complete",
                 "average",
                 "mcquitty",
                 "centroid")

s.cl.spar.linkage = c("average",
                      "complete", 
                      "single",
                      "centroid")

s.cl.diss = c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", "DTW")
s.cl.spar.diss = c("squared.distance","absolute.value")


# Help text ----
dmattek's avatar
Added:    
dmattek committed
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
# Creates a popup with help text
# From: https://gist.github.com/jcheng5/5913297
helpPopup <- function(title, content,
                      placement=c('right', 'top', 'left', 'bottom'),
                      trigger=c('click', 'hover', 'focus', 'manual')) {
  tagList(
    singleton(
      tags$head(
        tags$script("$(function() { $(\"[data-toggle='popover']\").popover(); })")
      )
    ),
    tags$a(
      href = "#", class = "btn btn-mini", `data-toggle` = "popover",
      title = title, `data-content` = content, `data-animation` = TRUE,
      `data-placement` = match.arg(placement, several.ok=TRUE)[1],
      `data-trigger` = match.arg(trigger, several.ok=TRUE)[1],
      #tags$i(class="icon-question-sign")
      # changed based on http://stackoverflow.com/questions/30436013/info-bubble-text-in-a-shiny-interface
      icon("question")
    )
  )
}

help.text = c(
  'Accepts CSV file with a column of cell IDs for removal. 
                   IDs should correspond to those used for plotting. 
  Say, the main data file contains columns Metadata_Site and TrackLabel. 
  These two columns should be then selected in UI to form a unique cell ID, e.g. 001_0001 where former part corresponds to Metadata_Site and the latter to TrackLabel.',
  'Plotting and data processing requires a unique cell ID across entire dataset. A typical dataset from CellProfiler assigns unique cell ID (TrackLabel) within each field of view (Metadata_Site).
110
111
                   Therefore, a unique ID is created by concatenating these two columns. If the dataset already contains a unique ID, UNcheck this box and select a single column only.',
  'This option allows to interpolate NAs or missing data. Some rows in the input file might be missing because a particular time point might not had been acquired. 
112
  This option, interpolates such missing points as well as points with NAs in the measurement column. When this option is checked, the interval of time column must be provided!',
dmattek's avatar
dmattek committed
113
  'Accepts CSV file with 5 columns: grouping (e.g. condition), start and end time points of stimulation, start and end points of y-position, dummy column with id.'
dmattek's avatar
Added:    
dmattek committed
114
115
116
)


dmattek's avatar
dmattek committed
117
# Functions for clustering ----
dmattek's avatar
dmattek committed
118
119
120
121
122
123
124
125
126

# Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k)
# This one works wth dist & hclust pair
# For sparse hierarchical clustering use getDataClSpar
# Arguments:
# in.dend  - dendrogram; usually output from as.dendrogram(hclust(distance_matrix))
# in.k - level at which dendrogram should be cut

getDataCl = function(in.dend, in.k) {
dmattek's avatar
Added:    
dmattek committed
127
128
  cat(file = stderr(), 'getDataCl \n')
  
dmattek's avatar
dmattek committed
129
130
131
132
133
134
135
136
  loc.m = dendextend::cutree(in.dend, in.k, order_clusters_as_data = TRUE)
  #print(loc.m)
  
  # The result of cutree containes named vector with names being cell id's
  # THIS WON'T WORK with sparse hierarchical clustering because there, the dendrogram doesn't have original id's
  loc.dt.cl = data.table(id = names(loc.m),
                         cl = loc.m)
  
137
138
  #cat('===============\ndataCl:\n')
  #print(loc.dt.cl)
dmattek's avatar
dmattek committed
139
  return(loc.dt.cl)
dmattek's avatar
Added:    
dmattek committed
140
141
}

dmattek's avatar
dmattek committed
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

# Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k)
# This one works with sparse hierarchical clustering!
# Arguments:
# in.dend  - dendrogram; usually output from as.dendrogram(hclust(distance_matrix))
# in.k - level at which dendrogram should be cut
# in.id - vector of cell id's

getDataClSpar = function(in.dend, in.k, in.id) {
  cat(file = stderr(), 'getDataClSpar \n')
  
  loc.m = dendextend::cutree(in.dend, in.k, order_clusters_as_data = TRUE)
  #print(loc.m)
  
  # The result of cutree containes named vector with names being cell id's
  # THIS WON'T WORK with sparse hierarchical clustering because there, the dendrogram doesn't have original id's
  loc.dt.cl = data.table(id = in.id,
                         cl = loc.m)
  
161
162
  #cat('===============\ndataCl:\n')
  #print(loc.dt.cl)
dmattek's avatar
dmattek committed
163
164
165
166
167
  return(loc.dt.cl)
}



dmattek's avatar
Added:    
dmattek committed
168
169
170
171
172
173
174
175
176
177
178
179
180
# prepares a table with cluster numbers in 1st column and colour assignments in 2nd column
# the number of rows is determined by dendrogram cut
getClCol <- function(in.dend, in.k) {
  
  loc.col_labels <- get_leaves_branches_col(in.dend)
  loc.col_labels <- loc.col_labels[order(order.dendrogram(in.dend))]
  
  return(unique(
    data.table(cl.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE),
               cl.col = loc.col_labels)))
}


dmattek's avatar
dmattek committed
181
# Custom plotting functions ----
dmattek's avatar
dmattek committed
182

dmattek's avatar
dmattek committed
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
# Build Function to Return Element Text Object
# From: https://stackoverflow.com/a/36979201/1898713
rotatedAxisElementText = function(angle, position='x', size = 12){
  angle     = angle[1]; 
  position  = position[1]
  positions = list(x=0, y=90, top=180, right=270)
  if(!position %in% names(positions))
    stop(sprintf("'position' must be one of [%s]",paste(names(positions),collapse=", ")), call.=FALSE)
  if(!is.numeric(angle))
    stop("'angle' must be numeric",call.=FALSE)
  rads = (-angle - positions[[ position ]])*pi/180
  hjust = round((1 - sin(rads)))/2
  vjust = round((1 + cos(rads)))/2
  element_text(size = 12, angle = angle, vjust = vjust, hjust = hjust)
}

199
# default ggplot theme used in the app
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
myGgplotTheme = 
  theme_bw(base_size = 8, base_family = "Helvetica") +
  theme(
    panel.spacing = unit(1, "lines"),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_blank(),
    panel.border = element_blank(),
    axis.line.x = element_line(color = "black", size = 0.25),
    axis.line.y = element_line(color = "black", size = 0.25),
    axis.text = element_text(size = 8),
    axis.title = element_text(size = 8),
    strip.text = element_text(size = 10, face = "bold"),
    strip.background = element_blank(),
    legend.key = element_blank(), 
    legend.text = element_text(size = 8),
    legend.key.height = unit(1, "lines"),
    legend.key.width = unit(2, "lines"),
    legend.position = "top"
  )

220
221
222

# Plot individual time series
LOCplotTraj = function(dt.arg, # input data table
dmattek's avatar
Mod:    
dmattek committed
223
224
225
226
227
228
229
230
231
232
233
                        x.arg,  # string with column name for x-axis
                        y.arg, # string with column name for y-axis
                        group.arg, # string with column name for grouping time series (typicaly cell ID)
                        facet.arg, # string with column name for facetting
                        facet.ncol.arg = 2, # default number of facet columns
                        facet.color.arg = NULL, # vector with list of colours for adding colours to facet names (currently a horizontal line on top of the facet is drawn)
                        line.col.arg = NULL, # string with column name for colouring time series (typically when individual time series are selected in UI)
                        xlab.arg = NULL, # string with x-axis label
                        ylab.arg = NULL, # string with y-axis label
                        plotlab.arg = NULL, # string with plot label
                        dt.stim.arg = NULL, # plotting additional dataset; typically to indicate stimulations (not fully implemented yet, not tested!)
234
235
                        x.stim.arg = c('tstart', 'tend'), # column names in stimulation dt with x and xend parameters
                        y.stim.arg = c('ystart', 'yend'), # column names in stimulation dt with y and yend parameters
dmattek's avatar
dmattek committed
236
                        tfreq.arg = 1,
dmattek's avatar
dmattek committed
237
                        ylim.arg = NULL,
dmattek's avatar
Added:    
dmattek committed
238
                        stim.bar.width.arg = 0.5,
dmattek's avatar
Mod:    
dmattek committed
239
                        aux.label1 = NULL, # 1st point label; used for interactive plotting; displayed in the tooltip; typically used to display values of column holding x & y coordinates
dmattek's avatar
Added:    
dmattek committed
240
                        aux.label2 = NULL,
241
                        aux.label3 = NULL,
dmattek's avatar
Added:    
dmattek committed
242
243
244
245
246
                        stat.arg = c('', 'mean', 'CI', 'SE')) {
  
  # match arguments for stat plotting
  loc.stat = match.arg(stat.arg, several.ok = TRUE)

dmattek's avatar
Added:    
dmattek committed
247
248
  
  # aux.label12 are required for plotting XY positions in the tooltip of the interactive (plotly) graph
dmattek's avatar
dmattek committed
249
250
  p.tmp = ggplot(dt.arg,
                 aes_string(x = x.arg,
dmattek's avatar
dmattek committed
251
                            y = y.arg,
dmattek's avatar
Added:    
dmattek committed
252
                            group = group.arg,
253
254
255
256
257
                            label = group.arg))
  #,
  #                          label  = aux.label1,
  #                          label2 = aux.label2,
  #                          label3 = aux.label3))
dmattek's avatar
dmattek committed
258
  
dmattek's avatar
dmattek committed
259
260
261
262
263
264
265
266
267
268
269
270
271
  if (is.null(line.col.arg)) {
    p.tmp = p.tmp +
      geom_line(alpha = 0.25, 
                              size = 0.25)
  }
  else {
    p.tmp = p.tmp + 
      geom_line(aes_string(colour = line.col.arg), 
                              alpha = 0.5, 
                              size = 0.5) +
      scale_color_manual(name = '', 
                         values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green', "NOT SEL" = rhg_cols[7]))
  }
dmattek's avatar
Mod:    
dmattek committed
272
273
274
275
276
277
278
279
280
281

  # this is temporary solution for adding colour according to cluster number
  # use only when plotting traj from clustering!
  # a horizontal line is added at the top of data
  if (!is.null(facet.color.arg)) {

    loc.y.max = max(dt.arg[, c(y.arg), with = FALSE])
    loc.dt.cl = data.table(xx = 1:length(facet.color.arg), yy = loc.y.max)
    setnames(loc.dt.cl, 'xx', facet.arg)
    
dmattek's avatar
Fixed:    
dmattek committed
282
283
    # adjust facet.color.arg to plot
    
dmattek's avatar
Mod:    
dmattek committed
284
285
286
287
288
    p.tmp = p.tmp +
      geom_hline(data = loc.dt.cl, colour = facet.color.arg, yintercept = loc.y.max, size = 4) +
      scale_colour_manual(values = facet.color.arg,
                          name = '')
  }
dmattek's avatar
dmattek committed
289
  
dmattek's avatar
Added:    
dmattek committed
290
291
  if ('mean' %in% loc.stat)
    p.tmp = p.tmp + 
dmattek's avatar
dmattek committed
292
293
294
    stat_summary(
      aes_string(y = y.arg, group = 1),
      fun.y = mean,
dmattek's avatar
Added:    
dmattek committed
295
      colour = 'red',
dmattek's avatar
dmattek committed
296
297
298
299
      linetype = 'solid',
      size = 1,
      geom = "line",
      group = 1
dmattek's avatar
Added:    
dmattek committed
300
301
302
303
304
305
306
307
    )

  if ('CI' %in% loc.stat)
    p.tmp = p.tmp + 
    stat_summary(
      aes_string(y = y.arg, group = 1),
      fun.data = mean_cl_normal,
      colour = 'red',
dmattek's avatar
Mod:    
dmattek committed
308
      alpha = 0.25,
dmattek's avatar
Added:    
dmattek committed
309
310
311
312
313
314
315
316
317
318
      geom = "ribbon",
      group = 1
    )
  
  if ('SE' %in% loc.stat)
    p.tmp = p.tmp + 
    stat_summary(
      aes_string(y = y.arg, group = 1),
      fun.data = mean_se,
      colour = 'red',
dmattek's avatar
Mod:    
dmattek committed
319
      alpha = 0.25,
dmattek's avatar
Added:    
dmattek committed
320
321
322
323
324
325
326
      geom = "ribbon",
      group = 1
    )
  
  
  
  p.tmp = p.tmp + 
dmattek's avatar
dmattek committed
327
328
329
    facet_wrap(as.formula(paste("~", facet.arg)),
               ncol = facet.ncol.arg,
               scales = "free_x")
330
331
332
333

  # plot stimulation bars underneath time series
  # dt.stim.arg is read separately and should contain 4 columns with
  # xy positions of beginning and end of the bar
dmattek's avatar
dmattek committed
334
335
  if(!is.null(dt.stim.arg)) {
    p.tmp = p.tmp + geom_segment(data = dt.stim.arg,
336
337
338
339
340
                                 aes_string(x = x.stim.arg[1],
                                            xend = x.stim.arg[2],
                                            y = y.stim.arg[1],
                                            yend = y.stim.arg[2],
                                            group = 'group'),
dmattek's avatar
dmattek committed
341
                                 colour = rhg_cols[[3]],
342
                                 size = stim.bar.width.arg) 
dmattek's avatar
dmattek committed
343
344
  }
  
dmattek's avatar
dmattek committed
345
346
347
  if (!is.null(ylim.arg)) 
    p.tmp = p.tmp + coord_cartesian(ylim = ylim.arg)
  
dmattek's avatar
dmattek committed
348
349
350
351
  p.tmp = p.tmp + 
    xlab(paste0(xlab.arg, "\n")) +
    ylab(paste0("\n", ylab.arg)) +
    ggtitle(plotlab.arg) +
352
    ggplotTheme() + 
353
    theme(legend.position = "top")
dmattek's avatar
dmattek committed
354
  
dmattek's avatar
Mod:    
dmattek committed
355
  return(p.tmp)
dmattek's avatar
dmattek committed
356
357
}

358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
# Plot average time series with CI together in one facet
LOCplotTrajRibbon = function(dt.arg, # input data table
                          x.arg, # string with column name for x-axis
                          y.arg, # string with column name for y-axis
                          group.arg = NULL, # string with column name for grouping time series (here, it's a column corresponding to grouping by condition)
                          col.arg = NULL, # colour pallette for individual time series
                          dt.stim.arg = NULL, # data table with stimulation pattern
                          x.stim.arg = c('tstart', 'tend'), # column names in stimulation dt with x and xend parameters
                          y.stim.arg = c('ystart', 'yend'), # column names in stimulation dt with y and yend parameters
                          stim.bar.width.arg = 0.5,
                          ribbon.lohi.arg = c('Lower', 'Upper'),
                          ribbon.fill.arg = 'grey50',
                          ribbon.alpha.arg = 0.5,
                          xlab.arg = NULL,
                          ylab.arg = NULL,
                          plotlab.arg = NULL) {
  
  p.tmp = ggplot(dt.arg, aes_string(x = x.arg, group = group.arg)) +
    geom_ribbon(aes_string(ymin = ribbon.lohi.arg[1], ymax = ribbon.lohi.arg[2]),
                fill = ribbon.fill.arg,
                alpha = ribbon.alpha.arg) +
    geom_line(aes_string(y = y.arg, colour = group.arg))
  
dmattek's avatar
dmattek committed
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
409
410
411
412
  # plot stimulation bars underneath time series
  # dt.stim.arg is read separately and should contain 4 columns with
  # xy positions of beginning and end of the bar
  if(!is.null(dt.stim.arg)) {
    p.tmp = p.tmp + geom_segment(data = dt.stim.arg,
                                 aes_string(x = x.stim.arg[1],
                                     xend = x.stim.arg[2],
                                     y = y.stim.arg[1],
                                     yend = y.stim.arg[2]),
                                 colour = rhg_cols[[3]],
                                 size = stim.bar.width.arg,
                                 group = 1) 
  }

  
  if (is.null(col.arg)) {
    p.tmp = p.tmp +
      scale_color_discrete(name = '')
  } else {
    p.tmp = p.tmp +
      scale_colour_manual(values = col.arg, name = '')
  }
  
  if (!is.null(plotlab.arg))
    p.tmp = p.tmp + ggtitle(plotlab.arg)
  
  p.tmp = p.tmp +
    xlab(xlab.arg) +
    ylab(ylab.arg)
  
  return(p.tmp)
413
414
415
}


416

dmattek's avatar
dmattek committed
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
# Plots a scatter plot with marginal histograms
# Points are connected by a line (grouping by cellID)
#
# Assumes an input of data.table with
# x, y - columns with x and y coordinates
# id - a unique point identifier (here corresponds to cellID)
# mid - a (0,1) column by which points are coloured (here corresponds to whether cells are within bounds)

myGgplotScat = function(dt.arg,
                        band.arg = NULL,
                        facet.arg = NULL,
                        facet.ncol.arg = 2,
                        xlab.arg = NULL,
                        ylab.arg = NULL,
                        plotlab.arg = NULL,
                        alpha.arg = 1,
                        group.col.arg = NULL) {
  p.tmp = ggplot(dt.arg, aes(x = x, y = y))
  
  if (is.null(group.col.arg)) {
    p.tmp = p.tmp +
      geom_point(alpha = alpha.arg, aes(group = id))
  } else {
    p.tmp = p.tmp +
      geom_point(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
      geom_path(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
      scale_color_manual(name = group.col.arg, values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green'))
  }
  
  if (is.null(band.arg))
    p.tmp = p.tmp +
      stat_smooth(
dmattek's avatar
dmattek committed
449
450
451
        # method = function(formula, data, weights = weight)
        #   rlm(formula, data, weights = weight, method = 'MM'),
        method = "lm",
dmattek's avatar
dmattek committed
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
        fullrange = FALSE,
        level = 0.95,
        colour = 'blue'
      )
  else {
    p.tmp = p.tmp +
      geom_abline(slope = band.arg$a, intercept = band.arg$b) +
      geom_abline(
        slope = band.arg$a,
        intercept =  band.arg$b + abs(band.arg$b)*band.arg$width,
        linetype = 'dashed'
      ) +
      geom_abline(
        slope = band.arg$a,
        intercept = band.arg$b - abs(band.arg$b)*band.arg$width,
        linetype = 'dashed'
      )
  }
  
  if (!is.null(facet.arg)) {
    p.tmp = p.tmp +
      facet_wrap(as.formula(paste("~", facet.arg)),
                 ncol = facet.ncol.arg)
    
  }
  
  
  if (!is.null(xlab.arg))
    p.tmp = p.tmp +
      xlab(paste0(xlab.arg, "\n"))
  
  if (!is.null(ylab.arg))
    p.tmp = p.tmp +
      ylab(paste0("\n", ylab.arg))
  
  if (!is.null(plotlab.arg))
    p.tmp = p.tmp +
      ggtitle(paste0(plotlab.arg, "\n"))
  
  
  
  p.tmp = p.tmp +
494
    ggplotTheme() +
495
496
    theme(legend.position = "none")

dmattek's avatar
dmattek committed
497
498
499
500
501
502
  # Marginal distributions don;t work with plotly...
  # if (is.null(facet.arg))
  #   ggExtra::ggMarginal(p.scat, type = "histogram",  bins = 100)
  # else
  return(p.tmp)
}
dmattek's avatar
dmattek committed
503

504

dmattek's avatar
Mod:    
dmattek committed
505
506
507
508
509
510
511
512
513
514
515
516
517
myPlotHeatmap <- function(data.arg,
                          dend.arg,
                          palette.arg,
                          palette.rev.arg = TRUE,
                          dend.show.arg = TRUE,
                          key.show.arg = TRUE,
                          margin.x.arg = 5,
                          margin.y.arg = 20,
                          nacol.arg = 0.5,
                          colCol.arg = NULL,
                          labCol.arg = NULL,
                          font.row.arg = 1,
                          font.col.arg = 1,
518
                          breaks.arg = NULL,
dmattek's avatar
Mod:    
dmattek committed
519
520
                          title.arg = 'Clustering') {
  
521
522
  loc.n.colbreaks = 99
  
dmattek's avatar
Mod:    
dmattek committed
523
524
  if (palette.rev.arg)
    my_palette <-
525
    rev(colorRampPalette(brewer.pal(9, palette.arg))(n = loc.n.colbreaks))
dmattek's avatar
Mod:    
dmattek committed
526
527
  else
    my_palette <-
528
    colorRampPalette(brewer.pal(9, palette.arg))(n = loc.n.colbreaks)
dmattek's avatar
Mod:    
dmattek committed
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
  
  
  col_labels <- get_leaves_branches_col(dend.arg)
  col_labels <- col_labels[order(order.dendrogram(dend.arg))]
  
  if (dend.show.arg) {
    assign("var.tmp.1", dend.arg)
    var.tmp.2 = "row"
  } else {
    assign("var.tmp.1", FALSE)
    var.tmp.2 = "none"
  }
  
  loc.p = heatmap.2(
    data.arg,
    Colv = "NA",
    Rowv = var.tmp.1,
    srtCol = 90,
    dendrogram = var.tmp.2,
    trace = "none",
    key = key.show.arg,
    margins = c(margin.x.arg, margin.y.arg),
    col = my_palette,
    na.col = grey(nacol.arg),
    denscol = "black",
    density.info = "density",
    RowSideColors = col_labels,
    colRow = col_labels,
    colCol = colCol.arg,
    labCol = labCol.arg,
    #      sepcolor = grey(input$inPlotHierGridColor),
    #      colsep = 1:ncol(loc.dm),
    #      rowsep = 1:nrow(loc.dm),
    cexRow = font.row.arg,
    cexCol = font.col.arg,
dmattek's avatar
dmattek committed
564
565
    main = title.arg,
    symbreaks = FALSE,
566
567
    symkey = FALSE,
    breaks = if (is.null(breaks.arg)) NULL else seq(breaks.arg[1], breaks.arg[2], length.out = loc.n.colbreaks+1)
dmattek's avatar
Mod:    
dmattek committed
568
569
570
571
  )
  
  return(loc.p)
}