R中如何遍历hclust内部节点

Question

考虑我们有这样一个用于聚类的数据框。

# df
dput(df)
structure(c(1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 
0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 
1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 
0L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 
1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 1L, 1L), dim = c(9L, 11L), dimnames = list(c("1", 
"2", "3", "4", "5", "6", "7", "8", "9"), c("C", "D", "E", "F", 
"G", "H", "K", "L", "M", "N", "P")))

dist_matrix <- dist(df, method = "manhattan")
clust <- hclust(dist_matrix, method = "complete")
plot(clust)

我们可以得到如下的聚类结果，其中斜体字母是附加标记。

请允许我用伪代码来说明我要实现的功能。

1. 获取特定节点的左节点和右节点。

FUNC GET_RIGHT_NODE(D)
RETUEN E,F,G
FUNC GET_LEFT_NODE(RIGHT)
RETUEN A,B,C

2. 获取特定节点的叶子元素

FUNC GET_LEAF(D)
RETURN 5,3,1,2,4

相关主题：

R：帮助分析层次聚类中的聚类内容

如何在 R 中打印 hclust 对象的行？

R 中的层次聚类最近邻算法

Answer 1

您需要的信息已编码在

clust$merge

中（请参阅

?hclust

）。

clust$merge
#>      [,1] [,2]
#> [1,]   -2   -4
#> [2,]   -8   -9
#> [3,]   -7    2
#> [4,]   -1    1
#> [5,]   -3    4
#> [6,]   -6    3
#> [7,]   -5    5
#> [8,]    6    7

这里节点1（

clust$merge

的第一行）由叶子

2

和

4

组成，节点3（第三行）由叶子

7

和节点2组成，依此类推

您的标签将对应于

clust$merge

，如下所示：

cbind(as.data.frame(clust$merge),
      Label = c("G", "C", "B", "F", "E", "A", "D", "Root"))
#>   V1 V2 Label
#> 1 -2 -4     G
#> 2 -8 -9     C
#> 3 -7  2     B
#> 4 -1  1     F
#> 5 -3  4     E
#> 6 -6  3     A
#> 7 -5  5     D
#> 8  6  7  Root

满足您要求的功能：

首先是指定节点左（右）的节点：

get_node <- function(cl, n, left = TRUE) {
  m <- cl$merge
  
  if (left) {
    if (m[n, 1] > 0) n <- m[n, 1] else return(integer(0))
  } else {
    if (m[n, 2] > 0) n <- m[n, 2] else return(integer(0))
  }
  
  e <- environment()
  out <- integer(n)
  out[1] <- n
  i <- 1L
  
  f <- function(n) {
    if (m[n, 1] > 0) {
      e$i <- e$i + 1L
      e$out[e$i] <- m[n, 1]
      Recall(e$out[d$i])
    }
    
    if (m[n, 2] > 0) {
      e$i <- e$i + 1L
      e$out[e$i] <- m[n, 2]
      Recall(e$out[e$i])
    }
  }
  
  f(n)
  out[1:i]
}

指定节点下的叶子：

get_leaf <- function(cl, n) {
  m <- cl$merge
  e <- environment()
  i <- 0L
  out <- integer(n + 1)
  
  f <- function(n) {
    if (m[n, 1] > 0) {
      f(m[n, 1])
    } else {
      e$i <- e$i + 1L
      e$out[e$i] <- -m[n, 1]
    }
    
    if (m[n, 2] > 0) {
      f(m[n, 2])
    } else {
      e$i <- e$i + 1L
      e$out[e$i] <- -m[n, 2]
    }
  }
  
  f(n)
  out[1:i]
}

演示：

get_node(clust, 7, FALSE) # get all nodes to the right of "D"
#> [1] 5 4 1
get_node(clust, 8)        # get all nodes to the left of "Root"
#> [1] 6 3 2
get_leaf(clust, 7)        # get all leaves under "D"
#> [1] 5 3 1 2 4
get_leaf(clust, 6)        # get all leaves under "A"
#> [1] 6 7 8 9