如何调整rect_border以接受多种颜色,就像其他调色板一样?

huangapple go评论66阅读模式
英文:

How to adjust rect_border to accept multiple colours like other colour palettes?

问题

I am unable to pass other color schemes into rect_border but it somehow works when the colour palette lancet is specified. How can I adjust the second plot to work on the smooth_rainbow colours?

请问你需要对第二个图表进行调整以使用smooth_rainbow颜色吗?

英文:

I am unable to pass other color schemes into rect_border but it somehow works when the colour palette lancet is specified. How can I adjust the second plot to work on the smooth_rainbow colours?

See reprex below:

library(factoextra)
library(ggplot2)
library(khroma)

df <- scale(mtcars) # Standardize the data


dist <- dist(df, method = "euclidean") # df = standardized data
hc <- hclust(dist, method = "ward.D2")

p <- fviz_dend(hc, k = 4, # Cut in four groups
               cex = 0.6, # label size
               k_colors = "lancet",
               color_labels_by_k = TRUE, # color labels by groups
               rect = TRUE, # Add rectangle around groups
               rect_border = "lancet",
               rect_fill = TRUE,
               rotate = TRUE) +
  theme_dark()
#> Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
#> "none")` instead.

p$layers[[1]]$data$col

]$data$col == "black"] <- "white" p$layers[[2]]$data$angle <- 0 p

如何调整rect_border以接受多种颜色,就像其他调色板一样?




smooth_rainbow <- khroma::colour("smooth rainbow")

p2 <- 
fviz_dend(hc, k = 4, # Cut in four groups
          cex = 0.6, # label size
          k_colors = smooth_rainbow(n = 4),
          color_labels_by_k = TRUE, # color labels by groups
          rect = TRUE, # Add rectangle around groups
          rect_border = smooth_rainbow(n = 4),
          rect_fill = TRUE,
          rotate = TRUE) +
  ggplot2::theme_dark()
#> Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
#> "none")` instead.
#> Error in if (color == "cluster") color <- "default": the condition has length > 1

p2
#> Error in eval(expr, envir, enclos): object 'p2' not found

<sup>Created on 2023-05-07 by the reprex package (v2.0.1)</sup>

&gt; sessionInfo()
R version 4.2.3 (2023-03-15 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19044)

Matrix products: default

locale:
[1] LC_COLLATE=English_South Africa.utf8  LC_CTYPE=English_South Africa.utf8   
[3] LC_MONETARY=English_South Africa.utf8 LC_NUMERIC=C                         
[5] LC_TIME=English_South Africa.utf8    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] khroma_1.10.0      cluster_2.1.4      MTGmeta_0.0.0.9000 factoextra_1.0.7  
 [5] magrittr_2.0.3     here_1.0.1         forcats_0.5.1      stringr_1.4.0     
 [9] dplyr_1.0.9        purrr_0.3.5        readr_2.1.2        tidyr_1.2.0       
[13] tibble_3.1.8       ggplot2_3.3.6      tidyverse_1.3.2   

答案1

得分: 1

以下是翻译好的内容,代码部分不进行翻译:

"This is a bug and it would be great if you could report it to the package maintainer. The error originates from a conditional statement in factoextra:::.rect_dendrogram, which tests if your color argument is color == &quot;cluster&quot;. This only works if your color argument is a vector of length 1. (e.g., passing a palette name works, as you have demonstrated).

When passing a vector of colors, this naturally fails, as R doesn't like to compare vectors of length > 1 with a ==. If you replace the conditional statement, e.g. with all(color == &quot;cluster&quot;), it works.

NB I have copied the adjusted functions for your convenience - there are a few uncommented modifications, in particular adding required factoextra::: to some un-exported functions.

library(factoextra)
library(ggplot2)
library(khroma)

##adjusted functions
fviz_dend2 &lt;- 
function (x, k = NULL, h = NULL, k_colors = NULL, palette = NULL, 
          show_labels = TRUE, color_labels_by_k = TRUE, label_cols = NULL, 
          labels_track_height = NULL, repel = FALSE, lwd = 0.7, type = c(&quot;rectangle&quot;, 
                                                                         &quot;circular&quot;, &quot;phylogenic&quot;), phylo_layout = &quot;layout.auto&quot;, 
          rect = FALSE, rect_border = &quot;gray&quot;, rect_lty = 2, rect_fill = FALSE, 
          lower_rect, horiz = FALSE, cex = 0.8, main = &quot;Cluster Dendrogram&quot;, 
          xlab = &quot;&quot;, ylab = &quot;Height&quot;, sub = NULL, ggtheme = theme_classic(), 
          ...) {
  ...
}

rect_dendrogram &lt;- function(dend, k = NULL, h = NULL, k_colors = NULL, palette = NULL, 
          rect_fill = FALSE, rect_lty = 2, lower_rect = -1.5, ...) {
  ...
}

fviz_dend2(hc, k = 4, # Cut in four groups
          cex = 0.6, # label size
          k_colors = smooth_rainbow(4),
          # color_labels_by_k = TRUE, # color labels by groups
          rect = TRUE, # Add rectangle around groups
          rect_border = smooth_rainbow(4),
          rect_fill = TRUE,
          rotate = TRUE) +
  ggplot2::theme_dark()
#&gt; Warning: The `&lt;scale&gt;` argument of `guides()` cannot be `FALSE`. Use &quot;none&quot; instead as
#&gt; of ggplot2 3.3.4.
#&gt; ℹ The deprecated feature was likely used in the factoextra package.
#&gt;   Please report the issue at &lt;https://github.com/kassambara/factoextra/issues&gt;.

如何调整rect_border以接受多种颜色,就像其他调色板一样?(创建于2023年05月07日,使用 reprex v2.0.2

英文:

This is a bug and it would be great if you could report it to the package maintainer. The error originates from a conditional statement in factoextra:::.rect_dendrogram, which tests if your color argument is color == &quot;cluster&quot;. This only works if your color argument is a vector of length 1. (e.g., passing a palette name works, as you have demonstrated).

When passing a vector of colors, this naturally fails, as R doesn't like to compare vectors of length > 1 with a ==. If you replace the conditional statement, e.g. with all(color == &quot;cluster&quot;), it works.

NB I have copied the adjusted functions for your convenience - there are a few uncommented modifications, in particular adding required factoextra::: to some un-exported functions.

library(factoextra)
library(ggplot2)
library(khroma)

##adjusted functions
fviz_dend2 &lt;- 
function (x, k = NULL, h = NULL, k_colors = NULL, palette = NULL, 
          show_labels = TRUE, color_labels_by_k = TRUE, label_cols = NULL, 
          labels_track_height = NULL, repel = FALSE, lwd = 0.7, type = c(&quot;rectangle&quot;, 
                                                                         &quot;circular&quot;, &quot;phylogenic&quot;), phylo_layout = &quot;layout.auto&quot;, 
          rect = FALSE, rect_border = &quot;gray&quot;, rect_lty = 2, rect_fill = FALSE, 
          lower_rect, horiz = FALSE, cex = 0.8, main = &quot;Cluster Dendrogram&quot;, 
          xlab = &quot;&quot;, ylab = &quot;Height&quot;, sub = NULL, ggtheme = theme_classic(), 
          ...) {
  if (missing(k_colors) &amp; !is.null(palette)) {
    k_colors &lt;- palette
    palette &lt;- NULL
  }
  if (!color_labels_by_k &amp; is.null(label_cols)) 
    label_cols &lt;- &quot;black&quot;
  type &lt;- match.arg(type)
  circular &lt;- type == &quot;circular&quot;
  phylogenic &lt;- type == &quot;phylogenic&quot;
  rectangle &lt;- type == &quot;rectangle&quot;
  if (inherits(x, &quot;HCPC&quot;)) {
    k &lt;- length(unique(x$data.clust$clust))
    x &lt;- x$call$t$tree
  }
  if (inherits(x, &quot;hcut&quot;)) {
    k &lt;- x$nbclust
    dend &lt;- as.dendrogram(x)
    method &lt;- x$method
  }
  else if (inherits(x, &quot;hkmeans&quot;)) {
    k &lt;- length(unique(x$cluster))
    dend &lt;- as.dendrogram(x$hclust)
    method &lt;- x$hclust$method
  }
  else if (inherits(x, c(&quot;hclust&quot;, &quot;agnes&quot;, &quot;diana&quot;))) {
    dend &lt;- as.dendrogram(x)
    method &lt;- x$method
  }
  else if (inherits(x, &quot;dendrogram&quot;)) {
    dend &lt;- x
    method &lt;- &quot;&quot;
  }
  else stop(&quot;Can&#39;t handle an object of class &quot;, paste(class(x), 
                                                      collapse = &quot;, &quot;))
  if (is.null(method)) 
    method &lt;- &quot;&quot;
  else if (is.na(method)) 
    method &lt;- &quot;&quot;
  if (is.null(sub) &amp; method != &quot;&quot;) 
    sub = paste0(&quot;Method: &quot;, method)
  if (!is.null(dendextend::labels_cex(dend))) 
    cex &lt;- dendextend::labels_cex(dend)
  dend &lt;- dendextend::set(dend, &quot;labels_cex&quot;, cex)
  dend &lt;- dendextend::set(dend, &quot;branches_lwd&quot;, lwd)
  k &lt;- factoextra:::.get_k(dend, k, h)
  if (!is.null(k)) {
    if (ggpubr:::.is_col_palette(k_colors)) 
      k_colors &lt;- ggpubr:::.get_pal(k_colors, k = k)
    else if (is.null(k_colors)) 
      k_colors &lt;- ggpubr:::.get_pal(&quot;default&quot;, k = k)
    dend &lt;- dendextend::set(dend, what = &quot;branches_k_color&quot;, 
                            k = k, value = k_colors)
    if (color_labels_by_k) 
      dend &lt;- dendextend::set(dend, &quot;labels_col&quot;, k = k, 
                              value = k_colors)
  }
  if (!is.null(label_cols)) {
    dend &lt;- dendextend::set(dend, &quot;labels_col&quot;, label_cols)
  }
  leaflab &lt;- ifelse(show_labels, &quot;perpendicular&quot;, &quot;none&quot;)
  if (xlab == &quot;&quot;) 
    xlab &lt;- NULL
  if (ylab == &quot;&quot;) 
    ylab &lt;- NULL
  max_height &lt;- max(dendextend::get_branches_heights(dend))
  if (missing(labels_track_height)) 
    labels_track_height &lt;- max_height/8
  if (max_height &lt; 1) 
    offset_labels &lt;- -max_height/100
  else offset_labels &lt;- -0.1
  if (rectangle | circular) {
    p &lt;- factoextra:::.ggplot_dend(dend, type = &quot;rectangle&quot;, offset_labels = offset_labels, 
                      nodes = FALSE, ggtheme = ggtheme, horiz = horiz, 
                      circular = circular, palette = palette, labels = show_labels, 
                      label_cols = label_cols, labels_track_height = labels_track_height, 
                      ...)
    if (!circular) 
      p &lt;- p + labs(title = main, x = xlab, y = ylab)
  }
  else if (phylogenic) {
    p &lt;- .phylogenic_tree(dend, labels = show_labels, label_cols = label_cols, 
                          palette = palette, repel = repel, ggtheme = ggtheme, 
                          phylo_layout = phylo_layout, ...)
  }
  if (circular | phylogenic | is.null(k)) 
    rect &lt;- FALSE
  if (rect_fill &amp; missing(rect_lty)) 
    rect_lty = &quot;blank&quot;
  if (missing(lower_rect)) 
    lower_rect = -(labels_track_height + 0.5)
  if (rect) {
    p &lt;- p + rect_dendrogram(dend, k = k, palette = rect_border, 
                              rect_fill = rect_fill, rect_lty = rect_lty, size = lwd, 
                              lower_rect = lower_rect)
  }
  attr(p, &quot;dendrogram&quot;) &lt;- dend
  structure(p, class = c(class(p), &quot;fviz_dend&quot;))
  return(p)
}

rect_dendrogram &lt;- function(dend, k = NULL, h = NULL, k_colors = NULL, palette = NULL, 
          rect_fill = FALSE, rect_lty = 2, lower_rect = -1.5, ...) {
  if (missing(k_colors) &amp; !is.null(palette)) 
    k_colors &lt;- palette
  prop_k_height &lt;- 0.5
  if (!dendextend::is.dendrogram(dend)) 
    stop(&quot;x is not a dendrogram object.&quot;)
  k &lt;- factoextra:::.get_k(dend, k, h)
  tree_heights &lt;- dendextend::heights_per_k.dendrogram(dend)[-1]
  tree_order &lt;- stats::order.dendrogram(dend)
  if (is.null(k)) 
    stop(&quot;specify k&quot;)
  if (k &lt; 2) {
    stop(gettextf(&quot;k must be between 2 and %d&quot;, length(tree_heights)), 
         domain = NA)
  }
  cluster &lt;- dendextend::cutree(dend, k = k)
  clustab &lt;- table(cluster)[unique(cluster[tree_order])]
  m &lt;- c(0, cumsum(clustab))
  which &lt;- 1L:k
  xleft &lt;- ybottom &lt;- xright &lt;- ytop &lt;- list()
  for (n in seq_along(which)) {
    next_k_height &lt;- tree_heights[names(tree_heights) == 
                                    k + 1]
    if (length(next_k_height) == 0) {
      next_k_height &lt;- 0
      prop_k_height &lt;- 1
    }
    xleft[[n]] = m[which[n]] + 0.66
    ybottom[[n]] = lower_rect
    xright[[n]] = m[which[n] + 1] + 0.33
    ytop[[n]] &lt;- tree_heights[names(tree_heights) == k] * 
      prop_k_height + next_k_height * (1 - prop_k_height)
  }
  df &lt;- data.frame(xmin = unlist(xleft), ymin = unlist(ybottom), 
                   xmax = unlist(xright), ymax = unlist(ytop), stringsAsFactors = TRUE)
  color &lt;- k_colors
  if (all(color == &quot;cluster&quot;))
    color &lt;- &quot;default&quot;
  if (ggpubr:::.is_col_palette(color)) 
    color &lt;- ggpubr:::.get_pal(color, k = k)
  else if (length(color) &gt; 1 &amp; length(color) &lt; k) {
    color &lt;- rep(color, k)[1:k]
  }
  if (rect_fill) {
    fill &lt;- color
    alpha &lt;- 0.2
  }
  else {
    fill &lt;- &quot;transparent&quot;
    alpha &lt;- 0
  }
  df$color &lt;- color
  df$cluster &lt;- as.factor(paste0(&quot;c&quot;, 1:k))
  ggpubr::geom_exec(geom_rect, data = df, xmin = &quot;xmin&quot;, ymin = &quot;ymin&quot;, 
                    xmax = &quot;xmax&quot;, ymax = &quot;ymax&quot;, fill = fill, color = color, 
                    linetype = rect_lty, alpha = alpha, ...)
}

fviz_dend2(hc, k = 4, # Cut in four groups
          cex = 0.6, # label size
          k_colors = smooth_rainbow(4),
          # color_labels_by_k = TRUE, # color labels by groups
          rect = TRUE, # Add rectangle around groups
          rect_border = smooth_rainbow(4),
          rect_fill = TRUE,
          rotate = TRUE) +
  ggplot2::theme_dark()
#&gt; Warning: The `&lt;scale&gt;` argument of `guides()` cannot be `FALSE`. Use &quot;none&quot; instead as
#&gt; of ggplot2 3.3.4.
#&gt; ℹ The deprecated feature was likely used in the factoextra package.
#&gt;   Please report the issue at &lt;https://github.com/kassambara/factoextra/issues&gt;.

如何调整rect_border以接受多种颜色,就像其他调色板一样?<!-- -->

<sup>Created on 2023-05-07 with reprex v2.0.2</sup>

huangapple
  • 本文由 发表于 2023年5月7日 19:16:38
  • 转载请务必保留本文链接:https://go.coder-hub.com/76193584.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定