talgalili / heatmaply

@@ -75,8 +75,7 @@
Loading
75 75
#' x <- data.frame(a = 1:10, b = 11:20)
76 76
#' x[4:6, 1:2] <- NA
77 77
#' percentize(x)
78 -
#' percentize(x[,1])
79 -
#'
78 +
#' percentize(x[, 1])
80 79
#' }
81 80
percentize <- function(x, ...) {
82 81
  UseMethod("percentize")
@@ -145,8 +144,7 @@
Loading
145 144
#' x <- data.frame(a = 1:10, b = 11:20)
146 145
#' x[4:6, 1:2] <- NA
147 146
#' normalize(x)
148 -
#' normalize(x[,1])
149 -
#'
147 +
#' normalize(x[, 1])
150 148
#' }
151 149
normalize <- function(x, ...) {
152 150
  UseMethod("normalize")

@@ -81,17 +81,21 @@
Loading
81 81
#' \dontrun{
82 82
#'
83 83
#' library(RColorBrewer)
84 -
#' display.brewer.all(n=11,type="div"); title(main = "Divergent color palette")
85 -
#' display.brewer.all(n=9,type=c("seq")); title(main = "Sequential color palette")
84 +
#' display.brewer.all(n = 11, type = "div")
85 +
#' title(main = "Divergent color palette")
86 +
#' display.brewer.all(n = 9, type = c("seq"))
87 +
#' title(main = "Sequential color palette")
86 88
#'
87 89
#'
88 90
#'
89 91
#' img <- function(obj, nam) {
90 -
#'   image(1:length(obj), 1, as.matrix(1:length(obj)), col=obj,
91 -
#'         main = nam, ylab = "", xaxt = "n", yaxt = "n",  bty = "n")
92 +
#'   image(1:length(obj), 1, as.matrix(1:length(obj)),
93 +
#'     col = obj,
94 +
#'     main = nam, ylab = "", xaxt = "n", yaxt = "n", bty = "n"
95 +
#'   )
92 96
#' }
93 97
#'
94 -
#' par(mfrow = c(10,1))
98 +
#' par(mfrow = c(10, 1))
95 99
#' img(rev(cool_warm(500)), "cool_warm, (Moreland 2009)")
96 100
#' img(RdBu(500), "RdBu")
97 101
#' img(BrBG(500), "BrBG")
@@ -105,9 +109,8 @@
Loading
105 109
#'
106 110
#'
107 111
#' library(heatmaply)
108 -
#' heatmaply(cor(mtcars), colors = PiYG, limits = c(-1,1))
109 -
#' heatmaply(cor(mtcars), colors = RdBu, limits = c(-1,1))
110 -
#'
112 +
#' heatmaply(cor(mtcars), colors = PiYG, limits = c(-1, 1))
113 +
#' heatmaply(cor(mtcars), colors = RdBu, limits = c(-1, 1))
111 114
#' }
112 115
NULL
113 116
@@ -284,7 +287,7 @@
Loading
284 287
    if (msh[1] >= unsatM - 0.1) {
285 288
      h <- msh[3]
286 289
    } else {
287 -
      hueSpin <- (msh[2] * sqrt(unsatM ^ 2 - msh[1] ^ 2) / (msh[1] *
290 +
      hueSpin <- (msh[2] * sqrt(unsatM^2 - msh[1]^2) / (msh[1] *
288 291
        sin(msh[2])))
289 292
      if (msh[3] > -0.3 * pi) {
290 293
        h <- msh[3] + hueSpin
@@ -307,8 +310,7 @@
Loading
307 310
        msh2[2] <- 0
308 311
        msh2[3] <- 0
309 312
        s <- 2 * s
310 -
      }
311 -
      else {
313 +
      } else {
312 314
        msh1[1] <- Mmid
313 315
        msh1[2] <- 0
314 316
        msh1[3] <- 0
@@ -327,10 +329,12 @@
Loading
327 329
    as(MshToLab(mshTmp), outColorspace)
328 330
  }
329 331
  dvmap <- matrix(0, length(s), 3)
330 -
  for (n in 1:length(s)) dvmap[n, ] <- divergingMap1val(
332 +
  for (n in 1:length(s)) {
333 +
    dvmap[n, ] <- divergingMap1val(
331 334
      s[n],
332 335
      rgb1, rgb2, outColorspace
333 336
    )@coords
337 +
  }
334 338
  dvmap
335 339
}
336 340

@@ -34,13 +34,11 @@
Loading
34 34
35 35
36 36
## TODO: duplication with heatmap_subplot_from_ggplotly
37 -
arrange_plots <- function(
38 -
    plots,
39 -
    widths = NULL,
40 -
    heights = NULL,
41 -
    row_dend_left = FALSE,
42 -
    hide_colorbar = FALSE) {
43 -
37 +
arrange_plots <- function(plots,
38 +
                          widths = NULL,
39 +
                          heights = NULL,
40 +
                          row_dend_left = FALSE,
41 +
                          hide_colorbar = FALSE) {
44 42
  plots <- plots[!sapply(plots, is.null)]
45 43
  if (!row_dend_left) {
46 44
    plots$p <- plots$p + theme(legend.position = "left")
@@ -89,5 +87,7 @@
Loading
89 87
}
90 88
91 89
ggplot_empty <- function() {
92 -
  ggplot() + theme_void() + theme(plot.margin = unit(c(0, 0, 0, 0), "npc"))
90 +
  ggplot() +
91 +
    theme_void() +
92 +
    theme(plot.margin = unit(c(0, 0, 0, 0), "npc"))
93 93
}

@@ -25,17 +25,22 @@
Loading
25 25
#' x <- data.frame(x)
26 26
#' x$am <- factor(x$am)
27 27
#' x$vs <- factor(x$vs)
28 -
#' set.seed(2017-01-19)
29 -
#' x[sample(nrow(x))[1:6],sample(ncol(x))[1:6]] <- NA
28 +
#' set.seed(2017 - 01 - 19)
29 +
#' x[sample(nrow(x))[1:6], sample(ncol(x))[1:6]] <- NA
30 30
#'
31 31
#'
32 32
#' # nice grey colors from here: https://github.com/njtierney/visdat/blob/master/R/vis_miss_ly.R
33 -
#' x %>% is.na10 %>% heatmaply( colors = c("grey80", "grey20"), dendrogram = "none")
34 -
#' x %>% is.na10 %>% heatmaply( colors = c("grey80", "grey20"), k_col = 2, k_row = 2)
35 -
#'
36 -
#' heatmaply(is.na10(airquality), grid_gap = 1,
37 -
#'          colors = c("grey80", "grey20"), k_col = 2, k_row = 2)
38 -
#'
33 +
#' x %>%
34 +
#'   is.na10() %>%
35 +
#'   heatmaply(colors = c("grey80", "grey20"), dendrogram = "none")
36 +
#' x %>%
37 +
#'   is.na10() %>%
38 +
#'   heatmaply(colors = c("grey80", "grey20"), k_col = 2, k_row = 2)
39 +
#'
40 +
#' heatmaply(is.na10(airquality),
41 +
#'   grid_gap = 1,
42 +
#'   colors = c("grey80", "grey20"), k_col = 2, k_row = 2
43 +
#' )
39 44
#' }
40 45
is.na10 <- function(x, ...) {
41 46
  # x %>% is.na %>% str

@@ -16,7 +16,7 @@
Loading
16 16
}
17 17
18 18
fix_not_all_unique <- function(x, ...) {
19 -
  if(all_unique(x)) {
19 +
  if (all_unique(x)) {
20 20
    return(x)
21 21
  } else {
22 22
    warning("Not all the values are unique - manually added prefix numbers")
@@ -136,7 +136,6 @@
Loading
136 136
#' \link{heatmap}, \link[gplots]{heatmap.2}
137 137
#'
138 138
#' @examples
139 -
#'
140 139
#' \dontrun{
141 140
#' library(heatmaply)
142 141
#' hm <- heatmapr(mtcars, scale = "column", colors = "Blues")
@@ -144,7 +143,6 @@
Loading
144 143
#' }
145 144
#'
146 145
heatmapr <- function(x,
147 -
148 146
                     ## dendrogram control
149 147
                     Rowv = NULL,
150 148
                     Colv = NULL,
@@ -152,36 +150,27 @@
Loading
152 150
                     hclustfun = hclust,
153 151
                     dist_method = NULL,
154 152
                     hclust_method = NULL,
155 -
156 153
                     distfun_row = distfun,
157 154
                     hclustfun_row = hclustfun,
158 155
                     distfun_col = distfun,
159 156
                     hclustfun_col = hclustfun,
160 -
161 157
                     dendrogram = c("both", "row", "column", "none"),
162 158
                     show_dendrogram = c(TRUE, TRUE),
163 159
                     reorderfun = function(d, w) reorder(d, w),
164 -
165 160
                     k_row = 1,
166 161
                     k_col = 1,
167 -
168 162
                     symm = FALSE,
169 163
                     revC = symm || (is.dendrogram(Colv) & is.dendrogram(Rowv) & identical(Rowv, rev(Colv))),
170 -
171 164
                     ## data scaling
172 165
                     scale = c("none", "row", "column"),
173 166
                     na.rm = TRUE,
174 -
175 167
                     labRow = rownames(x),
176 168
                     labCol = colnames(x),
177 -
178 169
                     cexRow = NULL,
179 170
                     cexCol = NULL,
180 -
181 171
                     ## value formatting
182 172
                     digits = 3L,
183 173
                     cellnote = NULL,
184 -
185 174
                     ## TODO: decide later which names/conventions to keep
186 175
                     theme = NULL,
187 176
                     colors = "RdYlBu",
@@ -279,8 +268,7 @@
Loading
279 268
  if (scale == "row") {
280 269
    x <- sweep(x, 1, rowMeans(x, na.rm = na.rm))
281 270
    x <- sweep(x, 1, apply(x, 1, sd, na.rm = na.rm), "/")
282 -
  }
283 -
  else if (scale == "column") {
271 +
  } else if (scale == "column") {
284 272
    x <- sweep(x, 2, colMeans(x, na.rm = na.rm))
285 273
    x <- sweep(x, 2, apply(x, 2, sd, na.rm = na.rm), "/")
286 274
  }
@@ -410,7 +398,8 @@
Loading
410 398
411 399
    if (k_row > 1) {
412 400
      Rowv <- color_branches(
413 -
        Rowv, k = k_row,
401 +
        Rowv,
402 +
        k = k_row,
414 403
        col = k_colors(k_row)
415 404
      )
416 405
    }
@@ -420,7 +409,8 @@
Loading
420 409
421 410
    if (k_col > 1) {
422 411
      Colv <- color_branches(
423 -
        Colv, k = k_col,
412 +
        Colv,
413 +
        k = k_col,
424 414
        col = k_colors(k_col)
425 415
      )
426 416
    }
@@ -449,8 +439,8 @@
Loading
449 439
  ## =======================
450 440
451 441
  # if(!is.null(custom_hovertext) && !is.matrix(custom_hovertext)) {
452 -
  if(is.data.frame(custom_hovertext)) {
453 -
      custom_hovertext <- as.matrix(custom_hovertext)
442 +
  if (is.data.frame(custom_hovertext)) {
443 +
    custom_hovertext <- as.matrix(custom_hovertext)
454 444
  }
455 445
456 446
  mtx <- list(

@@ -39,13 +39,13 @@
Loading
39 39
                           row_text_angle = 0,
40 40
                           column_text_angle = 45,
41 41
                           scale_fill_gradient_fun =
42 -
                           scale_fill_gradientn(
43 -
                             colors = viridis(
44 -
                               n = 256, alpha = 1, begin = 0,
45 -
                               end = 1, option = "viridis"
42 +
                             scale_fill_gradientn(
43 +
                               colors = viridis(
44 +
                                 n = 256, alpha = 1, begin = 0,
45 +
                                 end = 1, option = "viridis"
46 +
                               ),
47 +
                               na.value = "grey50", limits = NULL
46 48
                             ),
47 -
                             na.value = "grey50", limits = NULL
48 -
                           ),
49 49
                           grid_color = NA,
50 50
                           grid_size = 0.1,
51 51
                           key.title = NULL,
@@ -120,9 +120,11 @@
Loading
120 120
        mdf[["text"]], "<br>",
121 121
        point_size_name, ": ", label_format_fun(mdf[[4]])
122 122
      )
123 -
      aes_args <- list(color = paste_aes(val),
123 +
      aes_args <- list(
124 +
        color = paste_aes(val),
124 125
        text = "text",
125 -
        size = paste_aes(point_size_name))
126 +
        size = paste_aes(point_size_name)
127 +
      )
126 128
127 129
      # geom_args[["mapping"]] <- aes_string(
128 130
      #   color = paste_aes(val),
@@ -131,8 +133,10 @@
Loading
131 133
      # )
132 134
    } else {
133 135
      geom_args[["size"]] <- grid_size
134 -
      aes_args <- list(color = paste_aes(val),
135 -
        text = "text")
136 +
      aes_args <- list(
137 +
        color = paste_aes(val),
138 +
        text = "text"
139 +
      )
136 140
      # geom_args[["mapping"]] <- aes_string(color = paste_aes(val), text = "text")
137 141
    }
138 142
  }
@@ -154,11 +158,15 @@
Loading
154 158
      axis.title = element_blank(),
155 159
      axis.text.x = if (showticklabels[[1]]) {
156 160
        element_text(angle = column_text_angle, size = fontsize_col, hjust = 1)
157 -
      } else element_blank(),
161 +
      } else {
162 +
        element_blank()
163 +
      },
158 164
      axis.ticks.x = if (showticklabels[[1]]) element_line() else element_blank(),
159 165
      axis.text.y = if (showticklabels[[2]]) {
160 166
        element_text(angle = row_text_angle, size = fontsize_row, hjust = 1)
161 -
      } else element_blank(),
167 +
      } else {
168 +
        element_blank()
169 +
      },
162 170
      axis.ticks.y = if (showticklabels[[2]]) element_line() else element_blank(),
163 171
    )
164 172
@@ -244,9 +252,7 @@
Loading
244 252
                           point_size_mat = NULL,
245 253
                           point_size_name = "Point size",
246 254
                           showticklabels = c(TRUE, TRUE),
247 -
                           label_format_fun = function(...) format(..., digits = 4)
248 -
                           ) {
249 -
255 +
                           label_format_fun = function(...) format(..., digits = 4)) {
250 256
  if (is.function(colors)) colors <- colors(256)
251 257
252 258
  if (is.null(label_names)) {
@@ -275,7 +281,8 @@
Loading
275 281
          label_names[3], ": ", label_format_fun(x[, i])
276 282
        )
277 283
        if (!is.null(point_size_mat)) {
278 -
          lab <- paste0(lab, "<br>",
284 +
          lab <- paste0(
285 +
            lab, "<br>",
279 286
            point_size_name, ": ", label_format_fun(point_size_mat[, i])
280 287
          )
281 288
        }
@@ -295,8 +302,7 @@
Loading
295 302
      zmin = limits[1], zmax = limits[2]
296 303
    )
297 304
  } else {
298 -
299 -
    melt <- function(x, cn=colnames(x), rn=rownames(x)) {
305 +
    melt <- function(x, cn = colnames(x), rn = rownames(x)) {
300 306
      xdf <- reshape2::melt(x)
301 307
      xdf$Var1 <- factor(xdf$Var1, levels = rn)
302 308
      xdf$Var2 <- factor(xdf$Var2, levels = cn)
@@ -319,7 +325,7 @@
Loading
319 325
      hoverinfo = "text"
320 326
    )
321 327
  }
322 -
  p <- p  %>%
328 +
  p <- p %>%
323 329
    layout(
324 330
      xaxis = list(
325 331
        tickfont = list(size = fontsize_col),
@@ -357,7 +363,6 @@
Loading
357 363
                        side = c("row", "col"),
358 364
                        flip = FALSE,
359 365
                        dend_hoverinfo = TRUE) {
360 -
361 366
  if (is.hclust(dend)) {
362 367
    dend <- as.dendrogram(dend)
363 368
  }
@@ -416,8 +421,7 @@
Loading
416 421
          yaxis = axis2
417 422
        )
418 423
    }
419 -
  }
420 -
  else {
424 +
  } else {
421 425
    add_plot_lines <- function(p) {
422 426
      p %>%
423 427
        add_segments(
@@ -467,7 +471,6 @@
Loading
467 471
                                   is_colors = FALSE,
468 472
                                   fontsize = 10,
469 473
                                   label_name = NULL) {
470 -
471 474
  type <- match.arg(type)
472 475
  if (is.matrix(df)) df <- as.data.frame(df)
473 476
  assert_that(is.data.frame(df))
@@ -577,7 +580,6 @@
Loading
577 580
                           colorscale_df = p$x$data[[1]]$colorscale %||% p$x$data[[2]]$marker$colorscale,
578 581
                           cell_values = p$x$data[[1]]$z,
579 582
                           plot_method = c("ggplot", "plotly")) {
580 -
581 583
  plot_method <- match.arg(plot_method)
582 584
583 585
  if (is.null(cell_values)) {
@@ -692,7 +694,6 @@
Loading
692 694
                                   colorbar_len = 0.3,
693 695
                                   fontsize = 10,
694 696
                                   show_legend = TRUE) {
695 -
696 697
  type <- match.arg(type)
697 698
698 699
  if (is.null(label_name)) label_name <- type
@@ -886,7 +887,7 @@
Loading
886 887
  )
887 888
}
888 889
889 -
size_default <- function(file_extension, direction=c("width", "height")) {
890 +
size_default <- function(file_extension, direction = c("width", "height")) {
890 891
  direction <- match.arg(direction)
891 892
  ## webshot uses viewport size in pixels to control file size, so
892 893
  ## all sizes in pixels
@@ -908,9 +909,10 @@
Loading
908 909
## Copied from gplots
909 910
#' @importFrom grDevices col2rgb
910 911
col2hex <- function(col) {
911 -
    colMat <- col2rgb(col)
912 -
    rgb(red = colMat[1, ] / 255,
913 -
        green = colMat[2, ] / 255,
914 -
        blue = colMat[3, ] / 255)
912 +
  colMat <- col2rgb(col)
913 +
  rgb(
914 +
    red = colMat[1, ] / 255,
915 +
    green = colMat[2, ] / 255,
916 +
    blue = colMat[3, ] / 255
917 +
  )
915 918
}
916 -

@@ -308,4 +308,3 @@
Loading
308 308
# pkgdown::build_site(run_dont_run = F)
309 309
# pkgdown::build_news()
310 310
# release()
311 -

@@ -281,15 +281,14 @@
Loading
281 281
#'
282 282
#' @export
283 283
#' @examples
284 -
#'
285 284
#' \dontrun{
286 285
#'
287 286
#' # mtcars
288 287
#' # x <- heatmapr(mtcars)
289 288
#' library(heatmaply)
290 -
#' heatmaply(iris[,-5], k_row = 3, k_col = 2)
291 -
#' heatmaply(cor(iris[,-5]))
292 -
#' heatmaply(cor(iris[,-5]), limits = c(-1,1))
289 +
#' heatmaply(iris[, -5], k_row = 3, k_col = 2)
290 +
#' heatmaply(cor(iris[, -5]))
291 +
#' heatmaply(cor(iris[, -5]), limits = c(-1, 1))
293 292
#' heatmaply(mtcars, k_row = 3, k_col = 2)
294 293
#' # heatmaply(mtcars, k_row = 3, k_col = 2, grid_color = "white")
295 294
#' heatmaply(mtcars, k_row = 3, k_col = 2, grid_gap = 1)
@@ -322,64 +321,83 @@
Loading
322 321
#' # If we want to share the Y axis, then it is risky to keep any of the dendrograms:
323 322
#' library(heatmaply)
324 323
#' hm1 <- heatmaply(mtcars, Colv = FALSE, Rowv = FALSE, margins = c(40, 130))
325 -
#' hm2 <- heatmaply(mtcars, scale = "col" , Colv = FALSE, Rowv = FALSE,
326 -
#'              margins = c(40, 130))
324 +
#' hm2 <- heatmaply(mtcars,
325 +
#'   scale = "col", Colv = FALSE, Rowv = FALSE,
326 +
#'   margins = c(40, 130)
327 +
#' )
327 328
#' subplot(hm1, hm2, margin = .02, shareY = TRUE)
328 329
#'
329 330
#'
330 331
#' # We can save heatmaply as an HTML file by using:
331 -
#' heatmaply(iris[,-5], file = "heatmaply_iris.html")
332 +
#' heatmaply(iris[, -5], file = "heatmaply_iris.html")
332 333
#' # or a png/pdf/jpeg file using:
333 -
#' heatmaply(iris[,-5], file = "heatmaply_iris.png")
334 +
#' heatmaply(iris[, -5], file = "heatmaply_iris.png")
334 335
#' # or just doing it in one go:
335 -
#' heatmaply(iris[,-5], file = c("heatmaply_iris.html", "heatmaply_iris.png") )
336 +
#' heatmaply(iris[, -5], file = c("heatmaply_iris.html", "heatmaply_iris.png"))
336 337
#'
337 338
#'
338 339
#'
339 340
#' # If we don't want the HTML to be selfcontained, we can use the following:
340 341
#' library(heatmaply)
341 342
#' library(htmlwidgets)
342 -
#' heatmaply(iris[,-5]) %>%
343 -
#'    saveWidget(file="heatmaply_iris.html",selfcontained = FALSE)
343 +
#' heatmaply(iris[, -5]) %>%
344 +
#'   saveWidget(file = "heatmaply_iris.html", selfcontained = FALSE)
344 345
#'
345 346
#'
346 347
#' # Example for using RowSideColors
347 348
#'
348 -
#' x  <- as.matrix(datasets::mtcars)
349 +
#' x <- as.matrix(datasets::mtcars)
349 350
#' rc <- colorspace::rainbow_hcl(nrow(x))
350 351
#'
351 352
#' library(gplots)
352 353
#' library(viridis)
353 -
#' heatmap.2(x, trace = "none", col = viridis(100),
354 -
#'           RowSideColors=rc)
354 +
#' heatmap.2(x,
355 +
#'   trace = "none", col = viridis(100),
356 +
#'   RowSideColors = rc
357 +
#' )
355 358
#'
356 -
#' heatmaply(x, seriate = "mean",
357 -
#'           RowSideColors=rc)
359 +
#' heatmaply(x,
360 +
#'   seriate = "mean",
361 +
#'   RowSideColors = rc
362 +
#' )
358 363
#'
359 364
#'
360 -
#' heatmaply(x[,-c(8,9)], seriate = "mean",
361 -
#'           col_side_colors = c(rep(0,5), rep(1,4)),
362 -
#'           row_side_colors = x[,8:9])
363 -
#' heatmaply(x[,-c(8,9)], seriate = "mean",
364 -
#'           col_side_colors = data.frame(a=c(rep(0,5), rep(1,4))),
365 -
#'           row_side_colors = x[,8:9])
365 +
#' heatmaply(x[, -c(8, 9)],
366 +
#'   seriate = "mean",
367 +
#'   col_side_colors = c(rep(0, 5), rep(1, 4)),
368 +
#'   row_side_colors = x[, 8:9]
369 +
#' )
370 +
#' heatmaply(x[, -c(8, 9)],
371 +
#'   seriate = "mean",
372 +
#'   col_side_colors = data.frame(a = c(rep(0, 5), rep(1, 4))),
373 +
#'   row_side_colors = x[, 8:9]
374 +
#' )
366 375
#'
367 376
#'
368 377
#' ## Example of using Rowv And Colv for custumized dendrograms.
369 378
#'
370 379
#'
371 -
#' x  <- as.matrix(datasets::mtcars)
380 +
#' x <- as.matrix(datasets::mtcars)
372 381
#'
373 382
#' # now let's spice up the dendrograms a bit:
374 383
#' library(dendextend)
375 384
#'
376 -
#' row_dend  <- x %>% dist %>% hclust %>% as.dendrogram %>%
377 -
#'   set("branches_k_color", k = 3) %>% set("branches_lwd", 4) %>%
378 -
#'   ladderize
385 +
#' row_dend <- x %>%
386 +
#'   dist() %>%
387 +
#'   hclust() %>%
388 +
#'   as.dendrogram() %>%
389 +
#'   set("branches_k_color", k = 3) %>%
390 +
#'   set("branches_lwd", 4) %>%
391 +
#'   ladderize()
379 392
#' #    rotate_DendSer(ser_weight = dist(x))
380 -
#' col_dend  <- x %>% t %>% dist %>% hclust %>% as.dendrogram %>%
381 -
#'   set("branches_k_color", k = 2) %>% set("branches_lwd", 4) %>%
382 -
#'   ladderize
393 +
#' col_dend <- x %>%
394 +
#'   t() %>%
395 +
#'   dist() %>%
396 +
#'   hclust() %>%
397 +
#'   as.dendrogram() %>%
398 +
#'   set("branches_k_color", k = 2) %>%
399 +
#'   set("branches_lwd", 4) %>%
400 +
#'   ladderize()
383 401
#' #    rotate_DendSer(ser_weight = dist(t(x)))
384 402
#'
385 403
#' heatmaply(x, Rowv = row_dend, Colv = col_dend)
@@ -389,30 +407,29 @@
Loading
389 407
#' heatmaply(is.na10(airquality), grid_gap = 1)
390 408
#'
391 409
#' # grid_gap can handle quite large data matrix
392 -
#' heatmaply(matrix(1:10000,100,100), k_row = 3, k_col = 3, grid_gap = 1)
410 +
#' heatmaply(matrix(1:10000, 100, 100), k_row = 3, k_col = 3, grid_gap = 1)
393 411
#'
394 412
#' # Examples of playing with font size:
395 -
#' heatmaply(mtcars, fontsize_col = 20, fontsize_row = 5, margin = c(100,90))
413 +
#' heatmaply(mtcars, fontsize_col = 20, fontsize_row = 5, margin = c(100, 90))
396 414
#'
397 415
#'
398 416
#'
399 417
#' # Example for using subplot_width/subplot_height
400 418
#'
401 419
#' heatmaply(percentize(mtcars),
402 -
#'      subplot_widths=c(0.6, 0.4),
403 -
#'      subplot_heights=c(0.05, 0.95))
420 +
#'   subplot_widths = c(0.6, 0.4),
421 +
#'   subplot_heights = c(0.05, 0.95)
422 +
#' )
404 423
#'
405 424
#'
406 425
#'
407 426
#' # Example of removing labels and thus making the plot faster
408 -
#' heatmaply(iris, showticklabels = c(T,F), margins = c(80,10))
427 +
#' heatmaply(iris, showticklabels = c(T, F), margins = c(80, 10))
409 428
#'
410 429
#' # this is what allows for a much larger matrix to be printed:
411 -
#' set.seed(2017-05-18)
412 -
#' large_x <- matrix(rnorm(19), 1000,100)
413 -
#' heatmaply(large_x, dendrogram = F, showticklabels = F, margins = c(1,1))
414 -
#'
415 -
#'
430 +
#' set.seed(2017 - 05 - 18)
431 +
#' large_x <- matrix(rnorm(19), 1000, 100)
432 +
#' heatmaply(large_x, dendrogram = F, showticklabels = F, margins = c(1, 1))
416 433
#' }
417 434
heatmaply <- function(x, ...) {
418 435
  UseMethod("heatmaply")
@@ -434,7 +451,8 @@
Loading
434 451
                         colors = c("grey80", "grey20"),
435 452
                         ...) {
436 453
  heatmaply(
437 -
    is.na10(x), grid_gap = grid_gap,
454 +
    is.na10(x),
455 +
    grid_gap = grid_gap,
438 456
    colors = colors, ...
439 457
  )
440 458
}
@@ -453,7 +471,8 @@
Loading
453 471
                          colors = cool_warm,
454 472
                          ...) {
455 473
  heatmaply(
456 -
    x, limits = limits, # symm = TRUE,
474 +
    x,
475 +
    limits = limits, # symm = TRUE,
457 476
    colors = colors, ...
458 477
  )
459 478
}
@@ -482,7 +501,6 @@
Loading
482 501
                              cellnote_color = "auto",
483 502
                              cellnote_textposition = "middle right",
484 503
                              cellnote_size = 12,
485 -
486 504
                              ## dendrogram control
487 505
                              Rowv = NULL,
488 506
                              Colv = NULL,
@@ -490,26 +508,20 @@
Loading
490 508
                              hclustfun = stats::hclust,
491 509
                              dist_method = NULL,
492 510
                              hclust_method = NULL,
493 -
494 511
                              distfun_row = distfun,
495 512
                              hclustfun_row = hclustfun,
496 513
                              distfun_col = distfun,
497 514
                              hclustfun_col = hclustfun,
498 -
499 515
                              dendrogram = c("both", "row", "column", "none"),
500 516
                              show_dendrogram = c(TRUE, TRUE),
501 517
                              reorderfun = function(d, w) reorder(d, w),
502 -
503 518
                              k_row = 1,
504 519
                              k_col = 1,
505 -
506 520
                              symm = FALSE,
507 521
                              revC = symm || (is.dendrogram(Colv) & is.dendrogram(Rowv) & identical(Rowv, rev(Colv))),
508 -
509 522
                              ## data scaling
510 523
                              scale = c("none", "row", "column"),
511 524
                              na.rm = TRUE,
512 -
513 525
                              row_dend_left = FALSE,
514 526
                              margins = c(NA, NA, NA, NA),
515 527
                              ...,
@@ -699,7 +711,6 @@
Loading
699 711
    col_side_colors = col_side_colors,
700 712
    point_size_mat = point_size_mat,
701 713
    seriate = seriate,
702 -
703 714
    cellnote = cellnote,
704 715
705 716
    ## dendrogram control
@@ -709,19 +720,15 @@
Loading
709 720
    hclustfun = hclustfun,
710 721
    dist_method = dist_method,
711 722
    hclust_method = hclust_method,
712 -
713 723
    distfun_row = distfun_row,
714 724
    hclustfun_row = hclustfun_row,
715 725
    distfun_col = distfun_col,
716 726
    hclustfun_col = hclustfun_col,
717 -
718 727
    dendrogram = dendrogram,
719 728
    show_dendrogram = show_dendrogram,
720 729
    reorderfun = reorderfun,
721 -
722 730
    k_row = k_row,
723 731
    k_col = k_col,
724 -
725 732
    symm = symm,
726 733
    revC = revC,
727 734
@@ -806,7 +813,6 @@
Loading
806 813
                               row_text_angle = 0,
807 814
                               column_text_angle = 45,
808 815
                               subplot_margin = 0,
809 -
810 816
                               row_dend_left = FALSE,
811 817
                               margins = c(NA, NA, NA, NA),
812 818
                               ...,
@@ -859,7 +865,6 @@
Loading
859 865
                               custom_hovertext = x[["matrix"]][["custom_hovertext"]],
860 866
                               dend_hoverinfo = TRUE,
861 867
                               side_color_colorbar_len = 0.3) {
862 -
863 868
  node_type <- match.arg(node_type)
864 869
  plot_method <- match.arg(plot_method)
865 870
  cellnote_textposition <- match.arg(
@@ -952,8 +957,9 @@
Loading
952 957
        dendrogram_layers
953 958
    } else {
954 959
      py <- plotly_dend(cols,
955 -
                        side = "col",
956 -
                        dend_hoverinfo = dend_hoverinfo)
960 +
        side = "col",
961 +
        dend_hoverinfo = dend_hoverinfo
962 +
      )
957 963
    }
958 964
  }
959 965
  if (is.null(rows)) {
@@ -973,9 +979,10 @@
Loading
973 979
      }
974 980
    } else {
975 981
      px <- plotly_dend(rows,
976 -
                        flip = row_dend_left,
977 -
                        side = "row",
978 -
                        dend_hoverinfo = dend_hoverinfo)
982 +
        flip = row_dend_left,
983 +
        side = "row",
984 +
        dend_hoverinfo = dend_hoverinfo
985 +
      )
979 986
    }
980 987
  }
981 988
  # create the heatmap
@@ -1110,13 +1117,13 @@
Loading
1110 1117
  if (!is.plotly(p)) {
1111 1118
    p <- ggplotly(p, dynamicTicks = dynamicTicks, tooltip = "text") %>%
1112 1119
      layout(showlegend = FALSE)
1113 -
      ## Currently broken, see:
1114 -
      ##  https://github.com/ropensci/plotly/issues/1701
1115 -
      # %>%
1116 -
      # colorbar(
1117 -
      #   len = colorbar_len,
1118 -
      #   thickness = colorbar_thickness
1119 -
      # )
1120 +
    ## Currently broken, see:
1121 +
    ##  https://github.com/ropensci/plotly/issues/1701
1122 +
    # %>%
1123 +
    # colorbar(
1124 +
    #   len = colorbar_len,
1125 +
    #   thickness = colorbar_thickness
1126 +
    # )
1120 1127
  }
1121 1128
1122 1129
  if (draw_cellnote) {
@@ -1138,18 +1145,18 @@
Loading
1138 1145
1139 1146
    p <- p %>% add_trace(
1140 1147
      data = cellnote_mdf,
1141 -
      x = ~ variable,
1142 -
      y = ~ `_row`,
1143 -
      text = ~ value,
1144 -
      customdata = ~ `__data_value`,
1148 +
      x = ~variable,
1149 +
      y = ~`_row`,
1150 +
      text = ~value,
1151 +
      customdata = ~`__data_value`,
1145 1152
      inherit = FALSE,
1146 1153
      type = "scatter",
1147 1154
      mode = "text",
1148 1155
      textposition = cellnote_textposition,
1149 1156
      # hoverinfo = "none",
1150 1157
      hovertemplate = paste0(
1151 -
        label_names[[1]], ": %{y}\n", 
1152 -
        label_names[[2]], ": %{x}\n", 
1158 +
        label_names[[1]], ": %{y}\n",
1159 +
        label_names[[2]], ": %{x}\n",
1153 1160
        label_names[[3]], ": %{customdata}<extra></extra>" ## see here for extra tag https://plotly.com/python/reference/#scatter-hovertemplate
1154 1161
      ),
1155 1162
      showlegend = FALSE,
@@ -1159,14 +1166,16 @@
Loading
1159 1166
1160 1167
  if (!is.null(px) && !is.plotly(px)) {
1161 1168
    px <- ggplotly(px,
1162 -
                   tooltip = if (dend_hoverinfo) "y" else "none",
1163 -
                   dynamicTicks = dynamicTicks) %>%
1169 +
      tooltip = if (dend_hoverinfo) "y" else "none",
1170 +
      dynamicTicks = dynamicTicks
1171 +
    ) %>%
1164 1172
      layout(showlegend = FALSE)
1165 1173
  }
1166 1174
  if (!is.null(py) && !is.plotly(py)) {
1167 1175
    py <- ggplotly(py,
1168 -
                   tooltip = if (dend_hoverinfo) "y" else "none",
1169 -
                   dynamicTicks = dynamicTicks) %>%
1176 +
      tooltip = if (dend_hoverinfo) "y" else "none",
1177 +
      dynamicTicks = dynamicTicks
1178 +
    ) %>%
1170 1179
      layout(showlegend = FALSE)
1171 1180
  }
1172 1181
@@ -1259,7 +1268,8 @@
Loading
1259 1268
1260 1269
  # keep only relevant plotly options
1261 1270
  l <- config(
1262 -
    l, displaylogo = FALSE,
1271 +
    l,
1272 +
    displaylogo = FALSE,
1263 1273
    modeBarButtonsToRemove = c("sendDataToCloud", "select2d", "lasso2d", "autoScale2d", "hoverClosestCartesian", "hoverCompareCartesian", "sendDataToCloud")
1264 1274
  )
1265 1275
@@ -1292,7 +1302,7 @@
Loading
1292 1302
heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc,
1293 1303
                                          row_dend_left = FALSE, subplot_margin = 0,
1294 1304
                                          titleX = TRUE, titleY = TRUE,
1295 -
                                          widths=NULL, heights=NULL,
1305 +
                                          widths = NULL, heights = NULL,
1296 1306
                                          plot_method,
1297 1307
                                          showticklabels = c(TRUE, TRUE)) {
1298 1308
  widths <- widths %||% default_dims(px, pr)
Files Coverage
R 90.96%
Project Totals (9 files) 90.96%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading