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

Есть ли простой способ вычислить наименьшее значение h в cut, которое создает группы заданного минимального размера?

В этом примере, если мне нужны кластеры, содержащие не менее десяти членов в каждом, я должен использовать h = 3.80:

# using iris data simply for reproducible example
data(iris)
d <- data.frame(scale(iris[,1:4]))
hc <- hclust(dist(d))
plot(hc)

cut(as.dendrogram(hc), h=3.79) # produces 5 groups; group 4 has 7 members

cut(as.dendrogram(hc), h=3.80) # produces 4 groups; no group has <10 members

Поскольку высоты разбиений указаны в hc$height, я мог бы создать набор значений-кандидатов, используя hc$height + 0.00001, а затем циклически выполнять разрезы в каждом из них. Однако я не понимаю, как проанализировать размер кластера members из класса dendrogram. Например, cut(as.dendrogram(hc), h=3.80)$lower[[1]]$members возвращает NULL, а не 66, как хотелось бы.

Обратите внимание, что это более простой вопрос, чем Cutting дендрограмма в n деревьев с минимальным размером кластера в R, которая использует пакет dynamicTreeCut; здесь я не указываю количество деревьев, просто минимальный размер кластера. ТЫВМ.


person C8H10N4O2    schedule 29.06.2015    source источник
comment
в качестве примечания: члены - это атрибут - attr(cut(as.dendrogram(hc), h=3.80)$lower[[1]], "members") дает 66.   -  person lukeA    schedule 29.06.2015


Ответы (3)


Благодаря @Vlo и @lukeA я могу реализовать цикл. Тем не менее, я публикую это только в качестве отправной точки и, безусловно, открыт для более элегантного решения.

unnest <- function(x) { # from Vlo's answer
  if(is.null(names(x))) x
  else c(list(all=unname(unlist(x))), do.call(c, lapply(x, unnest)))
}

cuts <- hc$height + 1e-9

min_size <- 10
smallest <- 0
i <- 0

while(smallest < min_size & i <= length(cuts)){
  h_i <- cuts[i <- i+1]
  if(i > length(cuts)){
    warning("Couldn't find a cluster big enough.")
  }
  else  smallest <- 
           Reduce(min, 
                  lapply(X = unnest(cut(as.dendrogram(hc), h=h_i)$lower), 
                         FUN = attr, which = "members") ) # from lukeA's comment
}
h_i # returns desired output: [1] 3.79211
person C8H10N4O2    schedule 29.06.2015

Эта функция доступна в пакете dendextend с функцией heights_per_k.dendrogram (которая также имеет более быстрая реализация C++ при загрузке функции dendextendRcpp).

## Not run: 
hc <- hclust(dist(USArrests[1:4,]), "ave")
dend <- as.dendrogram(hc)
heights_per_k.dendrogram(dend)
##       1        2        3        4
##86.47086 68.84745 45.98871 28.36531

Кстати, в пакете dedextend есть метод cutree.dendrogram S3 для дендрограмм (который работает очень похоже на cutree для объектов hclust).

person Tal Galili    schedule 11.07.2015
comment
спасибо за ответ (и за создание пакета dendextend, +1). Я отменил ваше редактирование тега, потому что мой вопрос не относится к [dendextend] как таковому, и, хотя это может быть удобно, [dendextend] — не единственное решение. Контекст - person C8H10N4O2; 11.07.2015
comment
Привет @C8H10N4O2. Я рад, что вам нравится дендекстенд :) (есть ли шанс получить пятерку?). Что касается удаления тега - я вижу мета, на которую вы ссылаетесь. На мой взгляд, поскольку dendextend — это пакет, предназначенный для ответов на такие вопросы, я бы предпочел, чтобы люди, глядя на тег dendextend, нашли это решение. то есть: meta.stackexchange.com/questions/26913/ Поскольку это это ваш вопрос - это, очевидно, ваше решение. - person Tal Galili; 11.07.2015

Это не отвечает на вопрос, но может быть полезно для извлечения members, если вы решите пройтись по h.

Кража и изменение некоторого кода из здесь

# Unnest the list/dendogram structure
unnest <- function(x) {
  if(is.null(names(x))) {
    x
  }
  else {
    c(list(all=unname(unlist(x))), do.call(c, lapply(x, unnest)))
  }
}

# Extract the `members` attribute from each dendogram
lapply(X = unnest(cut(as.dendrogram(hc), h=3.8)), FUN = attr, which = "members")

Выход:

# Please don't ask me why there are 2 dendograms stored
# in the `$upper` list while `print` displays one

$upper1
[1] 2

$upper2
[1] 2

$lower1
[1] 66

$lower2
[1] 11

$lower3
[1] 24

$lower4
[1] 49
person Vlo    schedule 29.06.2015