Re: [R] dendrogram - got it , just need to label :)
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. __ R-help@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code.
Re: [R] accessing the "address" of items in a recursive list
j daniel wrote: > > > I would like to print the "address" of the smaller dendrograms on the edge > similar to this: > > addr <- function(n) { > if(!is.leaf(n)) { > attr(n, "edgetext") <- paste("height of",(attr(n,"height")) > } > n > } > labeledDends <- dendrapply(dend, addr) > > Where "i,j,k" is printed instead of "height". But I have not been able to > figure out how to ask each dendrogram its address within the dendrapply > function. Can anyone help me with this? > > Hi! Load the following four functions into R and execute this (assuming your dendrogram is in variable 'dend') newdend <- dendrapplyGlobal(dend, "height",function(x){names(x)},attrNameTo="edgetext") #From the specified dendrogram X a vector of all values of the specified #node attribute is extracted, modified by the function FUN and a new #dendrogram is created using the new values for the attribute. Optionally, #a different attribute can be set using 'attrNameTo' dendrapplyGlobal <- function(X,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(X,funcGet) values <- FUN(values,...) ret <- dendrapplyFromVector(X,values,funcSet) return(ret) } #Traverses the dendrogram in postorder and applies FUN to each node. #The result of each evaluation is stored in the resulting array. #Additional arguments to FUN can be passed as ... #The names attribute of the resulting vector is the 'path' to each node. #This implementation is based on dendrapply(graphics). 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) } #Traverses the dendrogram X in postorder and constructs a new dendrogram using #the specified function FUN and vector parVec. Each element of parVec must #relate to a node in X, which is the case if parVec was created using #dendrapplyToVector(). #Additional arguments to FUN can be passed as ... #This implementation is based on dendrapply(graphics). dendrapplyFromVector <- function(X,parVec,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 for (j in seq_along(d)) { childrenCount <- getDendrogramNodeCount(d[[j]]) indices <- i:(i+childrenCount-1) ret[[j]] <- Napply(d[[j]],v[indices]) i <- i + childrenCount } ret <- FUN(ret,v[i],...) } return(ret) } Napply(X,parVec) } #Returns the number of nodes in a dendrogram. getDendrogramNodeCount <- function(dend) { if (!is.leaf(dend)){ childrenSum <- 0 for (child in dend) { childrenSum <- childrenSum + getDendrogramNodeCount(child) } return(childrenSum+1) } return(1) } -- View this message in context: http://www.nabble.com/accessing-the-%22address%22-of-items-in-a-recursive-list-tp13938566p15019890.html Sent from the R help mailing list archive at Nabble.com. __ R-help@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code.
Re: [R] accessing the "address" of items in a recursive list
j daniel wrote: > > > I would like to print the "address" of the smaller dendrograms on the edge > similar to this: > > addr <- function(n) { > if(!is.leaf(n)) { > attr(n, "edgetext") <- paste("height of",(attr(n,"height")) > } > n > } > labeledDends <- dendrapply(dend, addr) > > Where "i,j,k" is printed instead of "height". But I have not been able to > figure out how to ask each dendrogram its address within the dendrapply > function. Can anyone help me with this? > > Hi! Load the following four functions into R and execute this (assuming your dendrogram is in variable 'dend') newdend <- dendrapplyGlobal(dend, "height",function(x){names(x)},attrNameTo="edgetext") #From the specified dendrogram X a vector of all values of the specified #node attribute is extracted, modified by the function FUN and a new #dendrogram is created using the new values for the attribute. Optionally, #a different attribute can be set using 'attrNameTo' dendrapplyGlobal <- function(X,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(X,funcGet) values <- FUN(values,...) ret <- dendrapplyFromVector(X,values,funcSet) return(ret) } #Traverses the dendrogram in postorder and applies FUN to each node. #The result of each evaluation is stored in the resulting array. #Additional arguments to FUN can be passed as ... #The names attribute of the resulting vector is the 'path' to each node. #This implementation is based on dendrapply(graphics). 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) } #Traverses the dendrogram X in postorder and constructs a new dendrogram using #the specified function FUN and vector parVec. Each element of parVec must #relate to a node in X, which is the case if parVec was created using #dendrapplyToVector(). #Additional arguments to FUN can be passed as ... #This implementation is based on dendrapply(graphics). dendrapplyFromVector <- function(X,parVec,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 for (j in seq_along(d)) { childrenCount <- getDendrogramNodeCount(d[[j]]) indices <- i:(i+childrenCount-1) ret[[j]] <- Napply(d[[j]],v[indices]) i <- i + childrenCount } ret <- FUN(ret,v[i],...) } return(ret) } Napply(X,parVec) } #Returns the number of nodes in a dendrogram. getDendrogramNodeCount <- function(dend) { if (!is.leaf(dend)){ childrenSum <- 0 for (child in dend) { childrenSum <- childrenSum + getDendrogramNodeCount(child) } return(childrenSum+1) } return(1) } hth, Florian -- View this message in context: http://www.nabble.com/accessing-the-%22address%22-of-items-in-a-recursive-list-tp13938566p15019892.html Sent from the R help mailing list archive at Nabble.com. __ R-help@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code.