# NOT RUN {
##################################################
## This tree reads a list
offspring <- function(path=character(0), lst, ...) {
if(length(path))
obj <- lst[[path]]
else
obj <- lst
nms <- names(obj)
hasOffspring <- sapply(nms, function(i) {
newobj <- obj[[i]]
is.recursive(newobj) && !is.null(names(newobj))
})
data.frame(comps=nms, hasOffspring=hasOffspring, ## fred=nms,
stringsAsFactors=FALSE)
}
l <- list(a="1", b= list(a="21", b="22", c=list(a="231")))
# }
# NOT RUN {
w <- gwindow("Tree test")
t <- gtree(offspring=offspring, offspring.data=l, cont=w)
# }
# NOT RUN {
##################################################
## This tree looks at recursive objects
describe <- function(x) UseMethod("describe")
describe.default <- function(x) sprintf("An object with class %s", class(x)[1])
describe.integer <- function(x) sprintf("An integer with %s value%s", length(x),
ifelse(length(x) > 1, "s", ""))
describe.numeric <- function(x) sprintf("A numeric with %s value%s", length(x),
ifelse(length(x) > 1, "s", ""))
describe.factor <- function(x) sprint("A factor with %s level%s", length(levels(x)),
ifelse(length(levels(x)) > 1, "s", ""))
offspring <- function(path, obj) {
if(length(path) > 0)
x <- obj[[path]]
else
x <- obj
nms <- names(x)
recursive <- sapply(x, function(i) {
is.recursive(i) &&
!is.null(attr(i, "names")) &&
length(i) > 0
})
descr <- sapply(x, describe)
data.frame(Variable=nms, offspring=recursive, Description=descr, stringsAsFactors=FALSE)
}
l <- lm(mpg ~ wt, mtcars)
# }
# NOT RUN {
w <- gwindow("test")
gtree(offspring=offspring, offspring.data=l, cont=w)
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab