デンドログラム解析
の編集
http://www.okadajp.org/RWiki/?%E3%83%87%E3%83%B3%E3%83%89%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%A0%E8%A7%A3%E6%9E%90
[
トップ
] [
編集
|
差分
|
バックアップ
|
添付
|
リロード
] [
新規
|
一覧
|
検索
|
最終更新
|
ヘルプ
]
-- 雛形とするページ --
(no template pages)
#contents *目的 [#o9a6d319] デンドログラムのデータから、すべてのノードについて、ノードの情報(下にあるすべての リーフの数、高さ)を集めたい。 dendrapplyでは、返されるデータ構造が目的に沿っていなかった。 *関数 [#k0930c71] dend2nodelist <- function(hc) { n <- length(hc$labels) denMat <- matrix(rep(0,n*(n-1)),ncol <- (n-1)) nodeData <- c() for(i in 1:(n-1)){ j <- hc$merge[i,1] k <- hc$merge[i,2] if(j < 0){ denMat[i,-j] <- 1 }else{ denMat[i, which(denMat[j,] == 1)] <- 1 } if(k < 0){ denMat[i,-k] <- 1 }else{ denMat[i, which(denMat[k,] == 1)] <- 1 } leafs <- hc$labels[which(denMat[i,] == 1)]#リーフの一覧 size <- length(leafs)#リーフの数 nodeData <- rbind( nodeData, list( leafs = leafs, size = size, height = hc$height[i] )) } nodeData } *使い方 [#i825e50f] > hc <- hclust(dist(USArrests[1:10,])) > dend2nodelist(hc) leafs size height [1,] Character,2 2 16.80625 [2,] Character,2 2 23.19418 [3,] Character,2 2 25.09303 [4,] Character,3 3 36.73486 [5,] Character,3 3 45.18296 [6,] Character,3 3 60.98073 [7,] Character,6 6 77.19741 [8,] Character,9 9 148.7357 [9,] Character,10 10 226.303 > dend2nodelist(hc)[1,] $leafs [1] "Alabama" "Delaware" $size [1] 2 $height [1] 16.80625 *再帰的な書き方1 [#ub4aea56] f<-function(X){ ret<-NULL f<-function(x){ if(is.leaf(x)){ attr(x,"label") }else{ r<-c(sapply(x,f),recursive=T) ret<<-rbind(ret,list(leafs=r,size=attr(x,"members"),height=attr(x,"height"))) r } } f(X) ret } r<-f(as.dendrogram(hclust(dist(USArrests), "ave"))) *再帰的な書き方2 [#y434a433] dend2nodelist <- function(hc) { GetElement <- function(i, j) { if (i < 0) { if (j < 0) return(c(hc$labels[-i], hc$labels[-j])) else return(c(hc$labels[-i], GetElement(hc$merge[j,1], hc$merge[j,2]))) } else { if (j < 0) return(c(GetElement(hc$merge[i,1], hc$merge[i,2]), hc$labels[-j])) else return(c(GetElement(hc$merge[i,1], hc$merge[i,2]), GetElement(hc$merge[j,1], hc$merge[j,2]))) } } n <- length(hc$height) leafs <- NULL size <- integer(n) for (i in 1:n) { labels <- GetElement(hc$merge[i,1], hc$merge[i,2]) size[i] <- length(labels) leafs[i] <- list(labels) } return(cbind(leafs=leafs, size=size, height=hc$height)) } *再帰的な書き方3 [#c15dae3a] dend2nodelist <- function(hc) { temp <- function(hc, j) GetElement(hc$merge[j,1], hc$merge[j,2]) temp2 <- function(hc, j) if (j < 0) hc$labels[-j] else temp(hc, j) GetElement <- function(i, j) if (i < 0) c(hc$labels[-i], temp2(hc, j)) else c(temp(hc,i), temp2(hc, j)) leafs <- size <- integer(n <- length(hc$height)) for (i in 1:n) {size[i] <- length(labels <- temp(hc, i)); leafs[i] <- list(labels) } return(cbind(leafs=leafs, size=size, height=hc$height)) } *実行例 [#oca5eb44] > hc <- hclust(dist(USArrests[1:10,])) > result <- dend2nodelist(hc)
タイムスタンプを変更しない
#contents *目的 [#o9a6d319] デンドログラムのデータから、すべてのノードについて、ノードの情報(下にあるすべての リーフの数、高さ)を集めたい。 dendrapplyでは、返されるデータ構造が目的に沿っていなかった。 *関数 [#k0930c71] dend2nodelist <- function(hc) { n <- length(hc$labels) denMat <- matrix(rep(0,n*(n-1)),ncol <- (n-1)) nodeData <- c() for(i in 1:(n-1)){ j <- hc$merge[i,1] k <- hc$merge[i,2] if(j < 0){ denMat[i,-j] <- 1 }else{ denMat[i, which(denMat[j,] == 1)] <- 1 } if(k < 0){ denMat[i,-k] <- 1 }else{ denMat[i, which(denMat[k,] == 1)] <- 1 } leafs <- hc$labels[which(denMat[i,] == 1)]#リーフの一覧 size <- length(leafs)#リーフの数 nodeData <- rbind( nodeData, list( leafs = leafs, size = size, height = hc$height[i] )) } nodeData } *使い方 [#i825e50f] > hc <- hclust(dist(USArrests[1:10,])) > dend2nodelist(hc) leafs size height [1,] Character,2 2 16.80625 [2,] Character,2 2 23.19418 [3,] Character,2 2 25.09303 [4,] Character,3 3 36.73486 [5,] Character,3 3 45.18296 [6,] Character,3 3 60.98073 [7,] Character,6 6 77.19741 [8,] Character,9 9 148.7357 [9,] Character,10 10 226.303 > dend2nodelist(hc)[1,] $leafs [1] "Alabama" "Delaware" $size [1] 2 $height [1] 16.80625 *再帰的な書き方1 [#ub4aea56] f<-function(X){ ret<-NULL f<-function(x){ if(is.leaf(x)){ attr(x,"label") }else{ r<-c(sapply(x,f),recursive=T) ret<<-rbind(ret,list(leafs=r,size=attr(x,"members"),height=attr(x,"height"))) r } } f(X) ret } r<-f(as.dendrogram(hclust(dist(USArrests), "ave"))) *再帰的な書き方2 [#y434a433] dend2nodelist <- function(hc) { GetElement <- function(i, j) { if (i < 0) { if (j < 0) return(c(hc$labels[-i], hc$labels[-j])) else return(c(hc$labels[-i], GetElement(hc$merge[j,1], hc$merge[j,2]))) } else { if (j < 0) return(c(GetElement(hc$merge[i,1], hc$merge[i,2]), hc$labels[-j])) else return(c(GetElement(hc$merge[i,1], hc$merge[i,2]), GetElement(hc$merge[j,1], hc$merge[j,2]))) } } n <- length(hc$height) leafs <- NULL size <- integer(n) for (i in 1:n) { labels <- GetElement(hc$merge[i,1], hc$merge[i,2]) size[i] <- length(labels) leafs[i] <- list(labels) } return(cbind(leafs=leafs, size=size, height=hc$height)) } *再帰的な書き方3 [#c15dae3a] dend2nodelist <- function(hc) { temp <- function(hc, j) GetElement(hc$merge[j,1], hc$merge[j,2]) temp2 <- function(hc, j) if (j < 0) hc$labels[-j] else temp(hc, j) GetElement <- function(i, j) if (i < 0) c(hc$labels[-i], temp2(hc, j)) else c(temp(hc,i), temp2(hc, j)) leafs <- size <- integer(n <- length(hc$height)) for (i in 1:n) {size[i] <- length(labels <- temp(hc, i)); leafs[i] <- list(labels) } return(cbind(leafs=leafs, size=size, height=hc$height)) } *実行例 [#oca5eb44] > hc <- hclust(dist(USArrests[1:10,])) > result <- dend2nodelist(hc)
テキスト整形のルールを表示する