Wyodrębnij kolor klastra z wyjścia dendextend :: circlize_dendrogram()

Question

Próbuję wyodrębnić kolory używane w grupowaniu circlize_dendrogram. Oto przykładowe kody:

library(magrittr) 
library(dendextend) 

cols <- c("#009000", "#FF033E", "#CB410B", "#3B444B", "#007FFF") 
dend <- iris[1:40,-5] %>% dist %>% hclust %>% as.dendrogram  

dend <- color_branches(dend, k = 5, col = cols) 
dend %<>% set("labels_col", value = cols, k= 5) 
dend %<>% set("labels_cex", .8) 
dend %<>% set("branches_lwd", 2) 

circlize_dendrogram(dend) 

Więc tabelarycznej klastry są uzyskiwane przy użyciu cutree(dend, k = 5). Czy istnieje sposób na wyodrębnienie kolorów klastrów w dendrogramie na podstawie podanego cols? Potrzebuję go do wstawienia legendy na działce za pomocą pakietu grid.

Przykład, Legenda: Klaster 1 - #009000; Cluster 2 - #FF033E; Cluster 3 - #CB410B; Cluster 4 - #3B444B; Klaster 5 - #007FFF. Problem z circlize_dendrogram polega na tym, że kolejność kolorów używanych w klastrze jest inna.

Chociaż mogę to zrobić ręcznie, byłoby to skuteczne, jeśli mogę to zrobić automatycznie. I to jest możliwe, jeśli mogę wyodrębnić kolory klastra.

Answer 1

OK, tutaj jest bardzo hacky rozwiązanie. Jestem przekonany, że są lepsze, ale to jest pierwsze ukłucie, więc nie bierzcie mnie.

Pomysł polega na przeszukaniu obiektu dend (który jest wewnętrzną listą) dla odpowiednich nazw elementów (w tym przypadku tylko liczb) i wyodrębnieniu odpowiedniego koloru, zapisaniu go w ramce danych i wykorzystaniu go dla legendy .

# First we'll extract the elements and corresponding categories... 
categories <- cutree(dend, k = 5) 

# ... and save them in a data frame 
categories_df <- data.frame(elements = as.numeric(names(categories)), 
     categories = categories, 
     color = NA) 

# now here's a little function that extracts the color for each element 
# from the 'dend' object. It uses the list.search() function from the 
# 'rlist' package 

library(rlist) 

extract_color <- function(element_no, dend_obj) { 
    dend.search <- list.search(dend_obj, all(. == element_no)) 
    color <- attr(dend.search[[1]], "edgePar")$col 
    return(color) 
} 

# I use 'dplyr' to manipulate the data 
library(dplyr) 

categories_df <- categories_df %>% 
    group_by(elements) %>% 
    mutate(color = extract_color(elements, dend)) 

Teraz to daje nam następujące dane: rama

> categories_df 
Source: local data frame [40 x 3] 
Groups: elements [40] 

    elements categories color 
     (dbl)  (int) (chr) 
1   1   1 #CB410B 
2   2   1 #CB410B 
3   3   1 #CB410B 
4   4   1 #CB410B 
5   5   1 #CB410B 
6   6   2 #009000 
7   7   1 #CB410B 
8   8   1 #CB410B 
9   9   3 #007FFF 
10  10   1 #CB410B 
..  ...  ...  ... 

Możemy podsumować to do ramki danych tylko z kolorów dla kategorii, na przykład

legend_data <- categories_df %>% 
    group_by(categories) %>% 
    summarise(color = unique(color)) 

> legend_data 
Source: local data frame [5 x 2] 

    categories color 
     (int) (chr) 
1   1 #CB410B 
2   2 #009000 
3   3 #007FFF 
4   4 #FF033E 
5   5 #3B444B 

Teraz łatwo wygenerować legendę:

circlize_dendrogram(dend) 
legend(-1.05, 1.05, legend = legend_data$categories, fill = legend_data$color, cex = 0.7) 

co daje:

Można użyć cutree(dend, k = 5) w celu potwierdzenia, że ​​numery dla kategorii kolory odpowiadają kategoria każdego elementu.

Answer 2

Oprócz rozwiązania Felixa, chciałbym zakładać własną odpowiedź:

library(magrittr) 
library(grid) 
library(gridExtra) 
library(dendextend) 

cols <- c("#009000", "#FF033E", "#CB410B", "#3B444B", "#007FFF") 
dend <- iris[1:40,-5] %>% dist %>% hclust %>% as.dendrogram  

dend <- color_branches(dend, k = 5, col = cols) 
dend %<>% set("labels_col", value = cols, k= 5) 
dend %<>% set("labels_cex", .8) 
dend %<>% set("branches_lwd", 2) 

clust <- cutree(dend, k = 5) 
colors <- labels_colors(dend)[clust %>% sort %>% names] 
clust_labs <- colors %>% unique 

circlize_dendrogram(dend) 
grid.circle(x = .95, y = .9, r = .02, gp = gpar(fill = clust_labs[1])) 
grid.circle(x = .95, y = .85, r = .02, gp = gpar(fill = clust_labs[2])) 
grid.circle(x = .95, y = .8, r = .02, gp = gpar(fill = clust_labs[3])) 
grid.circle(x = .95, y = .75, r = .02, gp = gpar(fill = clust_labs[4])) 
grid.circle(x = .95, y = .7, r = .02, gp = gpar(fill = clust_labs[5])) 

grid.text(x = .95, y = .9, label = expression(bold(1)), gp = gpar(fontsize = 9, col = "white")) 
grid.text(x = .95, y = .85, label = expression(bold(2)), gp = gpar(fontsize = 9, col = "white")) 
grid.text(x = .95, y = .8, label = expression(bold(3)), gp = gpar(fontsize = 9, col = "white")) 
grid.text(x = .95, y = .75, label = expression(bold(4)), gp = gpar(fontsize = 9, col = "white")) 
grid.text(x = .95, y = .7, label = expression(bold(5)), gp = gpar(fontsize = 9, col = "white")) 
grid.text(x = .91, y = .8, label = "CLUSTERS", rot = 90, gp = gpar(fontsize = 9))