R получение поддеревьев из дендрограммы на основе меток разрезов

================= ОБНОВЛЕННЫЙ ответ

Теперь это можно решить с помощью get_subdendrograms из dendextend.

# needed packages:
# install.packages(gplots)
# install.packages(viridis)
# install.packages(devtools)
# devtools::install_github('talgalili/dendextend') # dendextend from github

# define dendrogram object to play with:
dend <- iris[,-5] %>% dist %>% hclust %>% as.dendrogram %>%  set("labels_to_character") %>% color_branches(k=5)
dend_list <- get_subdendrograms(dend, 5)

# Plotting the result
par(mfrow = c(2,3))
plot(dend, main = "Original dendrogram")
sapply(dend_list, plot)

Это также можно использовать в тепловой карте:

# plot a heatmap of only one of the sub dendrograms
par(mfrow = c(1,1))
library(gplots)
sub_dend <- dend_list[[1]] # get the sub dendrogram
# make sure of the size of the dend
nleaves(sub_dend)
length(order.dendrogram(sub_dend))
# get the subset of the data
subset_iris <- as.matrix(iris[order.dendrogram(sub_dend),-5])
# update the dendrogram's internal order so to not cause an error in heatmap.2
order.dendrogram(sub_dend) <- rank(order.dendrogram(sub_dend))
heatmap.2(subset_iris, Rowv = sub_dend, trace = "none", col = viridis::viridis(100))

================= СТАРЫЙ ответ

Я думаю, что вам могут быть полезны следующие две функции:

Первый просто перебирает все кластеры и извлекает подструктуру. Это требует:

• объект dendrogram, из которого мы хотим получить субдендрограммы
• метки кластеров (например, возвращенные cutree)

Возвращает список субдендрограмм.

extractDendrograms <- function(dendr, clusters){
    lapply(unique(clusters), function(clust.id){
        getSubDendrogram(dendr, which(clusters==clust.id))
    })
}

Второй выполняет поиск в глубину, чтобы определить, в каком поддереве существует кластер, и если он соответствует полному кластеру, возвращает его. Здесь мы используем предположение, что все элементы кластера находятся в одном подгруппе. Это требует:

• объект дендрограммы
• позиции элементов в кластере

Возвращает субдендрограммы, соответствующие кластеру заданных элементов.

getSubDendrogram<-function(dendr, my.clust){
    if(all(unlist(dendr) %in% my.clust))
        return(dendr)
    if(any(unlist(dendr[[1]]) %in% my.clust ))
        return(getSubDendrogram(dendr[[1]], my.clust))
    else 
        return(getSubDendrogram(dendr[[2]], my.clust))
}

Используя эти две функции, мы можем использовать переменные, которые вы указали в вопросе, и получить следующий результат. (Думаю, строчка clusters <- cutree(dnd, k = 6) должна быть clusters <- cutree(hc, k = 6))

my.sub.dendrograms <- extractDendrograms(dnd, clusters)

построение всех шести элементов из списка дает все субдендрограммы

ИЗМЕНИТЬ

Как предлагается в комментарии, я добавляю функцию, которая в качестве входных данных принимает дендрограмму dend и количество поддеревьев k, но по-прежнему использует ранее определенную рекурсивную функцию getSubDendrogram:

prune_cutree_to_dendlist <- function(dend, k, order_clusters_as_data=FALSE) {
    clusters <- cutree(dend, k, order_clusters_as_data)
    lapply(unique(clusters), function(clust.id){    
        getSubDendrogram(dend, which(clusters==clust.id))
    })
}

Тестовый пример для 5 подструктур:

library(dendextend)
dend <- iris[,-5] %>% dist %>% hclust %>% as.dendrogram %>% set("labels_to_character") %>% color_branches(k=5)

subdend.list <- prune_cutree_to_dendlist(dend, 5)

#plotting
par(mfrow = c(2,3))
plot(dend, main = "original dend")
sapply(prunned_dends, plot)

Я выполнил несколько тестов, используя rbenchmark с функцией, предложенной Талом Галили (здесь она называется prune_cutree_to_dendlist2), и результаты довольно многообещающие для подхода DFS из приведенного выше:

library(rbenchmark)
benchmark(prune_cutree_to_dendlist(dend, 5), 
          prune_cutree_to_dendlist2(dend, 5), replications=5)

                                test replications elapsed relative user.self
1  prune_cutree_to_dendlist(dend, 5)            5    0.02        1     0.020
2 prune_cutree_to_dendlist2(dend, 5)            5   60.82     3041    60.643

Я написал функцию prune_cutree_to_dendlist, чтобы сделать то, о чем вы просили. Я должен добавить его в dendextend в будущем.

А пока вот пример кода и вывода (функция немного медленная. Чтобы сделать ее быстрее, нужно, чтобы prune была быстрее, и я не собираюсь исправлять ее в ближайшем будущем.)

# install.packages("dendextend")

library(dendextend)
dend <- iris[,-5] %>% dist %>% hclust %>% as.dendrogram %>% 
  set("labels_to_character")
dend <- dend %>% color_branches(k=5)

# plot(dend)

prune_cutree_to_dendlist <- function(dend, k) {
  clusters <- cutree(dend,k, order_clusters_as_data = FALSE)
  # unique_clusters <- unique(clusters) # could also be 1:k but it would be less robust
  # k <- length(unique_clusters)
  # for(i in unique_clusters) { 
  dends <- vector("list", k)
  for(i in 1:k) { 
    leves_to_prune <- labels(dend)[clusters != i]
    dends[[i]] <- prune(dend, leves_to_prune)

  }

  class(dends) <- "dendlist"

  dends
}

prunned_dends <- prune_cutree_to_dendlist(dend, 5)
sapply(prunned_dends, nleaves)

par(mfrow = c(2,3))
plot(dend, main = "original dend")
sapply(prunned_dends, plot)

Как вы получили 6 кластеров с помощью hclust? Вы можете разрезать дерево в любой момент, поэтому просто попросите cuttree дать вам больше кластеров:

clusters = cutree(hclusters, number_of_clusters)

Однако, если у вас много данных, это может быть не очень удобно. В этих случаях я вручную выбираю кластеры, которые хочу изучить дальше, а затем запускаю hclust только для данных в этих кластерах. Я не знаю ни одной функции в hclust, которая позволяет делать это автоматически, но это довольно просто:

good_clusters = c(which(clusters==1), 
                  which(clusters==2)) #or whichever cLusters you want
new_df = df[good_clusters,]
new_hclusters = hclust(new_df)
new_clusters = cutree(new_hclusters, new_number_of_clusters)