[Phylobase-commits] r350 - pkg/R

[noreply at r-forge.r-project.org]

Author: skembel
Date: 2008-12-19 23:00:00 +0100 (Fri, 19 Dec 2008)
New Revision: 350

Modified:
   pkg/R/checkdata.R
   pkg/R/methods-phylo4.R
   pkg/R/setAs-Methods.R
   pkg/R/treestruc.R
Log:
Minor change to the way polytomies are detected in summary method

Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R	2008-12-19 21:30:21 UTC (rev 349)
+++ pkg/R/checkdata.R	2008-12-19 22:00:00 UTC (rev 350)
@@ -10,9 +10,7 @@
     if (hasEdgeLength(object) && length(object at edge.length) != N)
       return("edge lengths do not match number of edges")
     ## if (length(object at tip.label)+object at Nnode-1 != N) # does not work with multifurcations
-    ##  return("number of tip labels not consistent with number of edges and nodes")
-    ## check: internal node numbers = 1:m
-    
+    ##  return("number of tip labels not consistent with number of edges and nodes")    
     ## check: tip numbers = (m+1):(m+n)
     ntips <- nTips(object)
     if(length(object at tip.label) != ntips)
@@ -24,12 +22,11 @@
     if (!(all(tips==1:ntips) && all(nodes=(ntips+1):(ntips+length(intnodes)))))
       return("tips and nodes incorrectly numbered")
     nAncest <- tabulate(E[, 2],nbins=max(nodes)) ## bug fix from Jim Regetz
-    ## fixme SWK the following all broke due to undoc'd edge matrix assumptions
-    ## fixme SWK commenting out most for now until we document these formally
     nDesc <- tabulate(na.omit(E[,1]))
     nTips <- sum(nDesc==0)
-    ##if (!all(nDesc[1:nTips]==0))
-    ##  return("nodes 1 to nTips must all be tips")
+    if (!all(nDesc[1:nTips]==0))
+      return("nodes 1 to nTips must all be tips")
+    ##fixme following check fails for unrooted trees
     ##if (!all(nDesc[(nTips+1):(nTips+nNodes(object))]>0))
     ##  return("nodes (nTips+1) to (nTips+nNodes) must all be internal nodes")
     if (any(nDesc>2)) {

Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R	2008-12-19 21:30:21 UTC (rev 349)
+++ pkg/R/methods-phylo4.R	2008-12-19 22:00:00 UTC (rev 350)
@@ -41,15 +41,9 @@
 })
 
 setMethod("isRooted","phylo4", function(x) {
-
     ## hack to avoid failure on an empty object
     if(nTips(x) == 0) return(FALSE)
-    ## HACK: make sure we find the right "nTips"
-    ## fixme SWK maybe broken after explicit root node addition?
-
     any(is.na(edges(x)[,1]))
-    ## fixme: fails with empty tree?
-    ## fixme - may fail with explicit root node in edge matrix
 })
 
 setMethod("nodeType", "phylo4", function(phy) {
@@ -267,8 +261,8 @@
         res$sumry.el <- NULL
     }
 
-    ## polytomies
-    if(hasPoly(x)){ # if there are polytomies
+    ## check for polytomies
+    if (any(tabulate(na.omit(edges(object)[,1]))>2)){ # if there are polytomies
         E <- edges(x)
         temp <- tabulate(na.omit(E[,1]))
         degree <- temp[na.omit(E[,1])] # contains the degree of the ancestor for all edges

Modified: pkg/R/setAs-Methods.R
===================================================================
--- pkg/R/setAs-Methods.R	2008-12-19 21:30:21 UTC (rev 349)
+++ pkg/R/setAs-Methods.R	2008-12-19 22:00:00 UTC (rev 350)
@@ -1,10 +1,9 @@
 #######################################################
 ## Importing from ape
 setAs("phylo", "phylo4", function(from, to) {
-    #fixme SWK kludgy fix to add root to an ape edge matrix
+    #fixme SWK kludgy fix may not work well with unrooted trees
     if (is.rooted(from)) {
         root.edge <- as.numeric(setdiff(unique(from$edge[,1]), unique(from$edge[,2])))
-        #fix - figure out node id of edge
         from$edge <- rbind(from$edge,c(NA,root.edge))
         if (!is.null(from$edge.length)) {
             if (is.null(from$root.edge)) {

Modified: pkg/R/treestruc.R
===================================================================
--- pkg/R/treestruc.R	2008-12-19 21:30:21 UTC (rev 349)
+++ pkg/R/treestruc.R	2008-12-19 22:00:00 UTC (rev 350)
@@ -4,8 +4,7 @@
 ##  and that it's simple enough to do
 ##   any(edgeLength(x)==0) if necessary
 hasPoly <- function(object) {
-  #fixme SWK why was this a call to check_phylo4 instead of just checking class?
-  #if(!check_phylo4(object)) stop("to be used with a phylo4 object")
+  if(!check_phylo4(object)) stop("to be used with a phylo4 object")
   degree <- tabulate(edges(object)[, 2])
   struc <- any(degree > 2)
   return(struc)