在由 Node-Wise 函数递归定义的 R 中生成 K-Nary 树
Generating A K-Nary Tree In R Recursively Defined By a Node-Wise Function
我怎样才能生成一个节点数未知的树，每个节点都有一个未知且不同数量的 children，条件是 child 个节点的列表给定的 parent 节点是由一些有趣的（parent）生成的？请注意，我正在使用 cran 的库（data.tree）来制作我的树层次结构。
树将始终以给定 parent 向量定义的节点开始。总会有有限数量的节点。每个节点的长度都与根节点相同。
我试图脱离上下文从一般意义上提出这个问题，但它太笼统了，无法提供明确的反馈。因此，这是目前不完全存在的脚本：
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...)
}
}
运行 一个可能的根节点节点上的脚本给出了一个奇怪的结果：
> 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>
如果你想要一个真实的工作示例，你可以从 here 和 运行 中获取并获取 "Generating Scripts.R" 以及 1:n 和 n>2 的任何带符号排列作为类似于我的例子的论点。
更清楚地说，根节点为 c(1,-2,3) 的树假设看起来像这样：
我认为您的功能没有按预期工作。例如，使用您的起始值
lapply(cdrpointers(c(1,-2,3)), function(i) cdrmove(c(1,-2,3), i))
[[1]]
[1] 1 2 3
[[2]]
[1] 1 2 3
但是，假设这些有效。您可以尝试以下方法并确定它们是否被错误使用。
## 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))
在@TheTime的帮助下，我对这个问题有了一个可靠的解决方案。
虽然代码很多，但我想 post 因为重复值存在一些棘手的问题：
####################
# 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 @Whosebug
# 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 )
}
我怎样才能生成一个节点数未知的树，每个节点都有一个未知且不同数量的 children，条件是 child 个节点的列表给定的 parent 节点是由一些有趣的（parent）生成的？请注意，我正在使用 cran 的库（data.tree）来制作我的树层次结构。
树将始终以给定 parent 向量定义的节点开始。总会有有限数量的节点。每个节点的长度都与根节点相同。
我试图脱离上下文从一般意义上提出这个问题，但它太笼统了，无法提供明确的反馈。因此，这是目前不完全存在的脚本：
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...)
}
}
运行 一个可能的根节点节点上的脚本给出了一个奇怪的结果：
> 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>
如果你想要一个真实的工作示例，你可以从 here 和 运行 中获取并获取 "Generating Scripts.R" 以及 1:n 和 n>2 的任何带符号排列作为类似于我的例子的论点。
更清楚地说，根节点为 c(1,-2,3) 的树假设看起来像这样：
我认为您的功能没有按预期工作。例如，使用您的起始值
lapply(cdrpointers(c(1,-2,3)), function(i) cdrmove(c(1,-2,3), i))
[[1]]
[1] 1 2 3
[[2]]
[1] 1 2 3
但是，假设这些有效。您可以尝试以下方法并确定它们是否被错误使用。
## 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))
在@TheTime的帮助下，我对这个问题有了一个可靠的解决方案。
虽然代码很多，但我想 post 因为重复值存在一些棘手的问题：
####################
# 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 @Whosebug
# 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 )
}