высота Извлечение из каждого дендрограмма узла с помощью dendrapply

Question

Вероятно, очень простой,

У меня есть dendrogram:

set.seed(1) 
my_mat <- matrix(rnorm(100),nrow=10,ncol=10) 
my_dend <- as.dendrogram(hclust(dist(my_mat))) 

и я хочу использовать dendrapply для извлечения heightattribute из каждой node в my_dend, так как оно пересекает dendrogram в pre-order.

Trying dendrapply «ы example на my_dend:

dendrapply(my_dend, function(n) utils::str(attributes(n))) 

Он не возвращает значение, но печатает информацию, мне нужно в pre-order. Я думал, что только получение heightattribute возвращенное так просто, как:

dendrapply(my_dend, function(n) attr(n,"height")) 

, но очевидно, что я не прав.

Любая идея?

Answer 1

Это то, что вы хотите?

sapply(hclust(dist(my_mat)), '[')$height 
#[1] 2.195193 2.661372 2.837259 2.890944 3.745600 4.098533 4.177088 5.514541 6.496675 
#and order 
sapply(hclust(dist(my_mat)), '[')$order 
# [1] 4 1 10 8 9 2 5 7 3 6 

Там также dendextend_get_branches_heights в библиотеке dendextend

dendextend_get_branches_heights(my_dend) 
#[1] 2.195193 2.661372 2.837259 2.890944 3.745600 4.098533 4.177088 5.514541 6.496675 

Answer 2

Чтобы получить высоту всех узлов в вашей дендрограмме, вы можете использовать функцию get_nodes_attr из пакета dendextend.

library(dendextend) 
get_nodes_attr(my_dend, "height") 

[1] 6.496675 0.000000 5.514541 3.745600 2.195193 0.000000 0.000000 2.890944 
[9] 0.000000 0.000000 4.177088 2.837259 0.000000 0.000000 4.098533 0.000000 
[17] 2.661372 0.000000 0.000000 

Answer 3

Это далеко от элегантной, но работает:

сохранить результат

dendrapply(my_dend, function(n) utils::str(attributes(n))) 

в файл и отредактировать файл:

out.fn <- "dendrogram.output" 
    capture.output(dendrapply(my_dend, function(n) utils::str(attributes(n))),file=out.fn) 
    system(paste0("sed -i '/List of/d' ",out.fn)) 
    system(paste0("sed -i '/\\[\\[/d' ",out.fn)) 
    system(paste0("sed -i '/NULL/d' ",out.fn)) 
    system(paste0("sed -i '/^$/d' ",out.fn)) 
    system(paste0("sed -i '/class/d' ",out.fn)) 
    system(paste0("sed -i '/midpoint/d' ",out.fn)) 
    system(paste0("sed -i '/leaf/d' ",out.fn)) 
    system(paste0("sed -i '/label/d' ",out.fn)) 
    system(paste0("sed -i '/members/d' ",out.fn)) 
    system(paste0("sed -i 's/ \\$ //g' ",out.fn)) 
    system(paste0("perl -i -pe 's/height\\s+:\\s+num\\s+//g' ",out.fn)) 

    my_dend.df <- dplyr::filter(read.table(out.fn,header=F,sep=",",stringsAsFactors=F,col.names="depth"),depth != 0) 

> my_dend.df 
    depth 
1 6.50 
2 5.51 
3 3.75 
4 2.20 
5 2.89 
6 4.18 
7 2.84 
8 4.10 
9 2.66