hauteur Extrait de chaque nœud de dendrogramme en utilisant dendrapply

Question

probablement très simple,

J'ai un dendrogram:

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

et je veux utiliser dendrapply pour extraire le heightattribute de tous node en my_dend, puisqu'il traverse le dendrogram en pre-order.

l » Trying dendrapplyexample sur my_dend:

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

Il ne retourne pas de valeur, mais imprime les informations dont j'ai besoin pre-order. Je pensais que juste obtenir le heightattribute retour est aussi simple que:

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

mais il est évident que je me trompe.

Une idée?

Answer 1

Est-ce ce que vous voulez?

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 

Il y a aussi dendextend_get_branches_heights dans la bibliothèque 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

Pour obtenir la hauteur de tous les noeuds de votre dendrogramme, vous pouvez utiliser la fonction get_nodes_attr du paquet 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

C'est de loin d'être élégant, mais fonctionne:

enregistrer la sortie de

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

dans un fichier, et modifier ce fichier:

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