Generating A K-Nary Tree In R Recursively Defined By a Node-Wise Function

Question

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:

Answer 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))

Answer 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 )
}