问题
How can I generate a tree with an unknown number of nodes, each of which have an unknown and varying number of children, with the condition that a list of the child nodes for a given parent node is generated by some fun(parent)? Note that I'm using library(data.tree) from cran to make my tree hierarchy.
The tree will always begin with a node defined by a given parent vector. There will always be a finite amount of nodes. Every node will have the same length as the root node.
I've tried to create the question in a general sense out of context, but it has just been too general to provide definitive feedback. Accordingly, here is the script that is presently not quite there:
require(data.tree)
#also requires Generating Scripts (link at bottom) to run
# Helper function to insert nodes as children of parents with unique names
i=1
assn <- function(child,parentvarname){
child<-paste(child,collapse=" ")
nam <- paste("v", i, sep = "")
# assign node to variable called vi
# and make the tree global so it can be seen outside the function
assign(nam, parentvarname$AddChild(child),envir = .GlobalEnv)
noquote(nam)->a
i+1
a #output the child variable name vi for the sake of recursion
}
cdrtree<- function(root){
#assign root
v0 <- Node$new(root) #assign root to the root of the tree
node<-root #rename variable for clarity in next step
kidparentname<-v0 #recursion starts at v0
have.kids<-function(node){ #this is unfortunately asexual reproduction...
for(pointer in cdrpointers(node)){ #A variable number of pointers are
#used to determine the next node(s) if any with function cdrmove
cdrmove(node,pointer)->newkid #make a child
assn(newkid,kidparentname) #enter this node in the tree hierarchy
#get the name of newkid for next iteration and write name to tree
kidparentname<-assn(newkid,kidparentname)
node<-newkid #rename node variable for the next iteration
have.kids(newkid) #recurse, likely the problem is here
}
return(v0) #return the tree (if the code works...)
}
}
Running the script on a possible root node node gives a strange result:
> cdrtree(c(1,-2,3))
> cdrtree(c(1,-2,3))->a
> a
function(node){ #this is unfortunately asexual reproduction...
for(pointer in cdrpointers(node)){ #A variable number of pointers are
... #all code as written above ...
}
<environment: 0x00000000330ee348>
If you want a true working example, you can grab and source "Generating Scripts.R" from here and run it with any signed permutation of 1:n with n>2 as an argument similar to my example.
To be extra clear, the tree with root node c(1,-2,3) would hypothetically look something like this:
回答1:
I don't think your function are working as expected. For example, using your starting value,
lapply(cdrpointers(c(1,-2,3)), function(i) cdrmove(c(1,-2,3), i))
[[1]]
[1] 1 2 3
[[2]]
[1] 1 2 3
But, assuming those work. you could try the following and determine if they are being used incorrectly.
## Name nodes uniquely, dont be assigning to the .Globalenv like
## you are in `assn`, which wont work becuse `i` isn't being incremented.
## You could invcrement `i` in the global, but, instead,
## I would encapsulate `i` in the function's parent.frame, avoiding possible conflicts
nodeNamer <- function() {
i <- 0
## Note: `i` is incremented outside of the scope of this function using `<<-`
function(node) sprintf("v%g", (i <<- i+1))
}
## Load your functions, havent looked at these too closely,
## so just gonna assume they work
source(file="https://raw.githubusercontent.com/zediiiii/CDS/master/Generating%20Scripts.r")
cdrtree <- function(root.value) {
root <- Node$new('root') # assign root
root$value <- root.value # There seems to be a separation of value from name
name_node <- nodeNamer() # initialize the node counter to name the nodes
## Define your recursive helper function
## Note: you could do without this and have `cdrtree` have an additional
## parameter, say tree=NULL. But, I think the separation is nice.
have.kids <- function(node) {
## this function (`cdrpointers`) needs work, it should return a 0 length list, not print
## something and then error if there are no values
## (or throw and error with the message if that is what you want)
pointers <- tryCatch({cdrpointers(node$value)}, error=function(e) return( list() ))
if (!length(pointers)) return()
for (pointer in pointers) {
child_val <- cdrmove(node$value, pointer) # does this always work?
child <- Node$new(name_node()) # give the node a name
child$value <- child_val
child <- node$AddChildNode(child)
Recall(child) # recurse with child
}
}
have.kids(root)
return( root )
}
library(data.tree)
res <- cdrtree(root.value=c(1,-2,3))
回答2:
After much help from @TheTime I have a solid solution to this question.
Though it's a lot of code, I would like to post it because there are a few tricky issues with duplicate values:
####################
# function: cdrtree()
# purpose: Generates a CDR tree with uniquely named nodes (uniqueness is required for igraph export)
# parameters: root.value: the value of the seed to generate the tree. Values of length>6 are not recommended.
# Author: Joshua Watson Nov 2015, help from TheTime @stackoverflow
# Dependancies: sort.listss.r ; gen.bincomb.r
require(combinat)
require(data.tree)
#Two helper functions for keeping names distinct.
nodeNamer <- function() {
i <- 0
function(node) sprintf("v%g", (i <<- i+1))
}
nodeNamer2 <- function() {
j <- 0
function(node) sprintf("%g", (j <<- j+1))
}
cdrtree <- function(root.value, make.igraph=FALSE) {
templist<- list()
root <- Node$new('v0')
root$value <- root.value
root$name <- paste(unlist(root$value),collapse=' ') #name this the same as the value collapsed in type char
name.node <- nodeNamer() # initialize the node counters to name the nodes
name.node2 <- nodeNamer2()
#recursive function that produces chidlren and names them appropriately
have.kids <- function(node) {
pointers <- tryCatch({cdrpointers(node$value)}, error=function(e) return( list() ))
if (!length(pointers)) return()
for (pointer in pointers) {
child.val <- cdrmove(node$value, pointer) #make the cdr move on the first pointer
child <- Node$new(name.node())
child$value <- child.val
#child$name <- paste(" ",unlist(child$value),collapse=' ') # Name it for text
child$name <- paste(unlist(child$value),collapse=' ') # Name it For Graphics
child <- node$AddChildNode(child)
#identical ending name handling catches duplicates. Names WIN+, WIN-, and DRAW outcomes
endname<-paste(unlist(tail(gen.cdrpile(length(root.value)), n=1)[[1]]),collapse=' ')
startname<-paste(unlist(root$value),collapse=' ')
if(child$name==endname){
child$name <- paste(name.node2(),"-WIN",child$name,sep='')
} else {
if(child$name==startname){
child$name <- paste(name.node2(),"+WIN",child$name,sep='')
} else {
#if all negative or all postitive then it is terminal and could be a duplicate, rename it
if((sum(child$value < 0) == length(root.value)) || (sum(child$value < 0 ) == 0 )){
child$name <- paste(name.node2(),"DRAW",child$name,sep='')
} else {
#catch the other duplicate cases that aren't listed above
if((child$name %in% templist == TRUE) || (child$name == root$name)){
child$name <- paste(name.node2(),"DUP",child$name,sep='')
#templist[[length(pointerlist)+1]] <-
}
}
}
}
#make a list of names for the last duplicate catcher
append(child$name,templist)->>templist
Recall(child) # recurse with child
}
}
have.kids(root)
return( root )
}
来源：https://stackoverflow.com/questions/33772031/generating-a-k-nary-tree-in-r-recursively-defined-by-a-node-wise-function