[R] dendrogram - got it , just need to label :)

[phlow]

Hi!
To label your dendrogram edges with the path to each of them, execute the
following script (assuming that your dendrogram is 'dend', see last 2
lines). 


dendrapplyGlobal <- function(dend,attrName,FUN,...,attrNameTo=NULL) {
	if (is.null(attrNameTo)) {
		attrNameTo <- attrName
	}
	funcGet <- function(x){
		attr(x,attrName)
	}
	funcSet <- function(x,value){
		attr(x,attrNameTo) <- value
		return(x)
	}
	values <- dendrapplyToVector(dend,funcGet)
	values <- FUN(values,...)
	ret <- dendrapplyFromVector(dend,values,funcSet)
	return(ret)
}

dendrapplyToVector <- function(X,FUN,...) {
	FUN <- match.fun(FUN)
	    if (!inherits(X, "dendrogram")) 
	        stop("'X' is not a dendrogram")
	    Napply <- function(d,path="") {
	    	if (is.leaf(d)) {
	    		ret <- c(FUN(d))
	    		names(ret)[1] <- substr(path,start=1,stop=nchar(path)-1)
	    		return(ret)
	    	} 
	    	ret <- vector()
	    	for (j in seq_along(d)) {
	    		addr <- paste(path,j,".",sep="")
	    		ret <- append(ret,Napply(d[[j]],addr))
	    	}
	    	ret <- append(ret,FUN(d))
	    	names(ret)[length(ret)] <- substr(path,start=1,stop=nchar(path)-1)
	        return(ret)
	    }
    Napply(X)
}

dendrapplyFromVector <- function(X,theVector,FUN,...) {
	FUN <- match.fun(FUN)
	    if (!inherits(X, "dendrogram")) 
	        stop("'X' is not a dendrogram")
	    Napply <- function(d,v) {
	    	if (is.leaf(d)) {
	    		ret <- FUN(d,v)
	    		return(ret)
	    	} else {
	    		ret <- d
                        if (!is.list(ret)) 
	                	ret <- as.list(ret)
	                i <- 1
	                memsum <- 0
	    		for (j in seq_along(d)) {
	    			childrenCount <- getDendrogramNodeCount(d[[j]])
	    			memsum <- memsum + childrenCount
	    			indices <- i:(i+childrenCount-1)
	    			ret[[j]] <- Napply(d[[j]],v[indices])
	    			i <- i + childrenCount
	    		}
	    		ret <- FUN(ret,v[i])
	    	}
	        return(ret)
	    }
    Napply(X,theVector)
}


dend1 <- dendrapplyGlobal(dend,
"height",function(x){names(x)},attrNameTo="edgetext")
plot(dend1)

hth,
Florian
-- 
View this message in context: http://www.nabble.com/dendrogram---got-it-%2C-just-need-to-label-%3A%29-tp9403784p15019424.html
Sent from the R help mailing list archive at Nabble.com.