Fixed after name change

R/calc-methods.R

@@ -5,13 +5,13 @@ calcPhyDv <- function(tree, ids) {
   counts <- table(prids)
   prids <- names(counts)[counts < length(ids)]
   spans <- unlist(lapply(tree@nodelist[c(ids, prids)],
-                         function(x) x$span))
+                         function(n) n[['span']]))
   sum(spans)
 }
 
 calcFrPrp <- function(tree, ids) {
   .share <- function(id) {
-    span <- tree@nodelist[[id]]$span
+    span <- tree@nodelist[[id]][['span']]
     children <- getNodeChildren(tree, id)
     if(!is.null(children)) {
       n <- length(children)
@@ -35,7 +35,7 @@ calcDstMtrx <- function(tree, ids) {
       return(0)
     }
     path <- getPath(tree, from=cmb[1], to=cmb[2])
-    path_spans <- unlist(lapply(tree@nodelist[path], function(x) x$span))
+    path_spans <- unlist(lapply(tree@nodelist[path], function(n) n[['span']]))
     sum(path_spans)
   }
   res <- apply(cmbs, 1, .getDist)

R/display-methods.R

@@ -56,30 +56,30 @@ setGeneric ("viz", signature=c("tree", "taxonyms"),
 setMethod ('viz', 'TreeMan',
            function(tree, taxonyms){
              get_pnts <- function (node, y, pnts) {
-               pstnds <- node$postnode
-               low_y_diff <- -node$pd/2
-               high_y_diff <- node$pd/2
+               pstids <- node[['post']]
+               low_y_diff <- -node[['pd']]/2
+               high_y_diff <- node[['pd']]/2
                y_diffs <- seq(from=low_y_diff, to=high_y_diff,
-                              length.out=length(pstnds))
+                              length.out=length(pstids))
                counter <- 1
-               for (pstnd in pstnds) {
-                 pstnd <- tree@nodelist[[pstnd]]
-                 pstnd_x <- pstnd$predist
+               for (pstid in pstids) {
+                 pstnd <- tree@nodelist[[pstid]]
+                 pstnd_x <- pstnd[['predist']]
                  pstnd_y <- y + y_diffs[counter]
-                 pnts <- rbind (pnts, data.frame (node=pstnd$id,
+                 pnts <- rbind (pnts, data.frame (node=pstid,
                                                   x=pstnd_x, y=pstnd_y))
                  pnts <- get_pnts (pstnd, pstnd_y, pnts)
                  counter <- counter + 1
                }
                pnts
              }
-             if(!tree@spns) {
+             if(!tree@wspn) {
                # TODO: switch to setNodesSpan
                for(i in 1:length(tree@nodelist)) {
-                 tree@nodelist[[i]]$span <- 1
-                 tree@nodelist[[i]]$pd <- length(tree@nodelist[[i]]$children)
-                 prnds <- getNodePrenodes(tree, tree@nodelist[[i]]$id)
-                 tree@nodelist[[i]]$predist <- length(prnds)
+                 tree@nodelist[[i]][['span']] <- 1
+                 tree@nodelist[[i]][['pd']] <- length(tree@nodelist[[i]][['children']])
+                 prids <- getNodePre(tree, tree@nodelist[[i]][['id']])
+                 tree@nodelist[[i]][['predist']] <- length(prids)
                }
                tree@pd <- length(tree@nodelist) - 1
              }
@@ -97,14 +97,14 @@ setMethod ('viz', 'TreeMan',
                            xlab='', bty='n', ylim=y_lmts)
              if(taxonyms) {
                text (x=pnts$x, y=pnts$y,
-                     labels=sapply(pnts$node, function(n) tree@nodelist[[n]]$taxonym),
+                     labels=sapply(pnts$node, function(n) tree@nodelist[[n]][['taxonym']]),
                      pos=1)
              } else {
                text (x=pnts$x, y=pnts$y, labels=pnts$node, pos=1)
              }
              # draw lines
              for (i in 2:nrow (pnts)) {
-               prenode <- tree@nodelist[[pnts$node[i]]]$prenode
+               prenode <- tree@nodelist[[pnts$node[i]]][['pre']]
                ind <- c (i, which (pnts$node == prenode))
                lines (x=pnts$x[ind], y=pnts$y[ind])
              }

R/gen-methods.R

@@ -51,13 +51,13 @@ randTree <- function (n) {
         new_predist <- predist + new_span
         nodelist <- .node (nl, new_id, new_span,
                            new_pre, new_predist, nodelist)
-        children <- c (children, nodelist[[new_id]]$children)
-        pd <- pd + new_span + nodelist[[new_id]]$pd
+        children <- c (children, nodelist[[new_id]][['children']])
+        pd <- pd + new_span + nodelist[[new_id]][['pd']]
       }
     }
-    nodelist[[id]]$children <- children
-    nodelist[[id]]$post <- post
-    nodelist[[id]]$pd <- pd
+    nodelist[[id]][['children']] <- children
+    nodelist[[id]][['post']] <- post
+    nodelist[[id]][['pd']] <- pd
     nodelist
   }
   if (n < 2) {

R/get-methods.R

@@ -16,7 +16,7 @@ getNodesName <- function(tree, name, ids) {
 
 getNodeChildren <- function(tree, id) {
   node <- tree@nodelist[[id]]
-  node$children
+  node[['children']]
 }
 
 getNodesChildren <- function(tree, ids) {
@@ -27,7 +27,7 @@ getNodesChildren <- function(tree, ids) {
 #TODO: how to effectively handle unrooted trees, age has no meaning
 getNodeAge <- function(tree, id) {
   node <- tree@nodelist[[id]]
-  tree@age - node$predist
+  tree@age - node[['predist']]
 }
 
 getNodesAge <- function(tree, ids) {
@@ -36,14 +36,14 @@ getNodesAge <- function(tree, ids) {
 }
 
 getEdgeAge <- function(tree, id) {
-  max <- getNodeAge(tree, tree@nodelist[[id]]$pre)
+  max <- getNodeAge(tree, tree@nodelist[[id]][['pre']])
   min <- getNodeAge(tree, id)
   data.frame(edge=id, max, min)
 }
 
 getEdgesAge <- function(tree, ids) {
   maxs <- sapply(ids, function(tree, id) {
-    getNodeAge(tree, tree@nodelist[[id]]$pre)
+    getNodeAge(tree, tree@nodelist[[id]][['pre']])
   }, tree=tree)
   mins <- sapply(ids, getNodeAge, tree=tree)
   data.frame(edge=ids, max=maxs, min=mins, row.names=NULL)
@@ -74,7 +74,7 @@ getPath <- function(tree, from, to) {
 # @name get_Pre
 getNodePre <- function(tree, id) {
   .get <- function(nd, prids) {
-    prid <- tree@nodelist[[nd]]$pre
+    prid <- tree@nodelist[[nd]][['pre']]
     if(!is.null(prid)) {
       prids <- c(prid, .get(prid, prids))
     }
@@ -90,9 +90,9 @@ getNodesPre <- function(tree, ids) {
 # @name get_Lineage
 getNodeLineage <- function(tree, id) {
   prids <- getNodePre(tree, id)
-  lineage <- sapply(prids, function(n) tree@nodelist[[n]]$taxonym)
+  lineage <- sapply(prids, function(n) tree@nodelist[[n]][['taxonym']])
   if(length(lineage) > 0) {
-    lineage <- c(tree@nodelist[[id]]$taxonym, lineage)
+    lineage <- c(tree@nodelist[[id]][['taxonym']], lineage)
     lineage <- lineage[length(lineage):1]
     lineage <- unique(lineage)
   } else {
@@ -110,15 +110,15 @@ getNodePost <- function(tree, id) {
   .get <- function(nds, pstids) {
     new_nds <- c()
     for(nd in nds) {
-      new_nds <- c(new_nds, tree@nodelist[[nd]]$post)
+      new_nds <- c(new_nds, tree@nodelist[[nd]][['post']])
     }
     pstids <- c(pstids, new_nds)
     if(length(new_nds) > 0) {
       pstids <- .get(nds=new_nds, pstids=pstids)
     }
     pstids
   }
-  .get(nds=node, pstids=NULL)
+  .get(nds=id, pstids=NULL)
 }
 
 getNodesPost <- function(tree, ids) {
@@ -129,13 +129,13 @@ getNodesPost <- function(tree, ids) {
 getSubtree <- function(tree, id) {
   pstids <- getNodePost(tree, id)
   ndlst <- tree@nodelist[c(id, pstids)]
-  nd_prdst <- ndlst[[id]]$predist
+  nd_prdst <- ndlst[[id]][['predist']]
   ndlst <- lapply(ndlst, function(x) {
-    x$predist <- x$predist - nd_prdst
+    x[['predist']] <- x[['predist']] - nd_prdst
     x
   })
-  ndlst[[id]]$pre <- NULL
-  ndlst[[id]]$span <- 0
+  ndlst[[id]][['pre']] <- NULL
+  ndlst[[id]][['span']] <- 0
   new_tree <- new('TreeMan', nodelist=ndlst, root=id)
   .update(new_tree)
 }

R/manip-methods.R

@@ -4,54 +4,54 @@ addTip <- function(tree, id, sister, start, end,
                    parent_id=paste0("p_", id),
                    tip_taxonym=NULL, parent_taxonym=NULL) {
   updatePre <- function(node) {
-    node$children <- c(node$children, tip$id)
-    node$pd <- node$pd + tip$span
+    node[['children']] <- c(node[['children']], tip[['id']])
+    node[['pd']] <- node[['pd']] + tip[['span']]
     node
   }
   tip <- list('id'=id)
   if(!is.null(tip_taxonym)) {
-    tip$taxonym <- tip_taxonym
+    tip[['taxonym']] <- tip_taxonym
   }
   node <- list('id'=parent_id)
   if(!is.null(parent_taxonym)) {
-    node$taxonym <- parent_taxonym
+    node[['taxonym']] <- parent_taxonym
   }
-  tip$span <- start - end
+  tip[['span']] <- start - end
   age <- getNodeAge(tree, sister)
   new_sister <- sister <- tree@nodelist[[sister]]
-  new_parent <- tree@nodelist[[sister$pre]]
-  new_parent$post <- new_parent$post[!new_parent$post %in% sister$id]
-  new_parent$post <- c(new_parent$post, node$id)
-  new_sister$span <- start - age
-  new_sister$pre <- node$id
-  node$span <- sister$span - new_sister$span
-  node$pd <- new_sister$span + tip$span
-  node$predist <- sister$predist - new_sister$span
-  node$pre <- sister$pre
-  node$post <- node$children <- c(tip$id, sister$id)
-  tip$pd <- 0
-  tip$predist <- node$predist + tip$span
-  tip$pre <- node$id
-  tree@nodelist[[tip$id]] <- tip
-  tree@nodelist[[node$id]] <- node
-  tree@nodelist[[new_sister$id]] <- new_sister
-  tree@nodelist[[new_parent$id]] <- new_parent
-  pres <- getNodePre(tree, node$id)
+  new_parent <- tree@nodelist[[sister[['pre']]]]
+  new_parent[['post']] <- new_parent[['post']][!new_parent[['post']] %in% sister[['id']]]
+  new_parent[['post']] <- c(new_parent[['post']], node[['id']])
+  new_sister[['span']] <- start - age
+  new_sister[['pre']] <- node[['id']]
+  node[['span']] <- sister[['span']] - new_sister[['span']]
+  node[['pd']] <- new_sister[['span']] + tip[['span']]
+  node[['predist']] <- sister[['predist']] - new_sister[['span']]
+  node[['pre']] <- sister[['pre']]
+  node[['post']] <- node[['children']] <- c(tip[['id']], sister[['id']])
+  tip[['pd']] <- 0
+  tip[['predist']] <- node[['predist']] + tip[['span']]
+  tip[['pre']] <- node[['id']]
+  tree@nodelist[[tip[['id']]]] <- tip
+  tree@nodelist[[node[['id']]]] <- node
+  tree@nodelist[[new_sister[['id']]]] <- new_sister
+  tree@nodelist[[new_parent[['id']]]] <- new_parent
+  pres <- getNodePre(tree, node[['id']])
   tree@nodelist[pres] <- lapply(tree@nodelist[pres],
                                     updatePre)
   .update(tree)
 }
 #TODO: add doc on pinning tips
 pinTip <- function(tree, tip_id, lineage, end) {
-  taxonyms <- unlist(lapply(tree@nodelist, function(n) n$taxonym))
+  taxonyms <- unlist(lapply(tree@nodelist, function(n) n[['taxonym']]))
   for(i in length(lineage):1) {
     edges <- names(taxonyms)[which(taxonyms == lineage[i])]
     if(length(edges) == 0) {
       next
     }
-    edges <- c(edges, unlist(sapply(edges, function(n) tree@nodelist[[n]]$posts)))
+    edges <- c(edges, unlist(sapply(edges, function(n) tree@nodelist[[n]][['post']])))
     edges <- edges[edges != tree@root]
-    rngs <- getEdgesAge(tree, edges=edges)
+    rngs <- getEdgesAge(tree, ids=edges)
     bool <- rngs[ ,'max'] > end
     if(any(bool)) {
       rngs <- rngs[bool, ]

R/node-declaration.R

@@ -1,19 +1,20 @@
 .newNode <- function(tree, node) {
   node <- tree@nodelist[[node]]
-  if(is.null(node$span) | !tree@wspn) {
+  if(is.null(node[['span']]) | !tree@wspn) {
     span <- numeric()
   } else {
-    span <- node$span
+    span <- node[['span']]
   }
   if(length(tree@age) > 0) {
-    age <- tree@age - node$predist
+    age <- tree@age - node[['predist']]
   } else {
     age <- numeric()
   }
-  new('Node', id=node$id, span=span, pre=as.character(node$pre),
-     post=as.character(node$post), children=as.character(node$children),
-     nchildren=length(as.character(node$children)), pd=node$pd, predist=node$predist,
-     root=tree@root == node$id, age=age, tip=length(node$post) == 0)
+  new('Node', id=node[['id']], span=span, pre=as.character(node[['pre']]),
+     post=as.character(node[['post']]), children=as.character(node[['children']]),
+     nchildren=length(as.character(node[['children']])), pd=node[['pd']],
+     predist=node[['predist']], root=tree@root == node[['id']],
+     age=age, tip=length(node[['post']]) == 0)
 }
 
 setClass ('Node', representation=representation (