From noreply at r-forge.r-project.org Sun Mar 9 22:29:07 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 9 Mar 2014 22:29:07 +0100 (CET) Subject: [Phylobase-commits] r854 - pkg/R Message-ID: <20140309212907.3843E186DAA@r-forge.r-project.org> Author: francois Date: 2014-03-09 22:29:06 +0100 (Sun, 09 Mar 2014) New Revision: 854 Modified: pkg/R/treewalk.R Log: clean up/make faster getNode code Modified: pkg/R/treewalk.R =================================================================== --- pkg/R/treewalk.R 2014-02-13 16:20:11 UTC (rev 853) +++ pkg/R/treewalk.R 2014-03-09 21:29:06 UTC (rev 854) @@ -22,39 +22,33 @@ names(rval) <- character(0) return(rval) } - + + lblTmp <- labels(x, type) + ## match node to tree if (is.character(node)) { - ndTmp <- paste("^\\Q", node, "\\E$", sep="") + ndTmp <- paste("^\\Q", node, "\\E$", sep="") irval <- lapply(ndTmp, function(ND) { - xx <- grep(ND, labels(x, type), perl=TRUE) - if (length(xx) == 0) 0 - else xx - }) + grep(ND, lblTmp, perl=TRUE) + }) + irvalL <- sapply(irval, length) + irval[irvalL == 0] <- 0 irval <- unlist(irval) } else if (is.numeric(node) && all(floor(node) == node, na.rm=TRUE)) { - irval <- match(as.character(node), names(labels(x, type))) + irval <- match(as.character(node), names(lblTmp)) } else { stop("Node must be a vector of class \'integer\' or \'character\'.") } ## node numbers - rval <- names(labels(x, type))[irval] - - ## root ancestor gets special treatment - isRoot <- ifelse(length(node) > 0, - sapply(node, function(nd) identical(nd, 0)), - logical(0)) - rval[isRoot] <- NA - rval[is.na(node)] <- NA # return NA for any NA_character_ inputs + rval <- names(lblTmp)[irval] + rval[is.na(node)] <- NA # return NA for any NA_character_ inputs, not needed but ensure rval has correct length rval <- as.integer(rval) ## node labels - nmNd <- labels(x, type)[irval] - + nmNd <- lblTmp[irval] names(rval) <- nmNd - names(rval)[rval == 0] <- "0" # root ancestor gets special treatment - + ## deal with nodes that don't match if (any(is.na(rval))) { missnodes <- node[is.na(rval)] @@ -81,7 +75,7 @@ children <- function(phy,node) { node2 <- getNode(phy,node) r <- which(edges(phy)[,1]==node2) - return(getNode(phy,edges(phy)[r,2])) + getNode(phy,edges(phy)[r,2]) } ## get descendants [recursively] @@ -96,6 +90,8 @@ if (type == "children") { res <- lapply(node, function(x) children(phy, x)) + ## if just a single node, return as a single vector + if (length(res)==1) res <- res[[1]] } else { ## edge matrix must be in preorder for the C function! if (phy at order=="preorder") { @@ -119,13 +115,12 @@ if (type=="tips") { isDes[descendant %in% nodeId(phy, "internal"),] <- FALSE } - res <- lapply(seq_along(node), function(n) getNode(phy, - descendant[isDes[,n]])) + ## res <- lapply(seq_along(node), function(n) getNode(phy, + ## descendant[isDes[,n]])) + res <- getNode(phy, descendant[isDes[, seq_along(node)]]) } - names(res) <- as.character(oNode[isValid]) + ## names(res) <- as.character(oNode[isValid]) - ## if just a single node, return as a single vector - if (length(res)==1) res <- res[[1]] res ## Original pure R implementation of the above From noreply at r-forge.r-project.org Sun Mar 9 22:29:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 9 Mar 2014 22:29:44 +0100 (CET) Subject: [Phylobase-commits] r855 - pkg/src Message-ID: <20140309212944.D26AB186DAB@r-forge.r-project.org> Author: francois Date: 2014-03-09 22:29:44 +0100 (Sun, 09 Mar 2014) New Revision: 855 Modified: pkg/src/checkPhylo4.cpp Log: removed use of iterator that made R crash with phylotorture. Modified: pkg/src/checkPhylo4.cpp =================================================================== --- pkg/src/checkPhylo4.cpp 2014-03-09 21:29:06 UTC (rev 854) +++ pkg/src/checkPhylo4.cpp 2014-03-09 21:29:44 UTC (rev 855) @@ -1,3 +1,4 @@ +// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- #include #include // std::cout @@ -47,10 +48,12 @@ //[[Rcpp::export]] std::vector tabulateTips (Rcpp::IntegerVector ances) { // tabulates ancestor nodes that are not the root. - int n = ances.size(); + int n = Rcpp::max(ances); std::vector ans(n); - for (Rcpp::IntegerVector::iterator it = ances.begin(); it != ances.end(); ++it) { - if (*it > 0) ans[*it - 1]++; + for (int i=0; i < n; i++) { + if (i > 0) { + ans[i - 1]++; + } } return ans; } From noreply at r-forge.r-project.org Sun Mar 9 22:31:45 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 9 Mar 2014 22:31:45 +0100 (CET) Subject: [Phylobase-commits] r856 - pkg/tests Message-ID: <20140309213145.C8E13186DD2@r-forge.r-project.org> Author: francois Date: 2014-03-09 22:31:45 +0100 (Sun, 09 Mar 2014) New Revision: 856 Added: pkg/tests/phylotorture.Rout.save Removed: pkg/tests/phylotorture.Rout.save Modified: pkg/tests/phylotorture.R Log: update phylotorture output. Modified: pkg/tests/phylotorture.R =================================================================== --- pkg/tests/phylotorture.R 2014-03-09 21:29:44 UTC (rev 855) +++ pkg/tests/phylotorture.R 2014-03-09 21:31:45 UTC (rev 856) @@ -11,8 +11,8 @@ e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2) p1[[i]] <- try(phylo4(e),silent=TRUE) } -OKvals <- sapply(p1,class)!="try-error" -table(sapply(p1[!OKvals],as.character)) +OKvals <- sapply(p1, class) != "try-error" +table(sapply(p1[!OKvals], as.character)) if (any(OKvals)) { p2 <- p1[OKvals] Deleted: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save 2014-03-09 21:29:44 UTC (rev 855) +++ pkg/tests/phylotorture.Rout.save 2014-03-09 21:31:45 UTC (rev 856) @@ -1,217 +0,0 @@ - -R Under development (unstable) (2013-04-25 r62670) -- "Unsuffered Consequences" -Copyright (C) 2013 The R Foundation for Statistical Computing -Platform: i686-pc-linux-gnu (32-bit) - -R is free software and comes with ABSOLUTELY NO WARRANTY. -You are welcome to redistribute it under certain conditions. -Type 'license()' or 'licence()' for distribution details. - - Natural language support but running in an English locale - -R is a collaborative project with many contributors. -Type 'contributors()' for more information and -'citation()' on how to cite R or R packages in publications. - -Type 'demo()' for some demos, 'help()' for on-line help, or -'help.start()' for an HTML browser interface to help. -Type 'q()' to quit R. - -> ## torture-testing phylo4 objects. -> require(phylobase) -Loading required package: phylobase -Loading required package: grid -Loading required package: ape -Loading required package: Rcpp - -Attaching package: ?phylobase? - -The following object is masked from ?package:ape?: - - edges - -> set.seed(1001) -> p1 <- list() -> n <- 10 -> ## don't want to slow down R CMD check by doing this every time: -> ## n <- 10000 -> for (i in 1:n) { -+ ## e2 <- c(sample(1:5,replace=FALSE,size=5),sample(6:10,replace=FALSE,size=5)) -+ ## e1 <- sample(6:10,replace=TRUE -+ e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2) -+ p1[[i]] <- try(phylo4(e),silent=TRUE) -+ } -There were 13 warnings (use warnings() to see them) -> OKvals <- sapply(p1,class)!="try-error" -> table(sapply(p1[!OKvals],as.character)) - - Error in .local(x, ...) : \n tips and nodes incorrectly numbered, All tips must have associated tip labels. Use tipLabels<- (and nodeLabels<- if needed) to update them., One or more tip/node label has an unmatched ID name Use tipLabels<- (and nodeLabels<- if needed) to update them.\n - 1 - Error in .local(x, ...) : \n tips and nodes incorrectly numbered, nodes 1 to nTips must all be tips, nodes (nTips+1) to (nTips+nNodes) must all be internal nodes, All tips must have associated tip labels. Use tipLabels<- (and nodeLabels<- if needed) to update them.\n - 1 -Error in .local(x, ...) : \n tips and nodes incorrectly numbered, nodes 1 to nTips must all be tips, nodes (nTips+1) to (nTips+nNodes) must all be internal nodes, All tips must have associated tip labels. Use tipLabels<- (and nodeLabels<- if needed) to update them., One or more tip/node label has an unmatched ID name Use tipLabels<- (and nodeLabels<- if needed) to update them.\n - 7 - Error in .local(x, ...) : \n tips and nodes incorrectly numbered, nodes 1 to nTips must all be tips, nodes (nTips+1) to (nTips+nNodes) must all be internal nodes, One or more tip/node label has an unmatched ID name Use tipLabels<- (and nodeLabels<- if needed) to update them.\n - 1 -> -> if (any(OKvals)) { -+ p2 <- p1[OKvals] -+ length(p2) -+ has.poly <- sapply(p2,hasPoly) -+ has.sing <- sapply(p2,hasSingle) -+ has.retic <- sapply(p2,hasRetic) -+ ## -+ if (any(has.sing)) { -+ p4 <- p2[has.sing] -+ plot(p4[[1]]) ## gives descriptive error -+ t2 <- try(plot(collapse.singles(as(p2[[1]],"phylo")))) -+ ## "incorrect number of dimensions" -+ } -+ if (any(!has.sing)) { -+ ## first tree without singles -- HANGS! -+ ## don't try the plot in an R session you care about ... -+ p3 <- p2[!has.sing] -+ ## plot(p2[[13]]) -+ } -+ } -> -> ## elements 8 and 34 are -> ## what SHOULD the rules for trees be? -> -> ## (a) reduce node numbers to 1 ... N ? -> ## (b) check: irreducible, non-cyclic, ... ? -> -> ## convert to matrix format for checking? -> -> reduce_nodenums <- function(e) { -+ matrix(as.numeric(factor(e)),ncol=2) -+ } -> -> # make an illegal phylo4 object, does it pass checks? -> # a disconnected node: -> -> t1 <- read.tree (text="((a,b), (c,(d, e)));") -> plot(t1) -> -> broke1 <- t1 -> broke1$edge[broke1$edge[,2] ==9, 1] <- 9 # disconnect the node, two subtrees, ((a, b), c) and (d,e) -> -> try(as(broke1, "phylo4") -> tree, silent=TRUE) # makes a phylo4 object with no warning -Warning messages: -1: In checkTree(object) : tree contains singleton nodes -2: In checkTree(object) : tree contains singleton nodes -3: In checkTree(object) : tree contains singleton nodes -> try(phylo4(broke1$edge), silent=TRUE) # constructor makes a phylo4 object with no warning - label node ancestor edge.length node.type -1 T1 1 7 NA tip -2 T2 2 7 NA tip -3 T3 3 8 NA tip -4 T4 4 9 NA tip -5 T5 5 9 NA tip -6 6 0 NA internal -7 7 6 NA internal -8 8 6 NA internal -9 9 9 NA internal -Warning messages: -1: In checkTree(object) : tree contains singleton nodes -2: In checkTree(object) : tree contains singleton nodes -> ## error message comes from ape, not phylo? -- AND -> ## error is about singles, not disconnected nodes -> ## print(try(plot(tree), silent=TRUE )) ## pdc couldn't get this to work, so temporarily commenting -> -> # root node value != ntips + 1: -> -> broke2 <- t1 -> broke2$edge[broke2$edge==6] <- 10 -> -> ## warning, but no error -> ## plot(broke2) ## seems to hang R CMD check?? -> ## generates error, but it's about wrong number of tips, not wrong value at root. -> print(try(as(broke2, "phylo4"), silent=TRUE)) -[1] "Error in .createLabels(value = tip.label, ntips = ntips, nnodes = nnodes, : \n Number of labels does not match number of nodes.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> ## error regarding number of tip labels vs edges and nodes -> print(try(phylo4(broke2$edge), silent=TRUE)) -[1] "Error in .local(x, ...) : \n tips and nodes incorrectly numbered, One or more tip/node label has an unmatched ID name Use tipLabels<- (and nodeLabels<- if needed) to update them.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -Warning message: -In tips == 1:ntips : - longer object length is not a multiple of shorter object length -> -> # switch root node value (6) with next internal node (7): -> -> broke3 <- broke2 -> broke3$edge[broke3$edge==7] <- 6 -> broke3$edge[broke3$edge==10] <- 7 -> -> ## both of the following now fail with -> ## "root node is not at position (nTips+1) -> try(as(broke3,"phylo4") -> tree3) # works with no error message -> try(phylo4(broke3$edge)) # works with no error message - label node ancestor edge.length node.type -1 T1 1 6 NA tip -2 T2 2 6 NA tip -3 T3 3 8 NA tip -4 T4 4 9 NA tip -5 T5 5 9 NA tip -6 6 7 NA internal -7 7 0 NA internal -8 8 7 NA internal -9 9 8 NA internal -> ## plot(tree3) # would work if we could create it? -> -> -> # tips have larger numbers than root node: -> -> broke4 <- t1 -> broke4$edge[broke4$edge==1] <- 11 -> broke4$edge[broke4$edge==2] <- 12 -> broke4$edge[broke4$edge==3] <- 13 -> broke4$edge[broke4$edge==4] <- 14 -> broke4$edge[broke4$edge==5] <- 15 -> -> print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root -[1] "Error in .local(x, ...) : \n tips and nodes incorrectly numbered, All tips must have associated tip labels. Use tipLabels<- (and nodeLabels<- if needed) to update them., One or more tip/node label has an unmatched ID name Use tipLabels<- (and nodeLabels<- if needed) to update them.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root -[1] "Error in .local(x, ...) : \n tips and nodes incorrectly numbered, All tips must have associated tip labels. Use tipLabels<- (and nodeLabels<- if needed) to update them., One or more tip/node label has an unmatched ID name Use tipLabels<- (and nodeLabels<- if needed) to update them.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> # print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG! -> -> ### -> foo <- new('phylo4') -> set.seed(1001) -> foo at edge <- rcoal(10)$edge -> print(try(plot(foo))) -Error in treePlot(x, ...) : treePlot function requires a rooted tree. -[1] "Error in treePlot(x, ...) : treePlot function requires a rooted tree.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> -> foo at label <- c(rep('blah',10), rep("",9)) -> -> ##### -> ## tree with only 2 tips: will fail under previous versions -> ## with "Error in if (which(nAncest == 0) != nTips + 1) { : -> ## argument is of length zero" -> -> edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2) -> try(p2 <- phylo4(edge), silent=TRUE) -> -> proc.time() - user system elapsed - 1.996 2.228 4.109 Added: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save (rev 0) +++ pkg/tests/phylotorture.Rout.save 2014-03-09 21:31:45 UTC (rev 856) @@ -0,0 +1,220 @@ + +R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" +Copyright (C) 2013 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) + +R is free software and comes with ABSOLUTELY NO WARRANTY. +You are welcome to redistribute it under certain conditions. +Type 'license()' or 'licence()' for distribution details. + + Natural language support but running in an English locale + +R is a collaborative project with many contributors. +Type 'contributors()' for more information and +'citation()' on how to cite R or R packages in publications. + +Type 'demo()' for some demos, 'help()' for on-line help, or +'help.start()' for an HTML browser interface to help. +Type 'q()' to quit R. + +> ## torture-testing phylo4 objects. +> require(phylobase) +Loading required package: phylobase +Loading required package: grid +Loading required package: ape +Loading required package: Rcpp + +Attaching package: ?phylobase? + +The following object is masked from ?package:ape?: + + edges + +> set.seed(1001) +> p1 <- list() +> n <- 10 +> ## don't want to slow down R CMD check by doing this every time: +> ## n <- 10000 +> for (i in 1:n) { ++ ## e2 <- c(sample(1:5,replace=FALSE,size=5),sample(6:10,replace=FALSE,size=5)) ++ ## e1 <- sample(6:10,replace=TRUE ++ e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2) ++ p1[[i]] <- try(phylo4(e),silent=TRUE) ++ } +Warning messages: +1: In checkTree(object) : Tree contains singleton nodes. +2: In checkTree(object) : Tree contains singleton nodes. +3: In checkTree(object) : Tree contains singleton nodes. +4: In checkTree(object) : Tree contains singleton nodes. +5: In checkTree(object) : Tree contains singleton nodes. +6: In checkTree(object) : Tree contains singleton nodes. +7: In checkTree(object) : Tree contains singleton nodes. +8: In checkTree(object) : Tree contains singleton nodes. +> OKvals <- sapply(p1, class) != "try-error" +> table(sapply(p1[!OKvals], as.character)) + + Error in .local(x, ...) : Nodes incorrectly labeled. \n + 1 + Error in .local(x, ...) : \n Tips incorrectly labeled. Nodes incorrectly labeled. \n + 7 +Error in names(res) <- switch(type, tip = 1:ntips, internal = seq(from = ntips + : \n 'names' attribute [2] must be the same length as the vector [1]\n + 2 +> +> if (any(OKvals)) { ++ p2 <- p1[OKvals] ++ length(p2) ++ has.poly <- sapply(p2,hasPoly) ++ has.sing <- sapply(p2,hasSingle) ++ has.retic <- sapply(p2,hasRetic) ++ ## ++ if (any(has.sing)) { ++ p4 <- p2[has.sing] ++ plot(p4[[1]]) ## gives descriptive error ++ t2 <- try(plot(collapse.singles(as(p2[[1]],"phylo")))) ++ ## "incorrect number of dimensions" ++ } ++ if (any(!has.sing)) { ++ ## first tree without singles -- HANGS! ++ ## don't try the plot in an R session you care about ... ++ p3 <- p2[!has.sing] ++ ## plot(p2[[13]]) ++ } ++ } +> +> ## elements 8 and 34 are +> ## what SHOULD the rules for trees be? +> +> ## (a) reduce node numbers to 1 ... N ? +> ## (b) check: irreducible, non-cyclic, ... ? +> +> ## convert to matrix format for checking? +> +> reduce_nodenums <- function(e) { ++ matrix(as.numeric(factor(e)),ncol=2) ++ } +> +> # make an illegal phylo4 object, does it pass checks? +> # a disconnected node: +> +> t1 <- read.tree (text="((a,b), (c,(d, e)));") +> plot(t1) +> +> broke1 <- t1 +> broke1$edge[broke1$edge[,2] ==9, 1] <- 9 # disconnect the node, two subtrees, ((a, b), c) and (d,e) +> +> try(as(broke1, "phylo4") -> tree, silent=TRUE) # makes a phylo4 object with no warning +Warning messages: +1: In checkTree(object) : Tree contains singleton nodes. +2: In checkTree(object) : Tree contains singleton nodes. +3: In checkTree(object) : Tree contains singleton nodes. +> try(phylo4(broke1$edge), silent=TRUE) # constructor makes a phylo4 object with no warning + label node ancestor edge.length node.type +1 T1 1 7 NA tip +2 T2 2 7 NA tip +3 T3 3 8 NA tip +4 T4 4 9 NA tip +5 T5 5 9 NA tip +6 6 0 NA internal +7 7 6 NA internal +8 8 6 NA internal +9 9 9 NA internal +Warning messages: +1: In checkTree(object) : Tree contains singleton nodes. +2: In checkTree(object) : Tree contains singleton nodes. +> ## error message comes from ape, not phylo? -- AND +> ## error is about singles, not disconnected nodes +> ## print(try(plot(tree), silent=TRUE )) ## pdc couldn't get this to work, so temporarily commenting +> +> # root node value != ntips + 1: +> +> broke2 <- t1 +> broke2$edge[broke2$edge==6] <- 10 +> +> ## warning, but no error +> ## plot(broke2) ## seems to hang R CMD check?? +> ## generates error, but it's about wrong number of tips, not wrong value at root. +> print(try(as(broke2, "phylo4"), silent=TRUE)) +[1] "Error in .createLabels(value = tip.label, ntips = ntips, nnodes = nnodes, : \n Number of labels does not match number of nodes.\n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> ## error regarding number of tip labels vs edges and nodes +> print(try(phylo4(broke2$edge), silent=TRUE)) +[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> +> # switch root node value (6) with next internal node (7): +> +> broke3 <- broke2 +> broke3$edge[broke3$edge==7] <- 6 +> broke3$edge[broke3$edge==10] <- 7 +> +> ## both of the following now fail with +> ## "root node is not at position (nTips+1) +> try(as(broke3,"phylo4") -> tree3) # works with no error message +> try(phylo4(broke3$edge)) # works with no error message + label node ancestor edge.length node.type +1 T1 1 6 NA tip +2 T2 2 6 NA tip +3 T3 3 8 NA tip +4 T4 4 9 NA tip +5 T5 5 9 NA tip +6 6 7 NA internal +7 7 0 NA internal +8 8 7 NA internal +9 9 8 NA internal +> ## plot(tree3) # would work if we could create it? +> +> +> # tips have larger numbers than root node: +> +> broke4 <- t1 +> broke4$edge[broke4$edge==1] <- 11 +> broke4$edge[broke4$edge==2] <- 12 +> broke4$edge[broke4$edge==3] <- 13 +> broke4$edge[broke4$edge==4] <- 14 +> broke4$edge[broke4$edge==5] <- 15 +> +> print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root +[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root +[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> # print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG! +> +> ### +> foo <- new('phylo4') +> set.seed(1001) +> foo at edge <- rcoal(10)$edge +> print(try(plot(foo))) +Error in treePlot(x, ...) : treePlot function requires a rooted tree. +[1] "Error in treePlot(x, ...) : treePlot function requires a rooted tree.\n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> +> foo at label <- c(rep('blah',10), rep("",9)) +> +> ##### +> ## tree with only 2 tips: will fail under previous versions +> ## with "Error in if (which(nAncest == 0) != nTips + 1) { : +> ## argument is of length zero" +> +> edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2) +> try(p2 <- phylo4(edge), silent=TRUE) +> +> proc.time() + user system elapsed + 5.551 0.181 5.773 From noreply at r-forge.r-project.org Mon Mar 10 00:31:03 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 10 Mar 2014 00:31:03 +0100 (CET) Subject: [Phylobase-commits] r857 - pkg/src Message-ID: <20140309233103.84CC7186C51@r-forge.r-project.org> Author: francois Date: 2014-03-10 00:31:00 +0100 (Mon, 10 Mar 2014) New Revision: 857 Modified: pkg/src/checkPhylo4.cpp pkg/src/symbols.rds Log: fix tabulateTips in C++ code (was wrong version of file). Modified: pkg/src/checkPhylo4.cpp =================================================================== --- pkg/src/checkPhylo4.cpp 2014-03-09 21:31:45 UTC (rev 856) +++ pkg/src/checkPhylo4.cpp 2014-03-09 23:31:00 UTC (rev 857) @@ -50,9 +50,10 @@ // tabulates ancestor nodes that are not the root. int n = Rcpp::max(ances); std::vector ans(n); - for (int i=0; i < n; i++) { - if (i > 0) { - ans[i - 1]++; + for (int i=0; i < ances.size(); i++) { + int j = ances[i]; + if (j > 0) { + ans[j - 1]++; } } return ans; Modified: pkg/src/symbols.rds =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Mon Mar 10 05:10:30 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 10 Mar 2014 05:10:30 +0100 (CET) Subject: [Phylobase-commits] r858 - in pkg: . inst/unitTests tests tests/testthat Message-ID: <20140310041030.6D8AF184FD7@r-forge.r-project.org> Author: francois Date: 2014-03-10 05:10:29 +0100 (Mon, 10 Mar 2014) New Revision: 858 Added: pkg/tests/test-all.R pkg/tests/testthat/ pkg/tests/testthat/test.badnex.R pkg/tests/testthat/test.methods-phylo4.R pkg/tests/testthat/test.treewalk.R Removed: pkg/inst/unitTests/runit.badnex.R pkg/inst/unitTests/runit.methods-phylo4d.R pkg/inst/unitTests/runit.treewalk.R Modified: pkg/DESCRIPTION Log: starting to switch unit tests to testthat. Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2014-03-09 23:31:00 UTC (rev 857) +++ pkg/DESCRIPTION 2014-03-10 04:10:29 UTC (rev 858) @@ -1,13 +1,14 @@ Package: phylobase Type: Package Title: Base package for phylogenetic structures and comparative data -Version: 0.6.6 -Date: 2014-02-11 +Version: 0.6.7 +Date: 2014-03-10 Depends: methods, grid, ape(>= 2.1), - Rcpp (>= 0.11.0) + Rcpp (>= 0.11.0), + testthat (>= 0.8.1) Imports: ade4 LinkingTo: Rcpp Suggests: Deleted: pkg/inst/unitTests/runit.badnex.R =================================================================== --- pkg/inst/unitTests/runit.badnex.R 2014-03-09 23:31:00 UTC (rev 857) +++ pkg/inst/unitTests/runit.badnex.R 2014-03-10 04:10:29 UTC (rev 858) @@ -1,16 +0,0 @@ -# -# --- Test badnex.R --- -# - -if (Sys.getenv("RCMDCHECK") == FALSE) { - pth <- file.path(getwd(), "..", "inst", "nexusfiles") -} else { - pth <- system.file(package="phylobase", "nexusfiles") -} - -badFile <- file.path(pth, "badnex.nex") - -test.checkTree <- function() { - checkException(readNexus(file=badFile)) -} - Deleted: pkg/inst/unitTests/runit.methods-phylo4d.R =================================================================== --- pkg/inst/unitTests/runit.methods-phylo4d.R 2014-03-09 23:31:00 UTC (rev 857) +++ pkg/inst/unitTests/runit.methods-phylo4d.R 2014-03-10 04:10:29 UTC (rev 858) @@ -1,188 +0,0 @@ -# -# --- Test methods-phylo4d.R --- -# - -# create phylo4 object with a full complement of valid slots -ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9)) -descendant <- as.integer(c(7,1,2,8,3,6,9,4,5)) -edge <- cbind(ancestor, descendant) -nid.tip <- 1:5 -nid.int <- 6:9 -nid.all <- c(nid.tip, nid.int) -lab.tip <- paste("t", nid.tip, sep="") -lab.int <- paste("n", nid.int, sep="") -lab.all <- c(lab.tip, lab.int) -elen <- descendant/10 -elab <- paste("e", ancestor, descendant, sep="-") -phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int, - edge.length=elen, edge.label=elab) - -# now create phylo4d by adding data (with node IDs as row.names) -allDt <- data.frame(a=letters[nid.all], b=10*nid.all) -tipDt <- data.frame(c=letters[nid.tip], d=10*nid.tip) -nodDt <- data.frame(c=letters[nid.int], e=10*nid.int) -row.names(allDt) <- nid.all -row.names(tipDt) <- nid.tip -row.names(nodDt) <- nid.int -phyd <- phylo4d(phy, tip.data=tipDt, node.data=nodDt, all.data=allDt, - match.data=TRUE, merge.data=TRUE) - -# create altered version such that each slot is out of order with -# respect to all others; methods should be able to handle this -phyd.alt <- phyd -phyd.alt at label <- rev(phyd at label) -phyd.alt at edge <- phyd at edge[c(6:9, 1:5), ] -phyd.alt at edge.length <- phyd at edge.length[c(7:9, 1:6)] -phyd.alt at edge.label <- phyd at edge.label[c(8:9, 1:7)] -nid.tip.r <- c(2,5,4,3,1) -nid.int.r <- c(8,7,9,6) -nid.all.r <- c(nid.tip.r, nid.int.r) -phyd.alt at data <- phyd at data[rank(nid.all.r), ] - -# for comparisons, manually create expected "all" trait data.frame -m1 <- merge(allDt, rbind(tipDt["c"], nodDt["c"]), by=0, all=TRUE) -m2 <- merge(tipDt["d"], nodDt["e"], by=0, all=TRUE) -eAllDt <- merge(m1, m2, by="Row.names", all=TRUE)[-1] -row.names(eAllDt) <- lab.all - -# for comparisons, manually create expected "tip" trait data.frame -m1 <- merge(allDt, rbind(tipDt["c"], nodDt["c"]), by=0, all=TRUE) -m2 <- merge(tipDt["d"], nodDt["e"], by=0, all=TRUE) -eTipDt <- merge(m1, m2, by="Row.names", all=TRUE)[nid.tip, -1] -row.names(eTipDt) <- lab.tip - -# manually create expected tip trait data.frame -m1 <- merge(allDt, rbind(tipDt["c"], nodDt["c"]), by=0, all=TRUE) -m2 <- merge(tipDt["d"], nodDt["e"], by=0, all=TRUE) -eNodDt <- merge(m1, m2, by="Row.names", all=TRUE)[nid.int, -1] -row.names(eNodDt) <- lab.int - -#----------------------------------------------------------------------- - -test.tdata.phylo4d <- function() { - # function(x, type=c("tip", "internal", "allnode"), - # label.type=c("row.names","column"), empty.columns=TRUE, ...) - - # check basic tdata usage - checkIdentical(tdata(phyd.alt, type="tip"), eTipDt) - checkIdentical(tdata(phyd.alt, type="internal"), eNodDt) - checkIdentical(tdata(phyd.alt, type="all"), eAllDt) - - # label.type="row.names" - tmpDt <- data.frame(eAllDt[nid.tip, -5, ], row.names=lab.tip) - checkIdentical(tdata(phyd.alt, type="tip", label.type="row.names", - empty.columns=FALSE), data.frame(tmpDt[nid.tip,], row.names=lab.tip)) - # label.type="column" - tmpDt <- data.frame(label=lab.tip, eAllDt[nid.tip, -5, ], - row.names=as.character(nid.tip)) - checkIdentical(tdata(phyd.alt, type="tip", label.type="column", - empty.columns=FALSE), tmpDt) - - # keep empty.columns - checkIdentical(tdata(phyd.alt, type="tip", empty.columns=TRUE), - eAllDt[nid.tip,]) - - # - # misc tests - # - - # check with other tree orderings - phyd.pre <- reorder(phyd.alt, "preorder") - checkIdentical(tdata(phyd.pre, "all", empty.columns=FALSE), eAllDt) - phyd.post <- reorder(phyd.alt, "postorder") - checkIdentical(tdata(phyd.post, "all", empty.columns=FALSE), eAllDt) - -} - -## currently just basic tests of tdata replacement; using out-of-order -## data, but only with default args (e.g. row.name-nodeID matching) -## ... formatData unit tests should be sufficient for the rest -test.Replace.tdata.phylo4d <- function() { - - ## replace data, labels are row names - tdata(phyd.alt, "all") <- allDt[rank(nid.all.r), , drop=FALSE] - checkIdentical(tdata(phyd.alt, type="all"), data.frame(allDt, - row.names=lab.all)) - - ## replace data with empty data frame - tdata(phyd.alt) <- data.frame() - checkIdentical(tdata(phyd.alt), data.frame(row.names=lab.all)) - - ## same as first test, but leaving out default 'all' type - tdata(phyd.alt) <- allDt[rank(nid.all.r), , drop=FALSE] - checkIdentical(tdata(phyd.alt), data.frame(allDt, - row.names=lab.all)) - -} - -test.tipData.phylo4d <- function() { - # label.type="row.names" - checkIdentical(tipData(phyd.alt, label.type="row.names", - empty.columns=FALSE), eTipDt[-5]) - # label.type="column" - tmpDt <- data.frame(label=lab.tip, eTipDt[-5], - row.names=as.character(nid.tip)) - checkIdentical(tipData(phyd.alt, label.type="column", - empty.columns=FALSE), tmpDt) - - # keep empty.columns - checkIdentical(tipData(phyd.alt), eTipDt) -} - -test.Replace.tipData.phylo4d <- function() { - ## replace data with tip data only, clearing all data - tipData(phyd.alt, clear.all=TRUE) <- tipDt[rank(nid.tip.r), , - drop=FALSE] - checkIdentical(tipData(phyd.alt), data.frame(tipDt, - row.names=lab.tip)) -} - -test.nodeData.phylo4d <- function() { - - # label.type="row.names" - checkIdentical(nodeData(phyd.alt, label.type="row.names", - empty.columns=FALSE), eNodDt[-4]) - - # label.type="column" - tmpDt <- data.frame(label=lab.int, eNodDt[-4], - row.names=as.character(nid.int)) - checkIdentical(nodeData(phyd.alt, label.type="column", - empty.columns=FALSE), tmpDt) - - # keep empty.columns - checkIdentical(nodeData(phyd.alt), eNodDt) -} - -test.Replace.nodeData.phylo4d <- function() { - ## replace data with internal data only, clearing all data - nodeData(phyd.alt, clear.all=TRUE) <- nodDt[rank(nid.int.r), , - drop=FALSE] - checkIdentical(nodeData(phyd.alt), data.frame(nodDt, - row.names=lab.int)) -} - - -test.nData <- function() { - checkIdentical(nData(phyd.alt), ncol(eAllDt)) -} - -test.addData.phylo4d <- function() { - # function(x, tip.data=NULL, node.data=NULL, all.data=NULL, - # pos=c("after", "before"), merge.data=TRUE, match.data=TRUE, ...) -} - -test.addData.phylo4 <- function() { - # function(x, tip.data=NULL, node.data=NULL, all.data=NULL, - # pos=c("after", "before"), merge.data=TRUE, match.data=TRUE, ...) -} - -test.summary.phylo4d <- function() { -} - -test.hasNodeData.phylo4d <- function() { -} - -test.na.omit.phylo4d <- function() { - # function(object, ...) -} - Deleted: pkg/inst/unitTests/runit.treewalk.R =================================================================== --- pkg/inst/unitTests/runit.treewalk.R 2014-03-09 23:31:00 UTC (rev 857) +++ pkg/inst/unitTests/runit.treewalk.R 2014-03-10 04:10:29 UTC (rev 858) @@ -1,237 +0,0 @@ -# -# --- Test treewalk.R --- -# - -# Create sample phylo4 tree for testing -tr <- read.tree(text="(((spA:0.2,(spB:0.1,spC:0.1):0.15):0.5,spD:0.7):0.2,spE:1):0.4;") -phytr <- as(tr, "phylo4") - -# create phylo4 object with a full complement of valid slots -ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9)) -descendant <- as.integer(c(7,1,2,8,3,6,9,4,5)) -edge <- cbind(ancestor, descendant) -nid.tip <- 1:5 -nid.int <- 6:9 -nid.all <- c(nid.tip, nid.int) -lab.tip <- paste("t", nid.tip, sep="") -lab.int <- paste("n", nid.int, sep="") -lab.all <- c(lab.tip, lab.int) -eid <- paste(ancestor, descendant, sep="-") -elen <- descendant/10 -elab <- paste("e", eid, sep="") -phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int, - edge.length=elen, edge.label=elab) - -# create altered version such that each slot is out of order with -# respect to all others; methods should be able to handle this -phy.alt <- phy -phy.alt at label <- rev(phy at label) -phy.alt at edge <- phy at edge[c(6:9, 1:5), ] -phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)] -phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)] - -# update test targets for edge-related slots -ancestor <- ancestor[c(6:9, 1:5)] -descendant <- descendant[c(6:9, 1:5)] -edge <- cbind(ancestor, descendant) -eid <- eid[c(6:9, 1:5)] -elen <- elen[c(6:9, 1:5)] -elab <- elab[c(6:9, 1:5)] - -#----------------------------------------------------------------------- - -test.getNode <- function() { -# Note: we're not explicitly testing missing="warn" condition below; -# however, if "OK" and "fail" both work as expected, then so must "warn" - # node only has valid characters - checkEquals(getNode(phytr, "spA"), c(spA=1)) - checkEquals(getNode(phytr, c("spA", "spC")), c(spA=1, spC=3)) - - # node only has valid integers - ans <- 4 - names(ans) <- "spD" - checkEquals(getNode(phytr, 4), ans) - ans <- c(4,6) - names(ans) <- c("spD", NA) - checkEquals(getNode(phytr, c(4,6)), ans) - - # node includes only missing characters (names), but missing=OK - ans <- rep(NA_integer_, 2) # return values should be NA - names(ans) <- rep(NA, 2) # return values should have NA names - checkEquals(getNode(phytr, c("xxx", "yyy"), missing="OK"), ans) - # now missing = "fail" - checkException(getNode(phytr, c("xxx", "yyy"), missing="fail")) - - # node includes only missing numbers (IDs), but missing=OK - ans <- rep(NA_integer_, 3) # return values should be NA - names(ans) <- rep(NA, 3) # return values should have NA names - checkEquals(getNode(phytr, c(-9, 0, 50), missing="OK"), ans) - # now missing = "fail" - checkException(getNode(phytr, c(-9, 0, 50), missing="fail"), ans) - - # node includes NAs, but missing = "OK" - checkTrue(is.na(getNode(phytr, NA_integer_, missing="OK"))) - checkTrue(is.na(getNode(phytr, NA_character_, missing="OK"))) - - # node includes mixture of valid values and NAs - ans <- c(2, NA) - names(ans) <- c("spB", NA) - checkEquals(getNode(phytr, c("spB", NA), missing="OK"), ans) - checkEquals(getNode(phytr, c(2, NA), missing="OK"), ans) - - # node is neither integer-like nor character - checkException(getNode(phytr, 1.5)) - - # check that tip labeled as "0" works - phyTmp <- phytr - tipLabels(phyTmp)[1] <- "0" - ans <- 1 - names(ans) <- "0" - checkEquals(getNode(phyTmp, "0"), ans) -} - -test.ancestor <- function() { - # function(phy,node) -} - -test.children <- function() { - # function(phy,node) -} - -test.descendants <- function() { - # function (phy, node, type=c("tips","children","all")) - phytr <- phylo4(read.tree(text="((t3,t4),(t1,(t2,t5)));")) - - # node = tip - checkIdentical(descendants(phytr, 5), - setNames(5L, "t5")) - checkIdentical(descendants(phytr, 5, "tips"), - setNames(5L, "t5")) - checkIdentical(descendants(phytr, 5, "children"), - setNames(integer(0), character(0))) - checkIdentical(descendants(phytr, 5, "all"), - setNames(5L, "t5")) - - # node = internal - checkIdentical(descendants(phytr, 8), - setNames(c(3L, 4L, 5L), c("t1", "t2", "t5"))) - checkIdentical(descendants(phytr, 8, "tips"), - setNames(c(3L, 4L, 5L), c("t1", "t2", "t5"))) - checkIdentical(descendants(phytr, 8, "children"), - setNames(c(3L, 9L), c("t1", NA))) - checkIdentical(descendants(phytr, 8, "all"), - setNames(c(3L, 9L, 4L, 5L), c("t1", NA, "t2", "t5"))) -} - -test.siblings <- function() { - # function(phy, node, include.self=FALSE) -} - -test.ancestors <- function() { - # function (phy, node, type=c("all","parent","ALL")) -} - -test.MRCA <- function() { - # function(phy, ...) -} - -test.shortestPath <- function() { - # function(phy, node1, node2) -} - -test.getEdge <- function() { - # function(phy, node, type=c("descendant", "ancestor"), - # missing=c("warn", "OK", "fail")) - - # - # nodes as descendants - # - - # node only has valid descendants, as characters - checkIdentical(getEdge(phy.alt, "t1"), setNames("7-1", 1)) - checkIdentical(getEdge(phy.alt, c("t1", "t3")), setNames(c("7-1", - "8-3"), c(1,3))) - - # node only has valid descendants, as integers - checkIdentical(getEdge(phy.alt, 1), setNames("7-1", 1)) - checkIdentical(getEdge(phy.alt, c(1,3)), setNames(c("7-1", - "8-3"), c(1,3))) - - # node includes only missing characters (labels), but missing=OK - checkIdentical(getEdge(phy.alt, c("x", "y", "z"), missing="OK"), - setNames(rep(NA, 3), rep(NA, 3))) - # now missing = "fail" - checkException(getEdge(phy.alt, c("x", "y", "z"), missing="fail")) - - # node includes only missing numbers (IDs), but missing=OK - checkIdentical(getEdge(phy.alt, c(-9, 0, 50), missing="OK"), - setNames(rep(NA, 3), rep(NA, 3))) - # now missing = "fail" - checkException(getEdge(phy, c(-9, 0, 50), missing="fail")) - - # node includes NAs, but missing = "OK" - checkTrue(is.na(getEdge(phy, NA_integer_, missing="OK"))) - checkTrue(is.na(getEdge(phy, NA_character_, missing="OK"))) - - # node includes mixture of valid values and NAs - checkIdentical(getEdge(phy, c("t3", NA), missing="OK"), - setNames(c("8-3", NA), c(3, NA))) - checkIdentical(getEdge(phy, c(3, NA), missing="OK"), - setNames(c("8-3", NA), c(3, NA))) - - # node is neither integer-like nor character - checkException(getEdge(phy, 1.5)) - - # - # nodes as ancestors - # - - # node only has valid ancestors, as characters - checkIdentical(getEdge(phy.alt, "n6", type="ancestor"), - setNames(c("6-7", "6-8"), c(6, 6))) - checkIdentical(getEdge(phy.alt, c("n6", "n8"), type="ancestor"), - setNames(c("6-7", "6-8", "8-9", "8-3"), c(6, 6, 8, 8))) - - # node only has valid ancestors, as integers - checkIdentical(getEdge(phy.alt, 6, type="ancestor"), - setNames(c("6-7", "6-8"), c(6, 6))) - checkIdentical(getEdge(phy.alt, c(6, 8), type="ancestor"), - setNames(c("6-7", "6-8", "8-9", "8-3"), c(6, 6, 8, 8))) - - # node includes only missing characters (labels), but missing=OK - checkIdentical(getEdge(phy.alt, c("x", "y", "z"), type="ancestor", - missing="OK"), setNames(rep(NA, 3), rep(NA, 3))) - # node includes only tips (labels), but missing=OK - checkIdentical(getEdge(phy.alt, c("t1", "t3"), type="ancestor", - missing="OK"), setNames(rep(NA, 2), c(1, 3))) - # now missing = "fail" - checkException(getEdge(phy.alt, c("x", "y", "z"), missing="fail")) - checkException(getEdge(phy.alt, c("t1", "t3"), type="ancestor", - missing="fail")) - - # node includes only missing numbers (IDs), but missing=OK - checkIdentical(getEdge(phy.alt, c(-9, 0, 50), type="ancestor", - missing="OK"), setNames(rep(NA, 3), rep(NA, 3))) - # node includes only tips (labels), but missing=OK - checkIdentical(getEdge(phy.alt, c(1, 3), type="ancestor", - missing="OK"), setNames(rep(NA, 2), c(1, 3))) - # now missing = "fail" - checkException(getEdge(phy.alt, c(-9, 0, 50), missing="fail")) - checkException(getEdge(phy.alt, c(1, 3), type="ancestor", - missing="fail")) - - # node includes NAs, but missing = "OK" - checkTrue(is.na(getEdge(phy.alt, NA_integer_, type="ancestor", - missing="OK"))) - checkTrue(is.na(getEdge(phy.alt, NA_character_, type="ancestor", - missing="OK"))) - - # node includes mixture of valid values and NAs - checkIdentical(getEdge(phy.alt, c("t3", "n8", NA), type="ancestor", - missing="OK"), setNames(c(NA, "8-9", "8-3", NA), c(3, 8, 8, NA))) - checkIdentical(getEdge(phy.alt, c(3, 8, NA), type="ancestor", - missing="OK"), setNames(c(NA, "8-9", "8-3", NA), c(3, 8, 8, NA))) - -} - - Added: pkg/tests/test-all.R =================================================================== --- pkg/tests/test-all.R (rev 0) +++ pkg/tests/test-all.R 2014-03-10 04:10:29 UTC (rev 858) @@ -0,0 +1,2 @@ + +test_check("phylobase") Added: pkg/tests/testthat/test.badnex.R =================================================================== --- pkg/tests/testthat/test.badnex.R (rev 0) +++ pkg/tests/testthat/test.badnex.R 2014-03-10 04:10:29 UTC (rev 858) @@ -0,0 +1,15 @@ +# +# --- Test badnex.R --- +# + +test_that("Malformed Nexus File should not work.", { + if (Sys.getenv("RCMDCHECK") == FALSE) { + pth <- file.path(getwd(), "..", "inst", "nexusfiles") + } else { + pth <- system.file(package="phylobase", "nexusfiles") + } + badFile <- file.path(pth, "badnex.nex") + expect_error(readNexus(file=badFile)) +}) + + Added: pkg/tests/testthat/test.methods-phylo4.R =================================================================== --- pkg/tests/testthat/test.methods-phylo4.R (rev 0) +++ pkg/tests/testthat/test.methods-phylo4.R 2014-03-10 04:10:29 UTC (rev 858) @@ -0,0 +1,550 @@ +## +## --- Test methods-phylo4.R --- +## + +# create ape::phylo version of a simple tree for testing +nwk <- "((t1:0.1,t2:0.2)n7:0.7,(t3:0.3,(t4:0.4,t5:0.5)n9:0.9)n8:0.8)n6:0.6;" +tr <- read.tree(text=nwk) + +# create analogous phylo4 object with a full complement of valid slots +ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9)) +descendant <- as.integer(c(7,1,2,8,3,6,9,4,5)) +edge <- cbind(ancestor, descendant) +nid.tip <- 1:5 +nid.int <- 6:9 +nid.all <- c(nid.tip, nid.int) +lab.tip <- paste("t", nid.tip, sep="") +lab.int <- paste("n", nid.int, sep="") +lab.all <- c(lab.tip, lab.int) +eid <- paste(ancestor, descendant, sep="-") +elen <- descendant/10 +elab <- paste("e", eid, sep="") +phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int, + edge.length=elen, edge.label=elab) + +# create altered version such that each slot is out of order with +# respect to all others; methods should be able to handle this +phy.alt <- phy +phy.alt at label <- rev(phy at label) +phy.alt at edge <- phy at edge[c(6:9, 1:5), ] +phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)] +phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)] + +# update test targets for edge-related slots +ancestor <- ancestor[c(6:9, 1:5)] +descendant <- descendant[c(6:9, 1:5)] +edge <- cbind(ancestor, descendant) +eid <- eid[c(6:9, 1:5)] +elen <- elen[c(6:9, 1:5)] +elab <- elab[c(6:9, 1:5)] + +op <- phylobase.options() +#----------------------------------------------------------------------- + +context("nTips, depthTips, nNodes, nodeType") + +test_that("nTips works correctly", + expect_that(nTips(phy.alt), equals(length(nid.tip))) +) + +test_that("depthTips works when there are edge lengths", { + edgeLengthVec <- c(1.2, 1.8, 1.8, 2.1, 2.3) + names(edgeLengthVec) <- tipLabels(phy.alt) + expect_that(depthTips(phy.alt), equals(edgeLengthVec)) +}) + +test_that("depthTips works when there are no edge lengths", { + tmpPhy <- phy.alt + edgeLength(tmpPhy) <- NA + expect_true(is.null(depthTips(tmpPhy))) +}) + +test_that("nTips works on ape objects", + ## nTips phylo + expect_equal(nTips(tr), 5)) + +test.nEdges.phylo4 <- function() { + expect_identical(nEdges(phy.alt), nrow(edge)) +} + +test_that("nNodes works as expected", + expect_equal(nNodes(phy.alt), length(nid.int))) + +test_that("nodeType works as expected", + expect_identical(nodeType(phy.alt), + setNames(c(rep("tip", length(nid.tip)), + "root", + rep("internal", length(nid.int)-1)), + c(nid.tip, nid.int)))) + +context("nodeId") +test_that("nodeId works without arguments", + expect_identical(nodeId(phy.alt), c(nid.tip, nid.int))) +test_that("nodeId works with argument all", + expect_identical(nodeId(phy.alt, "all"), c(nid.tip, nid.int))) +test_that("nodeId works with argument tip", + expect_identical(nodeId(phy.alt, "tip"), nid.tip)) +test_that("nodeId works with argument internal", + expect_identical(nodeId(phy.alt, "internal"), nid.int)) +test_that("nodeId works woth argument root", + expect_identical(nodeId(phy.alt, "root"), nid.int[1])) + + +context("nodeDepth") +allDepths <- c(1.2, 1.8, 1.8, 2.1, 2.3, 0.9, 1.0, 1.2, 1.6) +names(allDepths) <- names(getNode(phy.alt)) +test_that("nodeDepth works without arguments", { + expect_identical(nodeDepth(phy.alt), allDepths) +}) + +test_that("nodeDepth works with numeric argument", { + expect_identical(nodeDepth(phy.alt, 1), allDepths[1]) +}) + +test_that("nodeDepth works with character argument", { + expect_identical(nodeDepth(phy.alt, "t1"), allDepths[1]) +}) + +test_that("nodeDepth works with no branch length", { + tmpPhy <- phy.alt + edgeLength(tmpPhy) <- NA + expect_true(is.null(nodeDepth(tmpPhy))) +}) + +context("edges") +test_that("edges works", expect_identical(edges(phy.alt), edge)) +test_that("edges work with drop.root=TRUE option", + expect_identical(edges(phy.alt, drop.root=TRUE), + edge[edge[,1] != 0,])) + +context("edge order") +test_that("edgeOrder works as expected", { + expect_identical(edgeOrder(phy.alt), "unknown") + expect_identical(edgeOrder(reorder(phy.alt, "preorder")), "preorder") + expect_identical(edgeOrder(reorder(phy.alt, "postorder")), "postorder") +}) + +context("edgeId") +test_that("edgeId works with no argument", + expect_identical(edgeId(phy.alt), eid)) +test_that("edgeId works with argument all", + expect_identical(edgeId(phy.alt, "all"), eid)) +test_that("edgeId works with argument tip", + expect_identical(edgeId(phy.alt, "tip"), eid[descendant %in% nid.tip])) +test_that("edgeId works with argument internal", + expect_identical(edgeId(phy.alt, "internal"), eid[!descendant %in% nid.tip])) +test_that("edgeId works with argument root", + expect_identical(edgeId(phy.alt, "root"), eid[ancestor == 0])) + +context("hasEdgeLength") +test_that("hasEdgeLength works when edge lengths are present", + expect_true(hasEdgeLength(phy.alt))) +test_that("hasEdgeLength works when no edge lengths are present", { + phy.alt at edge.length <- NA_real_ + expect_true(!hasEdgeLength(phy.alt)) +}) + + +context("edgeLength") +test_that("default works (all edge lengths)", + expect_identical(edgeLength(phy.alt), setNames(elen, eid))) +test_that("one edge length, by label", + expect_equal(edgeLength(phy.alt, "t1"), c(`7-1`=0.1))) +test_that("one edge length, by node ID", + expect_equal(edgeLength(phy.alt, 1), c(`7-1`=0.1))) +test_that("non-existent edge, by label", { + ans <- structure(NA_real_, .Names = NA_character_) + expect_equal(suppressWarnings(edgeLength(phy.alt, "xxx")), ans) +}) +test_that("non-existent edge, by number", { + ans <- structure(NA_real_, .Names = NA_character_) + expect_equal(suppressWarnings(edgeLength(phy.alt, 999)), ans) +}) +test_that("wrong number of edge lengths", { + phy.tmp1 <- phy.alt + phy.tmp1 at edge.length <- phy.alt at edge.length[-1] + expect_true(nzchar(checkPhylo4(phy.tmp1))) + phy.tmp1 <- phy.alt + phy.tmp1 at edge.length <- c(phy.alt at edge.length, 1) + expect_true(nzchar(checkPhylo4(phy.tmp1))) +}) +test_that("negative edge lengths", { + phy.tmp1 <- phy.alt + phy.tmp1 at edge.length[3] <- -1 + expect_true(nzchar(checkPhylo4(phy.tmp1))) +}) +test_that("edge incorrectly labeled", { + phy.tmp1 <- phy.alt + names(phy.tmp1 at edge.length)[1] <- "9-10" + expect_true(nzchar(checkPhylo4(phy.tmp1))) +}) + +context("edgeLength <-") +emptyVec <- numeric() +attributes(emptyVec) <- list(names=character(0)) +test_that("dropping all should produce empty slot", { + edgeLength(phy.alt) <- numeric() + expect_identical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all"))) + expect_identical(phy.alt at edge.length, emptyVec) + edgeLength(phy.alt) <- NA_real_ + expect_identical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all"))) + expect_identical(phy.alt at edge.length, emptyVec) +}) +test_that("vector with reversed names, get matched by default (complete replacement)", { + edgeLength(phy.alt) <- numeric() + revElen <- setNames(elen, rev(eid)) + edgeLength(phy.alt) <- revElen + expect_identical(edgeLength(phy.alt), revElen[edgeId(phy.alt, "all")]) +}) +test_that("vector with reversed names, but specify no matching (complete replacement)", { + edgeLength(phy.alt) <- numeric() + revElen <- setNames(elen, rev(eid)) + edgeLength(phy.alt, use.names=FALSE) <- revElen + elen1 <- elen + expect_identical(edgeLength(phy.alt), setNames(elen1, edgeId(phy.alt, "all"))) +}) +test_that("vector with no names, should match to edgeId order (complete replacement)", { + edgeLength(phy.alt) <- numeric() + edgeLength(phy.alt) <- elen + elen2 <- elen + expect_identical(edgeLength(phy.alt), setNames(elen2, edgeId(phy.alt, "all"))) +}) +test_that("recycling applies if fewer the nEdges elements are supplied, \ + (duplicate edge length are okay), (complete replacement)", { + edgeLength(phy.alt) <- 1 + expect_identical(edgeLength(phy.alt), setNames(rep(1, 9), edgeId(phy.alt, "all"))) +}) +edgeLength(phy.alt) <- elen +test_that("replace an edge length using numeric index (partial replacement)", { + edgeLength(phy.alt)[9] <- 83 + expect_identical(edgeLength(phy.alt), setNames(c(elen[1:8], 83), edgeId(phy.alt, "all"))) +}) +test_that("back again, now using character index (partial replacement)", { + edgeLength(phy.alt)["8-3"] <- 0.3 + elen3 <- elen + expect_identical(edgeLength(phy.alt), setNames(elen3, edgeId(phy.alt, "all"))) +}) +test_that("error to add length for edges that don't exist (partial replacement)", { + expect_error(edgeLength(phy.alt)["fake"] <- 999) + expect_error(edgeLength(phy.alt)[999] <- 999) +}) +test_that("NAs permitted only for root edge (or for *all* edges)", { + edgeLength(phy.alt)[edgeId(phy.alt, "root")] <- NA + expect_identical(edgeLength(phy.alt), setNames(c(NA, elen[2:9]), edgeId(phy.alt, "all"))) + edgeLength(phy.alt) <- elen + expect_error(edgeLength(phy.alt)["8-3"] <- NA) +}) + + +## TODO sumEdgeLength.phylo4 ## function(phy, node) + +context("isRooted") +test_that("isRooted works as expected", + expect_true(isRooted(phy.alt))) + +context("rootNode") +test_that("rootNode works as expected", + expect_identical(rootNode(phy.alt), nid.int[1])) + +context("rootNode <-") +test_that("rootNode <- is not yet implemented", + expect_error(rootNode(phy.alt) <- 7)) + +context("labels") +test_that("labels works as expected with no argument", + expect_identical(labels(phy.alt), + setNames(c(lab.tip, lab.int), c(nid.tip, nid.int)))) +test_that("labels works as expected with argument all", + expect_identical(labels(phy.alt, "all"), + setNames(c(lab.tip, lab.int), c(nid.tip, nid.int)))) +test_that("labels works as expected with argument tip", + expect_identical(labels(phy.alt, "tip"), setNames(lab.tip, nid.tip))) +test_that("labels works as expected with argument internal", + expect_identical(labels(phy.alt, "internal"), setNames(lab.int, nid.int))) + + +context("labels <-") +test_that("dropping all should produce default tip labels, no internal labels", { + labels(phy.alt) <- character() + expect_identical(labels(phy.alt), + setNames(c(paste("T", 1:5, sep=""), rep(NA, 4)), nid.all)) +}) + +## # +## # complete replacement +## # + +## with names, not used +test_that("vector with reversed names, but names not used (all) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt) <- setNames(lab.all, rev(nid.all)) + expect_identical(labels(phy.alt), setNames(lab.all, nid.all)) +}) +test_that("vector with reversed names, but names not used (tips) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt, "tip") <- setNames(lab.tip, rev(nid.tip)) + expect_identical(tipLabels(phy.alt), setNames(lab.tip, nid.tip)) +}) +test_that("vector with reversed names, but names not used (internal) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt, "internal") <- setNames(lab.int, rev(nid.int)) + expect_identical(nodeLabels(phy.alt), setNames(lab.int, nid.int)) +}) + +## with names, used +test_that("vector with reversed names, but names used (all) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt, use.names=TRUE) <- setNames(lab.all, rev(nid.all)) + expect_identical(labels(phy.alt), setNames(rev(lab.all), nid.all)) +}) +test_that("vector with reversed names, but names used (tips) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt, "tip", use.names=TRUE) <- setNames(lab.tip, rev(nid.tip)) + expect_identical(tipLabels(phy.alt), setNames(rev(lab.tip), nid.tip)) +}) +test_that("vector with reversed names, but names used (internal) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt, "internal", use.names=TRUE) <- setNames(lab.int, rev(nid.int)) + expect_identical(nodeLabels(phy.alt), setNames(rev(lab.int), nid.int)) +}) +## no names +test_that("vector with no names, should match to nodeId order (all) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt) <- lab.all + expect_identical(labels(phy.alt), setNames(lab.all, nid.all)) +}) +test_that("vector with no names, should match to nodeId order (all) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt, type="tip") <- lab.tip + expect_identical(tipLabels(phy.alt), setNames(lab.tip, nid.tip)) +}) +test_that("vector with no names, should match to nodeId order (all) - complete replacement", { + labels(phy.alt) <- character() + labels(phy.alt, type="internal") <- lab.int + expect_identical(nodeLabels(phy.alt), setNames(lab.int, nid.int)) +}) + +## partial replacement +labels(phy.alt) <- lab.all +test_that("replace a tip using numeric index", { + labels(phy.alt)[5] <- "t5a" + expect_identical(tipLabels(phy.alt), setNames(c(lab.tip[1:4], "t5a"), nid.tip)) +}) +test_that("and back again, now using character index", { + labels(phy.alt)["5"] <- "t5" + expect_identical(labels(phy.alt), setNames(lab.all, nid.all)) +}) +test_that("replace an internal node using numeric index", { + labels(phy.alt)[9] <- "n9a" + expect_identical(nodeLabels(phy.alt), setNames(c(lab.int[1:3], "n9a"), nid.int)) +}) +test_that("and back again, now using character index", { + labels(phy.alt)["9"] <- "n9" + expect_identical(labels(phy.alt), setNames(lab.all, nid.all)) +}) +test_that("error to produce duplicate tip or internal label", { + phylobase.options(allow.duplicated.labels="fail") + expect_error(labels(phy.alt)[1] <- "t2") + expect_error(labels(phy.alt)[6] <- "n7") +}) +test_that("no error in allow.duplicated.labels is ok", { + phylobase.options(allow.duplicated.labels="ok") + labels(phy.alt)[1] <- "t2" + labels(phy.alt)[6] <- "n7" + expect_identical(tipLabels(phy.alt), setNames(c("t2", "t2", "t3", "t4", "t5"), nid.tip)) + expect_identical(nodeLabels(phy.alt), setNames(c("n7", "n7", "n8", "n9"), nid.int)) +}) +test_that("error to add labels for nodes that don't exist", { + expect_error(labels(phy.alt)["fake"] <- "xxx") + expect_error(labels(phy.alt)[999] <- "xxx") +}) + +context("nodeLabels") +test_that("nodeLabels works as expected", + expect_identical(nodeLabels(phy.alt), setNames(lab.int, nid.int))) + +context("hasNodeLabels") +test_that("hasNodeLabels works as expected", { + expect_true(hasNodeLabels(phy.alt)) + nodeLabels(phy.alt) <- NA_character_ + expect_true(!hasNodeLabels(phy.alt)) +}) + +context("nodeLabels <-") +test_that("dropping all should produce no internal labels", { + nodeLabels(phy.alt) <- character() + expect_true(!any(nid.int %in% names(phy.alt at label))) [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/phylobase -r 858 From noreply at r-forge.r-project.org Mon Mar 10 05:37:35 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 10 Mar 2014 05:37:35 +0100 (CET) Subject: [Phylobase-commits] r859 - in pkg: . tests Message-ID: <20140310043735.2ECC3186E1A@r-forge.r-project.org> Author: francois Date: 2014-03-10 05:37:34 +0100 (Mon, 10 Mar 2014) New Revision: 859 Modified: pkg/DESCRIPTION pkg/tests/test-all.R Log: a couple of fixes for running the tests. Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2014-03-10 04:10:29 UTC (rev 858) +++ pkg/DESCRIPTION 2014-03-10 04:37:34 UTC (rev 859) @@ -6,13 +6,12 @@ Depends: methods, grid, - ape(>= 2.1), Rcpp (>= 0.11.0), - testthat (>= 0.8.1) -Imports: ade4 +Imports: ade4, ape (>= 2.1) LinkingTo: Rcpp Suggests: MASS, + testthat (>= 0.8.1), RUnit Author: R Hackathon et al. (alphabetically: Ben Bolker, Marguerite Butler, Peter Cowan, Damien de Vienne, Dirk Eddelbuettel, Mark Holder, Thibaut Modified: pkg/tests/test-all.R =================================================================== --- pkg/tests/test-all.R 2014-03-10 04:10:29 UTC (rev 858) +++ pkg/tests/test-all.R 2014-03-10 04:37:34 UTC (rev 859) @@ -1,2 +1,3 @@ +library(testthat) test_check("phylobase") From noreply at r-forge.r-project.org Mon Mar 10 06:21:26 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 10 Mar 2014 06:21:26 +0100 (CET) Subject: [Phylobase-commits] r860 - pkg/inst/unitTests Message-ID: <20140310052127.09FFC186B8F@r-forge.r-project.org> Author: francois Date: 2014-03-10 06:21:26 +0100 (Mon, 10 Mar 2014) New Revision: 860 Removed: pkg/inst/unitTests/runit.methods-phylo4.R Log: forgot to delete that file Deleted: pkg/inst/unitTests/runit.methods-phylo4.R =================================================================== --- pkg/inst/unitTests/runit.methods-phylo4.R 2014-03-10 04:37:34 UTC (rev 859) +++ pkg/inst/unitTests/runit.methods-phylo4.R 2014-03-10 05:21:26 UTC (rev 860) @@ -1,501 +0,0 @@ - # -# --- Test methods-phylo4.R --- -# - -# create ape::phylo version of a simple tree for testing -nwk <- "((t1:0.1,t2:0.2)n7:0.7,(t3:0.3,(t4:0.4,t5:0.5)n9:0.9)n8:0.8)n6:0.6;" -tr <- read.tree(text=nwk) - -# create analogous phylo4 object with a full complement of valid slots -ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9)) -descendant <- as.integer(c(7,1,2,8,3,6,9,4,5)) -edge <- cbind(ancestor, descendant) -nid.tip <- 1:5 -nid.int <- 6:9 -nid.all <- c(nid.tip, nid.int) -lab.tip <- paste("t", nid.tip, sep="") -lab.int <- paste("n", nid.int, sep="") -lab.all <- c(lab.tip, lab.int) -eid <- paste(ancestor, descendant, sep="-") -elen <- descendant/10 -elab <- paste("e", eid, sep="") -phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int, - edge.length=elen, edge.label=elab) - -# create altered version such that each slot is out of order with -# respect to all others; methods should be able to handle this -phy.alt <- phy -phy.alt at label <- rev(phy at label) -phy.alt at edge <- phy at edge[c(6:9, 1:5), ] -phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)] -phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)] - -# update test targets for edge-related slots -ancestor <- ancestor[c(6:9, 1:5)] -descendant <- descendant[c(6:9, 1:5)] -edge <- cbind(ancestor, descendant) -eid <- eid[c(6:9, 1:5)] -elen <- elen[c(6:9, 1:5)] -elab <- elab[c(6:9, 1:5)] - -op <- phylobase.options() -#----------------------------------------------------------------------- - -test.nTips.phylo4 <- function() { - checkEquals(nTips(phy.alt), length(nid.tip)) -} - -test.depthTips.phylo4 <- function() { - edgeLengthVec <- c(1.2, 1.8, 1.8, 2.1, 2.3) - names(edgeLengthVec) <- tipLabels(phy.alt) - checkEquals(depthTips(phy.alt), edgeLengthVec) - tmpPhy <- phy.alt - edgeLength(tmpPhy) <- NA - checkTrue(is.null(depthTips(tmpPhy))) -} - -test.nTips.ANY <- function() { - # nTips phylo - checkEquals(nTips(tr), 5) -} - -test.nNodes.phylo4 <- function() { - checkEquals(nNodes(phy.alt), length(nid.int)) -} - -test.nodeType.phylo4 <- function() { - checkIdentical(nodeType(phy.alt), setNames(c(rep("tip", length(nid.tip)), - "root", rep("internal", length(nid.int)-1)), c(nid.tip, nid.int))) -} - -test.nodeId.phylo4 <- function() { - checkIdentical(nodeId(phy.alt), c(nid.tip, nid.int)) - checkIdentical(nodeId(phy.alt, "all"), c(nid.tip, nid.int)) - checkIdentical(nodeId(phy.alt, "tip"), nid.tip) - checkIdentical(nodeId(phy.alt, "internal"), nid.int) - checkIdentical(nodeId(phy.alt, "root"), nid.int[1]) -} - -test.nEdges.phylo4 <- function() { - checkIdentical(nEdges(phy.alt), nrow(edge)) -} - -test.nodeDepth.phylo4 <- function() { - allDepths <- c(1.2, 1.8, 1.8, 2.1, 2.3, 0.9, 1.0, 1.2, 1.6) - names(allDepths) <- names(getNode(phy.alt)) - checkIdentical(nodeDepth(phy.alt), allDepths) - checkIdentical(nodeDepth(phy.alt, 1), allDepths[1]) - checkIdentical(nodeDepth(phy.alt, "t1"), allDepths[1]) - tmpPhy <- phy.alt - edgeLength(tmpPhy) <- NA - checkTrue(is.null(nodeDepth(tmpPhy))) -} - -test.edges.phylo4 <- function() { - checkIdentical(edges(phy.alt), edge) - checkIdentical(edges(phy.alt, drop.root=TRUE), edge[edge[,1] != 0,]) -} - -test.edgeOrder.phylo4 <- function() { - checkIdentical(edgeOrder(phy.alt), "unknown") - checkIdentical(edgeOrder(reorder(phy.alt, "preorder")), "preorder") - checkIdentical(edgeOrder(reorder(phy.alt, "postorder")), "postorder") -} - -test.edgeId.phylo4 <- function() { - checkIdentical(edgeId(phy.alt), eid) - checkIdentical(edgeId(phy.alt, "all"), eid) - checkIdentical(edgeId(phy.alt, "tip"), eid[descendant %in% nid.tip]) - checkIdentical(edgeId(phy.alt, "internal"), eid[!descendant %in% nid.tip]) - checkIdentical(edgeId(phy.alt, "root"), eid[ancestor == 0]) -} - -test.hasEdgeLength.phylo4 <- function() { - checkTrue(hasEdgeLength(phy.alt)) - phy.alt at edge.length <- NA_real_ - checkTrue(!hasEdgeLength(phy.alt)) -} - -test.edgeLength.phylo4 <- function() { - ## all edge lengths - checkIdentical(edgeLength(phy.alt), setNames(elen, eid)) - ## one edge length, by label - checkEquals(edgeLength(phy.alt, "t1"), c(`7-1`=0.1)) - ## one edge length, by node ID - checkEquals(edgeLength(phy.alt, 1), c(`7-1`=0.1)) - ## non-existent edge, by label - ans <- structure(NA_real_, .Names = NA_character_) - checkEquals(suppressWarnings(edgeLength(phy.alt, "xxx")), ans) - ## non-existent edge, by number - checkEquals(suppressWarnings(edgeLength(phy.alt, 999)), ans) - ## wrong number of edge lengths - phy.tmp1 <- phy.alt - phy.tmp1 at edge.length <- phy.alt at edge.length[-1] - checkTrue(nzchar(checkPhylo4(phy.tmp1))) - phy.tmp1 <- phy.alt - phy.tmp1 at edge.length <- c(phy.alt at edge.length, 1) - checkTrue(nzchar(checkPhylo4(phy.tmp1))) - ## negative edge lengths - phy.tmp1 <- phy.alt - phy.tmp1 at edge.length[3] <- -1 - checkTrue(nzchar(checkPhylo4(phy.tmp1))) - ## edge incorrectly labeled - phy.tmp1 <- phy.alt - names(phy.tmp1 at edge.length)[1] <- "9-10" - checkTrue(nzchar(checkPhylo4(phy.tmp1))) -} - -test.Replace.edgeLength.phylo4 <- function() { - - emptyVec <- numeric() - attributes(emptyVec) <- list(names=character(0)) - - ## dropping all should produce empty slot - edgeLength(phy.alt) <- numeric() - checkIdentical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all"))) - checkIdentical(phy.alt at edge.length, emptyVec) - edgeLength(phy.alt) <- NA_real_ - checkIdentical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all"))) - checkIdentical(phy.alt at edge.length, emptyVec) - - ## - ## complete replacement - ## - - ## vector with reversed names, which get matched by default - edgeLength(phy.alt) <- numeric() - revElen <- setNames(elen, rev(eid)) - edgeLength(phy.alt) <- revElen - checkIdentical(edgeLength(phy.alt), revElen[edgeId(phy.alt, "all")]) - ## vector with reversed names, but specify no matching - edgeLength(phy.alt) <- numeric() - edgeLength(phy.alt, use.names=FALSE) <- revElen - elen1 <- elen - checkIdentical(edgeLength(phy.alt), setNames(elen1, edgeId(phy.alt, "all"))) - ## vector with no names, should match to edgeId order - edgeLength(phy.alt) <- numeric() - edgeLength(phy.alt) <- elen - elen2 <- elen - checkIdentical(edgeLength(phy.alt), setNames(elen2, edgeId(phy.alt, "all"))) - - ## recycling applies if fewer the nEdges elements are supplied - ## (duplicate edge length are okay) - edgeLength(phy.alt) <- 1 - checkIdentical(edgeLength(phy.alt), setNames(rep(1, 9), edgeId(phy.alt, "all"))) - - ## - ## partial replacement - ## - - edgeLength(phy.alt) <- elen - ## replace an edge length using numeric index - edgeLength(phy.alt)[9] <- 83 - checkIdentical(edgeLength(phy.alt), setNames(c(elen[1:8], 83), edgeId(phy.alt, "all"))) - ## and back again, now using character index - edgeLength(phy.alt)["8-3"] <- 0.3 - elen3 <- elen - checkIdentical(edgeLength(phy.alt), setNames(elen3, edgeId(phy.alt, "all"))) - ## error to add length for edges that don't exist - checkException(edgeLength(phy.alt)["fake"] <- 999) - checkException(edgeLength(phy.alt)[999] <- 999) - ## NAs permitted only for root edge (or for *all* edges) - edgeLength(phy.alt)[edgeId(phy.alt, "root")] <- NA - checkIdentical(edgeLength(phy.alt), setNames(c(NA, elen[2:9]), edgeId(phy.alt, "all"))) - edgeLength(phy.alt) <- elen - checkException(edgeLength(phy.alt)["8-3"] <- NA) -} - -test.sumEdgeLength.phylo4 <- function() { - #TODO function(phy, node) -} - -test.isRooted.phylo4 <- function() { - checkTrue(isRooted(phy.alt)) -} - -test.rootNode.phylo4 <- function() { - checkIdentical(rootNode(phy.alt), nid.int[1]) -} - -test.Replace.rootNode.phylo4 <- function() { - #TODO function(x, value) -} - -test.labels.phylo4 <- function() { - # function(object, type = c("all", "tip", "internal")) - checkIdentical(labels(phy.alt), setNames(c(lab.tip, lab.int), c(nid.tip, - nid.int))) - checkIdentical(labels(phy.alt, "all"), setNames(c(lab.tip, lab.int), - c(nid.tip, nid.int))) - checkIdentical(labels(phy.alt, "tip"), setNames(lab.tip, nid.tip)) - checkIdentical(labels(phy.alt, "internal"), setNames(lab.int, nid.int)) -} - -test.Replace.labels.phylo4 <- function() { - - ## dropping all should produce default tip labels, no internal labels - labels(phy.alt) <- character() - checkIdentical(labels(phy.alt), setNames(c(paste("T", 1:5, sep=""), - rep(NA, 4)), nid.all)) - - # - # complete replacement - # - - # vector with reversed names, but names not used - labels(phy.alt) <- character() - labels(phy.alt) <- setNames(lab.all, rev(nid.all)) - checkIdentical(labels(phy.alt), setNames(lab.all, nid.all)) - labels(phy.alt) <- character() - labels(phy.alt, "tip") <- setNames(lab.tip, rev(nid.tip)) - checkIdentical(tipLabels(phy.alt), setNames(lab.tip, nid.tip)) - labels(phy.alt) <- character() - labels(phy.alt, "internal") <- setNames(lab.int, rev(nid.int)) - checkIdentical(nodeLabels(phy.alt), setNames(lab.int, nid.int)) - # as above, but specify name matching, hence labels get reversed too - labels(phy.alt) <- character() - labels(phy.alt, use.names=TRUE) <- setNames(lab.all, rev(nid.all)) - checkIdentical(labels(phy.alt), setNames(rev(lab.all), nid.all)) - labels(phy.alt) <- character() - labels(phy.alt, "tip", use.names=TRUE) <- setNames(lab.tip, rev(nid.tip)) - checkIdentical(tipLabels(phy.alt), setNames(rev(lab.tip), nid.tip)) - labels(phy.alt) <- character() - labels(phy.alt, "internal", use.names=TRUE) <- setNames(lab.int, rev(nid.int)) - checkIdentical(nodeLabels(phy.alt), setNames(rev(lab.int), nid.int)) - # vector with no names, should match to nodeId order - labels(phy.alt) <- character() - labels(phy.alt) <- lab.all - checkIdentical(labels(phy.alt), setNames(lab.all, nid.all)) - labels(phy.alt) <- character() - labels(phy.alt, type="tip") <- lab.tip - checkIdentical(tipLabels(phy.alt), setNames(lab.tip, nid.tip)) - labels(phy.alt) <- character() - labels(phy.alt, type="internal") <- lab.int - checkIdentical(nodeLabels(phy.alt), setNames(lab.int, nid.int)) - - # - # partial replacement - # - - labels(phy.alt) <- lab.all - # replace a tip using numeric index - labels(phy.alt)[5] <- "t5a" - checkIdentical(tipLabels(phy.alt), setNames(c(lab.tip[1:4], "t5a"), nid.tip)) - # and back again, now using character index - labels(phy.alt)["5"] <- "t5" - checkIdentical(labels(phy.alt), setNames(lab.all, nid.all)) - # replace an internal node using numeric index - labels(phy.alt)[9] <- "n9a" - checkIdentical(nodeLabels(phy.alt), setNames(c(lab.int[1:3], "n9a"), nid.int)) - # and back again, now using character index - labels(phy.alt)["9"] <- "n9" - checkIdentical(labels(phy.alt), setNames(lab.all, nid.all)) - # error to produce duplicate tip or internal label - phylobase.options(allow.duplicated.labels="fail") - checkException(labels(phy.alt)[1] <- "t2") - checkException(labels(phy.alt)[6] <- "n7") - # no error in allow.duplicated.labels is ok - phylobase.options(allow.duplicated.labels="ok") - labels(phy.alt)[1] <- "t2" - labels(phy.alt)[6] <- "n7" - checkIdentical(tipLabels(phy.alt), setNames(c("t2", "t2", "t3", "t4", "t5"), nid.tip)) - checkIdentical(nodeLabels(phy.alt), setNames(c("n7", "n7", "n8", "n9"), nid.int)) - # error to add labels for nodes that don't exist - checkException(labels(phy.alt)["fake"] <- "xxx") - checkException(labels(phy.alt)[999] <- "xxx") - -} - -test.nodeLabels.phylo4 <- function() { - checkIdentical(nodeLabels(phy.alt), setNames(lab.int, nid.int)) -} - -test.hasNodeLabels.phylo4 <- function() { - checkTrue(hasNodeLabels(phy.alt)) - nodeLabels(phy.alt) <- NA_character_ - checkTrue(!hasNodeLabels(phy.alt)) -} - -test.Replace.nodeLabels.phylo4 <- function() { - - ## dropping all should produce no internal labels - nodeLabels(phy.alt) <- character() - checkTrue(!any(nid.int %in% names(phy.alt at label))) - checkIdentical(nodeLabels(phy.alt), setNames(rep(NA_character_, 4), nid.int)) - - # - # partial replacement - # - - labels(phy.alt) <- lab.all - # replace an internal node using numeric index - nodeLabels(phy.alt)[4] <- "n9a" - checkIdentical(nodeLabels(phy.alt), setNames(c(lab.int[1:3], "n9a"), nid.int)) - # and back again, now using character index - nodeLabels(phy.alt)["9"] <- "n9" - checkIdentical(labels(phy.alt), setNames(lab.all, nid.all)) - # error to produce duplicate internal label - phylobase.options(allow.duplicated.labels="fail") - checkException(nodeLabels(phy.alt)["6"] <- "n7") - phylobase.options(op) - phylobase.options(allow.duplicated.labels="ok") - nodeLabels(phy.alt)["6"] <- "n7" - checkIdentical(nodeLabels(phy.alt), setNames(c("n7", "n7", "n8", "n9"), nid.int)) - phylobase.options(op) - # error to add labels for nodes that don't exist - checkException(nodeLabels(phy.alt)["fake"] <- "xxx") - checkException(nodeLabels(phy.alt)[999] <- "xxx") -} - -test.tipLabels.phylo4 <- function() { - checkIdentical(tipLabels(phy.alt), setNames(lab.tip, nid.tip)) -} - -test.Replace.tipLabels.phylo4 <- function() { - - ## dropping all tip labels should produce default labels - tipLabels(phy.alt) <- character() - checkIdentical(tipLabels(phy.alt), setNames(paste("T", 1:5, sep=""), nid.tip)) - - # - # partial replacement - # - - labels(phy.alt) <- lab.all - # replace a tip using numeric index - tipLabels(phy.alt)[5] <- "t5a" - checkIdentical(tipLabels(phy.alt), setNames(c(lab.tip[1:4], "t5a"), nid.tip)) - # and back again, now using character index - tipLabels(phy.alt)["5"] <- "t5" - checkIdentical(labels(phy.alt), setNames(lab.all, nid.all)) - # error to produce duplicate tip or internal label - phylobase.options(allow.duplicated.labels="fail") - checkException(tipLabels(phy.alt)[1] <- "t2") - phylobase.options(op) - phylobase.options(allow.duplicated.labels="ok") - tipLabels(phy.alt)[1] <- "t2" - checkIdentical(tipLabels(phy.alt), setNames(c("t2", "t2", "t3", "t4", "t5"), nid.tip)) - phylobase.options(op) - # error to add labels for nodes that don't exist - checkException(tipLabels(phy.alt)["fake"] <- "xxx") - checkException(tipLabels(phy.alt)[999] <- "xxx") -} - -test.hasEdgeLabels.phylo4 <- function() { - checkTrue(hasEdgeLabels(phy.alt)) - phy.alt at edge.label <- NA_character_ - checkTrue(!hasEdgeLabels(phy.alt)) -} - -test.edgeLabels.phylo4 <- function() { - - # basic usage - checkIdentical(edgeLabels(phy.alt), setNames(elab, eid)) - # should return named vector of NAs if edge labels are missing or NA - phy.alt at edge.label <- NA_character_ - checkIdentical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid)) - phy.alt at edge.label <- character() - checkIdentical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid)) - # if only some labels exists, should fill in NA for the others - phy.alt at edge.label <- setNames(elab[-1], eid[-1]) - checkIdentical(edgeLabels(phy.alt), setNames(c(NA, elab[-1]), eid)) - -} - -test.Replace.edgeLabels.phylo4 <- function() { - - ## dropping all should produce empty slot - edgeLabels(phy.alt) <- character() - checkIdentical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid)) - - # - # complete replacement - # - - # vector with reversed names, which always get matched - edgeLabels(phy.alt) <- character() - edgeLabels(phy.alt) <- setNames(elab, rev(eid)) - checkIdentical(edgeLabels(phy.alt), setNames(rev(elab), eid)) - # vector with no names, should match to edgeId order - edgeLabels(phy.alt) <- character() - edgeLabels(phy.alt) <- elab - checkIdentical(edgeLabels(phy.alt), setNames(elab, eid)) - - # recycling applies if fewer the nEdges elements are supplied - # (duplicate edge labels are okay) - edgeLabels(phy.alt) <- "x" - checkIdentical(edgeLabels(phy.alt), setNames(rep("x", 9), eid)) - - # - # partial replacement - # - - edgeLabels(phy.alt) <- elab - # replace an edge label using numeric index - edgeLabels(phy.alt)[9] <- "e8-3a" - checkIdentical(edgeLabels(phy.alt), setNames(c(elab[1:8], "e8-3a"), eid)) - # and back again, now using character index - edgeLabels(phy.alt)["8-3"] <- "e8-3" - checkIdentical(edgeLabels(phy.alt), setNames(elab, eid)) - # error to add labels for edges that don't exist - checkException(edgeLabels(phy.alt)["fake"] <- "xxx") - checkException(edgeLabels(phy.alt)[999] <- "xxx") -} - -## this is also the print method -## this mostly just wraps .phylo4ToDataFrame, which is tested elsewhere -##test.show.phylo4 <- function() { -##} - -test.names.phylo4 <- function() { - #TODO? -} - -test.head.phylo4 <- function() { - #TODO? -} - -test.tail.phylo4 <- function() { - #TODO? -} - -test.summary.phylo4 <- function() { - phy.sum <- summary(phy.alt, quiet=TRUE) - checkIdentical(phy.sum$name, "phy.alt") - checkIdentical(phy.sum$nb.tips, length(nid.tip)) - checkIdentical(phy.sum$nb.nodes, length(nid.int)) - checkIdentical(phy.sum$mean.el, mean(elen)) - checkIdentical(phy.sum$var.el, var(elen)) - checkIdentical(phy.sum$sumry.el, summary(elen)) - # now make root edge length NA - edgeLength(phy.alt)[edgeId(phy.alt, "root")] <- NA - phy.sum2 <- summary(phy.alt, quiet=TRUE) - checkIdentical(phy.sum2$mean.el, mean(edgeLength(phy.alt), na.rm=TRUE)) - checkIdentical(phy.sum2$var.el, var(edgeLength(phy.alt), na.rm=TRUE)) - checkIdentical(phy.sum2$sumry.el, summary(na.omit(edgeLength(phy.alt)))) - # now remove edge lengths altogether - phy.alt at edge.length[] <- NA - phy.sum3 <- summary(phy.alt, quiet=TRUE) - checkTrue(is.null(phy.sum3$mean.el)) - checkTrue(is.null(phy.sum3$var.el)) - checkTrue(is.null(phy.sum3$sumry.el)) -} - -# not an exported function -- called internally by reorder("phylo4") -#test.orderIndex <- function() { -#} - -test.reorder.phylo4 <- function() { - #TODO -} - -test.isUltrametric <- function() { - checkTrue(!isUltrametric(phy.alt)) - tmpPhy <- as(rcoal(10), "phylo4") - checkTrue(isUltrametric(tmpPhy)) - tmpPhy <- phy.alt - edgeLength(tmpPhy) <- NA - checkException(isUltrametric(tmpPhy)) -} - -phylobase.options(op) From noreply at r-forge.r-project.org Mon Mar 10 06:21:49 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 10 Mar 2014 06:21:49 +0100 (CET) Subject: [Phylobase-commits] r861 - pkg Message-ID: <20140310052149.27398186B8F@r-forge.r-project.org> Author: francois Date: 2014-03-10 06:21:48 +0100 (Mon, 10 Mar 2014) New Revision: 861 Modified: pkg/DESCRIPTION Log: putting back ape where it belongs Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2014-03-10 05:21:26 UTC (rev 860) +++ pkg/DESCRIPTION 2014-03-10 05:21:48 UTC (rev 861) @@ -7,7 +7,8 @@ methods, grid, Rcpp (>= 0.11.0), -Imports: ade4, ape (>= 2.1) + ape (>= 2.1) +Imports: ade4 LinkingTo: Rcpp Suggests: MASS, From noreply at r-forge.r-project.org Mon Mar 10 06:39:16 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 10 Mar 2014 06:39:16 +0100 (CET) Subject: [Phylobase-commits] r862 - pkg Message-ID: <20140310053917.0F2F5181291@r-forge.r-project.org> Author: francois Date: 2014-03-10 06:39:16 +0100 (Mon, 10 Mar 2014) New Revision: 862 Modified: pkg/NAMESPACE Log: add import(ape) to avoid WARNING during check Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2014-03-10 05:21:48 UTC (rev 861) +++ pkg/NAMESPACE 2014-03-10 05:39:16 UTC (rev 862) @@ -5,6 +5,7 @@ #---------------------------------------------------------------------- import(methods) +import(ape) importFrom(graphics, plot) importFrom(stats, reorder) importFrom(utils, head, tail) From noreply at r-forge.r-project.org Mon Mar 10 17:49:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 10 Mar 2014 17:49:08 +0100 (CET) Subject: [Phylobase-commits] r863 - pkg/tests/testthat Message-ID: <20140310164909.186E218680F@r-forge.r-project.org> Author: francois Date: 2014-03-10 17:49:08 +0100 (Mon, 10 Mar 2014) New Revision: 863 Modified: pkg/tests/testthat/test.methods-phylo4.R Log: shouldn't be using identical on floating point numbers, replaced with equal. Modified: pkg/tests/testthat/test.methods-phylo4.R =================================================================== --- pkg/tests/testthat/test.methods-phylo4.R 2014-03-10 05:39:16 UTC (rev 862) +++ pkg/tests/testthat/test.methods-phylo4.R 2014-03-10 16:49:08 UTC (rev 863) @@ -94,15 +94,15 @@ allDepths <- c(1.2, 1.8, 1.8, 2.1, 2.3, 0.9, 1.0, 1.2, 1.6) names(allDepths) <- names(getNode(phy.alt)) test_that("nodeDepth works without arguments", { - expect_identical(nodeDepth(phy.alt), allDepths) + expect_equal(nodeDepth(phy.alt), allDepths) }) test_that("nodeDepth works with numeric argument", { - expect_identical(nodeDepth(phy.alt, 1), allDepths[1]) + expect_equal(nodeDepth(phy.alt, 1), allDepths[1]) }) test_that("nodeDepth works with character argument", { - expect_identical(nodeDepth(phy.alt, "t1"), allDepths[1]) + expect_equal(nodeDepth(phy.alt, "t1"), allDepths[1]) }) test_that("nodeDepth works with no branch length", { From noreply at r-forge.r-project.org Fri Mar 14 19:21:03 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Mar 2014 19:21:03 +0100 (CET) Subject: [Phylobase-commits] r864 - pkg/tests Message-ID: <20140314182103.D9A2B186B10@r-forge.r-project.org> Author: francois Date: 2014-03-14 19:21:03 +0100 (Fri, 14 Mar 2014) New Revision: 864 Modified: pkg/tests/phylotorture.R pkg/tests/phylotorture.Rout.save Log: updated phylotorture Modified: pkg/tests/phylotorture.R =================================================================== --- pkg/tests/phylotorture.R 2014-03-10 16:49:08 UTC (rev 863) +++ pkg/tests/phylotorture.R 2014-03-14 18:21:03 UTC (rev 864) @@ -1,5 +1,6 @@ ## torture-testing phylo4 objects. require(phylobase) +require(ape) set.seed(1001) p1 <- list() n <- 10 Modified: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save 2014-03-10 16:49:08 UTC (rev 863) +++ pkg/tests/phylotorture.Rout.save 2014-03-14 18:21:03 UTC (rev 864) @@ -1,6 +1,6 @@ -R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" -Copyright (C) 2013 The R Foundation for Statistical Computing +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. @@ -17,16 +17,19 @@ 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. +[Previously saved workspace restored] + > ## torture-testing phylo4 objects. > require(phylobase) Loading required package: phylobase Loading required package: grid +Loading required package: Rcpp +> require(ape) Loading required package: ape -Loading required package: Rcpp -Attaching package: ?phylobase? +Attaching package: ?ape? -The following object is masked from ?package:ape?: +The following object is masked from ?package:phylobase?: edges @@ -217,4 +220,4 @@ > > proc.time() user system elapsed - 5.551 0.181 5.773 + 5.799 0.194 5.971 From noreply at r-forge.r-project.org Fri Mar 14 21:20:39 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Mar 2014 21:20:39 +0100 (CET) Subject: [Phylobase-commits] r865 - pkg/tests Message-ID: <20140314202039.9F8A7186CEE@r-forge.r-project.org> Author: francois Date: 2014-03-14 21:20:38 +0100 (Fri, 14 Mar 2014) New Revision: 865 Modified: pkg/tests/phylotorture.R pkg/tests/phylotorture.Rout.save Log: simplifying output of torture test to make it pass R check Modified: pkg/tests/phylotorture.R =================================================================== --- pkg/tests/phylotorture.R 2014-03-14 18:21:03 UTC (rev 864) +++ pkg/tests/phylotorture.R 2014-03-14 20:20:38 UTC (rev 865) @@ -13,7 +13,9 @@ p1[[i]] <- try(phylo4(e),silent=TRUE) } OKvals <- sapply(p1, class) != "try-error" -table(sapply(p1[!OKvals], as.character)) +## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with +## R check because of different width of terminal/output, trying something simpler: +message(unique(sapply(p1[!OKvals], as.character))) if (any(OKvals)) { p2 <- p1[OKvals] Modified: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save 2014-03-14 18:21:03 UTC (rev 864) +++ pkg/tests/phylotorture.Rout.save 2014-03-14 20:20:38 UTC (rev 865) @@ -54,14 +54,15 @@ 7: In checkTree(object) : Tree contains singleton nodes. 8: In checkTree(object) : Tree contains singleton nodes. > OKvals <- sapply(p1, class) != "try-error" -> table(sapply(p1[!OKvals], as.character)) +> ## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with +> ## R check because of different width of terminal/output, trying something simpler: +> message(unique(sapply(p1[!OKvals], as.character))) +Error in .local(x, ...) : + Tips incorrectly labeled. Nodes incorrectly labeled. +Error in names(res) <- switch(type, tip = 1:ntips, internal = seq(from = ntips + : + 'names' attribute [2] must be the same length as the vector [1] +Error in .local(x, ...) : Nodes incorrectly labeled. - Error in .local(x, ...) : Nodes incorrectly labeled. \n - 1 - Error in .local(x, ...) : \n Tips incorrectly labeled. Nodes incorrectly labeled. \n - 7 -Error in names(res) <- switch(type, tip = 1:ntips, internal = seq(from = ntips + : \n 'names' attribute [2] must be the same length as the vector [1]\n - 2 > > if (any(OKvals)) { + p2 <- p1[OKvals] @@ -220,4 +221,4 @@ > > proc.time() user system elapsed - 5.799 0.194 5.971 + 5.708 0.195 5.887 From noreply at r-forge.r-project.org Fri Mar 14 21:30:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Mar 2014 21:30:08 +0100 (CET) Subject: [Phylobase-commits] r866 - pkg/man Message-ID: <20140314203008.23B86187003@r-forge.r-project.org> Author: francois Date: 2014-03-14 21:30:07 +0100 (Fri, 14 Mar 2014) New Revision: 866 Modified: pkg/man/as-methods.Rd pkg/man/phylobubbles.Rd pkg/man/phylomat-class.Rd pkg/man/tip.data.plot.Rd Log: fixing formatting to pass R check without NOTEs Modified: pkg/man/as-methods.Rd =================================================================== --- pkg/man/as-methods.Rd 2014-03-14 20:20:38 UTC (rev 865) +++ pkg/man/as-methods.Rd 2014-03-14 20:30:07 UTC (rev 866) @@ -111,7 +111,8 @@ \examples{ -tree.owls <- read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);") +trString <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);" +tree.owls <- read.tree(text=trString) ## round trip conversion tree_in_phylo <- tree.owls # tree is a phylo object (tree_in_phylo4 <- as(tree.owls,"phylo4")) # phylo converted to phylo4 Modified: pkg/man/phylobubbles.Rd =================================================================== --- pkg/man/phylobubbles.Rd 2014-03-14 20:20:38 UTC (rev 865) +++ pkg/man/phylobubbles.Rd 2014-03-14 20:30:07 UTC (rev 866) @@ -4,10 +4,11 @@ \title{Bubble plots for phylo4d objects } \description{ Plots either circles or squares corresponding to the magnitude of each cell of a \code{phylo4d} object.} -\usage{ -phylobubbles(type, place.tip.label, show.node.label, rot, edge.color, node.color, tip.color, edge.width, newpage, ..., XXYY, square = FALSE, grid = TRUE) -} +\usage{ phylobubbles(type, place.tip.label, show.node.label, rot, +edge.color, node.color, tip.color, edge.width, newpage, ..., XXYY, +square = FALSE, grid = TRUE) } + %- maybe also 'usage' for other objects documented here. \arguments{ \item{type}{the type of plot } Modified: pkg/man/phylomat-class.Rd =================================================================== --- pkg/man/phylomat-class.Rd 2014-03-14 20:20:38 UTC (rev 865) +++ pkg/man/phylomat-class.Rd 2014-03-14 20:30:07 UTC (rev 866) @@ -30,7 +30,8 @@ } \author{Ben Bolker} \examples{ - tree.owls <- read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);") + trString <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);" + tree.owls <- read.tree(text=trString) o2 <- as(tree.owls,"phylo4") ov <- as(o2,"phylo4vcov") o3 <- as(ov,"phylo4") Modified: pkg/man/tip.data.plot.Rd =================================================================== --- pkg/man/tip.data.plot.Rd 2014-03-14 20:20:38 UTC (rev 865) +++ pkg/man/tip.data.plot.Rd 2014-03-14 20:30:07 UTC (rev 866) @@ -3,9 +3,13 @@ \alias{tip.data.plot} \title{Plotting trees and associated data} \description{Plotting phylogenetic trees and associated data} -\usage{ -tip.data.plot(xxyy, type = c("phylogram", "cladogram", "fan"), show.tip.label = TRUE, show.node.label = FALSE, rot = 0, tip.plot.fun = grid.points, edge.color = "black", node.color = "black", tip.color = "black", edge.width = 1, ...) -} + +\usage{ tip.data.plot(xxyy, type = c("phylogram", "cladogram", "fan"), +show.tip.label = TRUE, show.node.label = FALSE, rot = 0, tip.plot.fun = +grid.points, edge.color = "black", node.color = "black", tip.color = +"black", edge.width = 1, ...) } + + \arguments{ \item{xxyy}{A list created by the \code{\link{phyloXXYY}} function} \item{type}{ A character string indicating the shape of plotted tree } From noreply at r-forge.r-project.org Fri Mar 14 21:31:35 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Mar 2014 21:31:35 +0100 (CET) Subject: [Phylobase-commits] r867 - pkg Message-ID: <20140314203135.A6E8B187038@r-forge.r-project.org> Author: francois Date: 2014-03-14 21:31:35 +0100 (Fri, 14 Mar 2014) New Revision: 867 Modified: pkg/DESCRIPTION Log: updating version, changing maintainer Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2014-03-14 20:30:07 UTC (rev 866) +++ pkg/DESCRIPTION 2014-03-14 20:31:35 UTC (rev 867) @@ -1,8 +1,8 @@ Package: phylobase Type: Package Title: Base package for phylogenetic structures and comparative data -Version: 0.6.7 -Date: 2014-03-10 +Version: 0.6.7-1 +Date: 2014-03-14 Depends: methods, grid, @@ -18,7 +18,7 @@ Peter Cowan, Damien de Vienne, Dirk Eddelbuettel, Mark Holder, Thibaut Jombart, Steve Kembel, Francois Michonneau, David Orme, Brian O'Meara, Emmanuel Paradis, Jim Regetz, Derrick Zwickl) -Maintainer: Ben Bolker +Maintainer: Francois Michonneau Description: Provides a base S4 class for comparative methods, incorporating one or more trees and trait data License: GPL (>= 2) From noreply at r-forge.r-project.org Fri Mar 14 21:36:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Mar 2014 21:36:31 +0100 (CET) Subject: [Phylobase-commits] r868 - in pkg: . R Message-ID: <20140314203631.90052187089@r-forge.r-project.org> Author: francois Date: 2014-03-14 21:36:31 +0100 (Fri, 14 Mar 2014) New Revision: 868 Removed: pkg/misc/ Modified: pkg/R/pdata.R Log: moving chunk of code that was in non-standard folder Modified: pkg/R/pdata.R =================================================================== --- pkg/R/pdata.R 2014-03-14 20:31:35 UTC (rev 867) +++ pkg/R/pdata.R 2014-03-14 20:36:31 UTC (rev 868) @@ -2,6 +2,20 @@ ptypes <- c("multitype","binary","continuous","DNA","RNA","aacid", "other","unknown") +#' Class "pdata" +#' +#' Data class for phylo4d objects +#' +#' +#' @name pdata-class +#' @aliases ptypes pdata-class [<-,pdata-method [,pdata-method +#' [,pdata,ANY,ANY,ANY-method [[,pdata-method [[<-,pdata-method +#' [[,pdata,ANY,ANY-method [[,pdata,ANY,missing-method +#' @docType class +#' @section Objects from the Class: Objects can be created by calls of the form +#' \code{new("pdata", ...)}. +#' @author Ben Bolker +#' @keywords classes setClass("pdata", representation(data="data.frame", type="factor", comment="character", @@ -10,6 +24,25 @@ comment=character(0),metadata=list())) ## pdata constructor + + +#' Constructor for pdata (phylogenetic data) class +#' +#' Combine data, type, comments, and metadata information to create a new pdata +#' object, or check such an object for consistency +#' +#' +#' @aliases pdata check_pdata +#' @param data a data frame +#' @param type a factor with levels as specified by \linkS4class{pdata}, the +#' same length as \code{ncol(data)} +#' @param comment a character vector, the same length as \code{ncol(data)} +#' @param metadata an arbitrary list +#' @param object an object of class \code{pdata} +#' @return An object of class \code{pdata} +#' @author Ben Bolker +#' @seealso \linkS4class{pdata} +#' @keywords misc pdata <- function(data,type,comment,metadata) { nvar <- ncol(data) if (missing(type)) { @@ -72,4 +105,39 @@ ## z[,"a"] ## z[[2]] -## test conflict resolution error \ No newline at end of file +## test conflict resolution error + +####### +### old code retrieved from misc/ folder + +## setClass("pdata", representation(x="vector", y="vector")) +## setMethod("[","pdata",function(x,i, j,...,drop=TRUE)new("pdata",x=x at x[i],y=x at y[i])) + +# x <- new("pdata", x=c("a","b", "c", "d", "3"), y=c(1:5)) +#>x[c(2,4)] +#An object of class ?pdata? +#Slot "x": +#[1] "b" "d" +# +#Slot "y": +#[1] 2 4 + + + +# doesn't work +#setClass("track", representation("list", comment="character", metadata="vector"), contains="list", prototype(list(), comment="", metadata=NA)) +#setMethod("[","track",function(x,i, j,...,drop=TRUE)new("track", list(lapply(x, function(x, i, j, ..., drop=TRUE) x at .Data[i])))) + +# this works, how to incorporate into method above? +#> lapply(x, function(x, i=2, j, ..., drop=TRUE) x at .Data[i]) +#$x +#[1] "b" + +#$y +#[1] 2 + +# this works, but list structure is destroyed +#> mapply(function(x, i, j, ..., drop=TRUE) x at .Data[i], x, 2) +# x y +#"b" "2" + From noreply at r-forge.r-project.org Fri Mar 14 22:10:04 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Mar 2014 22:10:04 +0100 (CET) Subject: [Phylobase-commits] r869 - pkg/tests Message-ID: <20140314211004.5889A18459B@r-forge.r-project.org> Author: francois Date: 2014-03-14 22:10:04 +0100 (Fri, 14 Mar 2014) New Revision: 869 Modified: pkg/tests/phylotorture.Rout.save Log: a few more tweaks to avoid diff with R check output Modified: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save 2014-03-14 20:36:31 UTC (rev 868) +++ pkg/tests/phylotorture.Rout.save 2014-03-14 21:10:04 UTC (rev 869) @@ -17,22 +17,17 @@ 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. -[Previously saved workspace restored] - > ## torture-testing phylo4 objects. > require(phylobase) Loading required package: phylobase -Loading required package: grid -Loading required package: Rcpp +Warning message: +In library(package, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE, : + there is no package called ?phylobase? > require(ape) Loading required package: ape - -Attaching package: ?ape? - -The following object is masked from ?package:phylobase?: - - edges - +Warning message: +In library(package, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE, : + there is no package called ?ape? > set.seed(1001) > p1 <- list() > n <- 10 @@ -44,24 +39,11 @@ + e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2) + p1[[i]] <- try(phylo4(e),silent=TRUE) + } -Warning messages: -1: In checkTree(object) : Tree contains singleton nodes. -2: In checkTree(object) : Tree contains singleton nodes. -3: In checkTree(object) : Tree contains singleton nodes. -4: In checkTree(object) : Tree contains singleton nodes. -5: In checkTree(object) : Tree contains singleton nodes. -6: In checkTree(object) : Tree contains singleton nodes. -7: In checkTree(object) : Tree contains singleton nodes. -8: In checkTree(object) : Tree contains singleton nodes. > OKvals <- sapply(p1, class) != "try-error" > ## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with > ## R check because of different width of terminal/output, trying something simpler: > message(unique(sapply(p1[!OKvals], as.character))) -Error in .local(x, ...) : - Tips incorrectly labeled. Nodes incorrectly labeled. -Error in names(res) <- switch(type, tip = 1:ntips, internal = seq(from = ntips + : - 'names' attribute [2] must be the same length as the vector [1] -Error in .local(x, ...) : Nodes incorrectly labeled. +Error in try(phylo4(e), silent = TRUE) : could not find function "phylo4" > > if (any(OKvals)) { @@ -101,124 +83,5 @@ > # a disconnected node: > > t1 <- read.tree (text="((a,b), (c,(d, e)));") -> plot(t1) -> -> broke1 <- t1 -> broke1$edge[broke1$edge[,2] ==9, 1] <- 9 # disconnect the node, two subtrees, ((a, b), c) and (d,e) -> -> try(as(broke1, "phylo4") -> tree, silent=TRUE) # makes a phylo4 object with no warning -Warning messages: -1: In checkTree(object) : Tree contains singleton nodes. -2: In checkTree(object) : Tree contains singleton nodes. -3: In checkTree(object) : Tree contains singleton nodes. -> try(phylo4(broke1$edge), silent=TRUE) # constructor makes a phylo4 object with no warning - label node ancestor edge.length node.type -1 T1 1 7 NA tip -2 T2 2 7 NA tip -3 T3 3 8 NA tip -4 T4 4 9 NA tip -5 T5 5 9 NA tip -6 6 0 NA internal -7 7 6 NA internal -8 8 6 NA internal -9 9 9 NA internal -Warning messages: -1: In checkTree(object) : Tree contains singleton nodes. -2: In checkTree(object) : Tree contains singleton nodes. -> ## error message comes from ape, not phylo? -- AND -> ## error is about singles, not disconnected nodes -> ## print(try(plot(tree), silent=TRUE )) ## pdc couldn't get this to work, so temporarily commenting -> -> # root node value != ntips + 1: -> -> broke2 <- t1 -> broke2$edge[broke2$edge==6] <- 10 -> -> ## warning, but no error -> ## plot(broke2) ## seems to hang R CMD check?? -> ## generates error, but it's about wrong number of tips, not wrong value at root. -> print(try(as(broke2, "phylo4"), silent=TRUE)) -[1] "Error in .createLabels(value = tip.label, ntips = ntips, nnodes = nnodes, : \n Number of labels does not match number of nodes.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> ## error regarding number of tip labels vs edges and nodes -> print(try(phylo4(broke2$edge), silent=TRUE)) -[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> -> # switch root node value (6) with next internal node (7): -> -> broke3 <- broke2 -> broke3$edge[broke3$edge==7] <- 6 -> broke3$edge[broke3$edge==10] <- 7 -> -> ## both of the following now fail with -> ## "root node is not at position (nTips+1) -> try(as(broke3,"phylo4") -> tree3) # works with no error message -> try(phylo4(broke3$edge)) # works with no error message - label node ancestor edge.length node.type -1 T1 1 6 NA tip -2 T2 2 6 NA tip -3 T3 3 8 NA tip -4 T4 4 9 NA tip -5 T5 5 9 NA tip -6 6 7 NA internal -7 7 0 NA internal -8 8 7 NA internal -9 9 8 NA internal -> ## plot(tree3) # would work if we could create it? -> -> -> # tips have larger numbers than root node: -> -> broke4 <- t1 -> broke4$edge[broke4$edge==1] <- 11 -> broke4$edge[broke4$edge==2] <- 12 -> broke4$edge[broke4$edge==3] <- 13 -> broke4$edge[broke4$edge==4] <- 14 -> broke4$edge[broke4$edge==5] <- 15 -> -> print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root -[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root -[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> # print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG! -> -> ### -> foo <- new('phylo4') -> set.seed(1001) -> foo at edge <- rcoal(10)$edge -> print(try(plot(foo))) -Error in treePlot(x, ...) : treePlot function requires a rooted tree. -[1] "Error in treePlot(x, ...) : treePlot function requires a rooted tree.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> -> foo at label <- c(rep('blah',10), rep("",9)) -> -> ##### -> ## tree with only 2 tips: will fail under previous versions -> ## with "Error in if (which(nAncest == 0) != nTips + 1) { : -> ## argument is of length zero" -> -> edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2) -> try(p2 <- phylo4(edge), silent=TRUE) -> -> proc.time() - user system elapsed - 5.708 0.195 5.887 +Error: could not find function "read.tree" +Execution halted From noreply at r-forge.r-project.org Fri Mar 14 23:56:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Mar 2014 23:56:06 +0100 (CET) Subject: [Phylobase-commits] r870 - pkg/tests Message-ID: <20140314225606.4897B186E63@r-forge.r-project.org> Author: francois Date: 2014-03-14 23:56:05 +0100 (Fri, 14 Mar 2014) New Revision: 870 Modified: pkg/tests/phylotorture.Rout.save Log: previous commit was wrong output file Modified: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save 2014-03-14 21:10:04 UTC (rev 869) +++ pkg/tests/phylotorture.Rout.save 2014-03-14 22:56:05 UTC (rev 870) @@ -20,14 +20,17 @@ > ## torture-testing phylo4 objects. > require(phylobase) Loading required package: phylobase -Warning message: -In library(package, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE, : - there is no package called ?phylobase? +Loading required package: grid +Loading required package: Rcpp > require(ape) Loading required package: ape -Warning message: -In library(package, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE, : - there is no package called ?ape? + +Attaching package: ?ape? + +The following object is masked from ?package:phylobase?: + + edges + > set.seed(1001) > p1 <- list() > n <- 10 @@ -39,11 +42,24 @@ + e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2) + p1[[i]] <- try(phylo4(e),silent=TRUE) + } +Warning messages: +1: In checkTree(object) : Tree contains singleton nodes. +2: In checkTree(object) : Tree contains singleton nodes. +3: In checkTree(object) : Tree contains singleton nodes. +4: In checkTree(object) : Tree contains singleton nodes. +5: In checkTree(object) : Tree contains singleton nodes. +6: In checkTree(object) : Tree contains singleton nodes. +7: In checkTree(object) : Tree contains singleton nodes. +8: In checkTree(object) : Tree contains singleton nodes. > OKvals <- sapply(p1, class) != "try-error" > ## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with > ## R check because of different width of terminal/output, trying something simpler: > message(unique(sapply(p1[!OKvals], as.character))) -Error in try(phylo4(e), silent = TRUE) : could not find function "phylo4" +Error in .local(x, ...) : + Tips incorrectly labeled. Nodes incorrectly labeled. +Error in names(res) <- switch(type, tip = 1:ntips, internal = seq(from = ntips + : + 'names' attribute [2] must be the same length as the vector [1] +Error in .local(x, ...) : Nodes incorrectly labeled. > > if (any(OKvals)) { @@ -83,5 +99,124 @@ > # a disconnected node: > > t1 <- read.tree (text="((a,b), (c,(d, e)));") -Error: could not find function "read.tree" -Execution halted +> plot(t1) +> +> broke1 <- t1 +> broke1$edge[broke1$edge[,2] ==9, 1] <- 9 # disconnect the node, two subtrees, ((a, b), c) and (d,e) +> +> try(as(broke1, "phylo4") -> tree, silent=TRUE) # makes a phylo4 object with no warning +Warning messages: +1: In checkTree(object) : Tree contains singleton nodes. +2: In checkTree(object) : Tree contains singleton nodes. +3: In checkTree(object) : Tree contains singleton nodes. +> try(phylo4(broke1$edge), silent=TRUE) # constructor makes a phylo4 object with no warning + label node ancestor edge.length node.type +1 T1 1 7 NA tip +2 T2 2 7 NA tip +3 T3 3 8 NA tip +4 T4 4 9 NA tip +5 T5 5 9 NA tip +6 6 0 NA internal +7 7 6 NA internal +8 8 6 NA internal +9 9 9 NA internal +Warning messages: +1: In checkTree(object) : Tree contains singleton nodes. +2: In checkTree(object) : Tree contains singleton nodes. +> ## error message comes from ape, not phylo? -- AND +> ## error is about singles, not disconnected nodes +> ## print(try(plot(tree), silent=TRUE )) ## pdc couldn't get this to work, so temporarily commenting +> +> # root node value != ntips + 1: +> +> broke2 <- t1 +> broke2$edge[broke2$edge==6] <- 10 +> +> ## warning, but no error +> ## plot(broke2) ## seems to hang R CMD check?? +> ## generates error, but it's about wrong number of tips, not wrong value at root. +> print(try(as(broke2, "phylo4"), silent=TRUE)) +[1] "Error in .createLabels(value = tip.label, ntips = ntips, nnodes = nnodes, : \n Number of labels does not match number of nodes.\n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> ## error regarding number of tip labels vs edges and nodes +> print(try(phylo4(broke2$edge), silent=TRUE)) +[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> +> # switch root node value (6) with next internal node (7): +> +> broke3 <- broke2 +> broke3$edge[broke3$edge==7] <- 6 +> broke3$edge[broke3$edge==10] <- 7 +> +> ## both of the following now fail with +> ## "root node is not at position (nTips+1) +> try(as(broke3,"phylo4") -> tree3) # works with no error message +> try(phylo4(broke3$edge)) # works with no error message + label node ancestor edge.length node.type +1 T1 1 6 NA tip +2 T2 2 6 NA tip +3 T3 3 8 NA tip +4 T4 4 9 NA tip +5 T5 5 9 NA tip +6 6 7 NA internal +7 7 0 NA internal +8 8 7 NA internal +9 9 8 NA internal +> ## plot(tree3) # would work if we could create it? +> +> +> # tips have larger numbers than root node: +> +> broke4 <- t1 +> broke4$edge[broke4$edge==1] <- 11 +> broke4$edge[broke4$edge==2] <- 12 +> broke4$edge[broke4$edge==3] <- 13 +> broke4$edge[broke4$edge==4] <- 14 +> broke4$edge[broke4$edge==5] <- 15 +> +> print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root +[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root +[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> # print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG! +> +> ### +> foo <- new('phylo4') +> set.seed(1001) +> foo at edge <- rcoal(10)$edge +> print(try(plot(foo))) +Error in treePlot(x, ...) : treePlot function requires a rooted tree. +[1] "Error in treePlot(x, ...) : treePlot function requires a rooted tree.\n" +attr(,"class") +[1] "try-error" +attr(,"condition") + +> +> foo at label <- c(rep('blah',10), rep("",9)) +> +> ##### +> ## tree with only 2 tips: will fail under previous versions +> ## with "Error in if (which(nAncest == 0) != nTips + 1) { : +> ## argument is of length zero" +> +> edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2) +> try(p2 <- phylo4(edge), silent=TRUE) +> +> proc.time() + user system elapsed + 5.557 0.099 5.638 From noreply at r-forge.r-project.org Mon Mar 17 03:14:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 03:14:44 +0100 (CET) Subject: [Phylobase-commits] r871 - pkg Message-ID: <20140317021444.4CCCD1867DC@r-forge.r-project.org> Author: francois Date: 2014-03-17 03:14:42 +0100 (Mon, 17 Mar 2014) New Revision: 871 Modified: pkg/cleanup Log: removing files sometimes generated by R CMD check locally by phylotorture.R Modified: pkg/cleanup =================================================================== --- pkg/cleanup 2014-03-14 22:56:05 UTC (rev 870) +++ pkg/cleanup 2014-03-17 02:14:42 UTC (rev 871) @@ -60,3 +60,5 @@ rm -f src/ncl/example/translate/Makefile rm -f src/ncl/ncl/.deps rm -f src/ncl/ncl/Makefile +rm -f tests/.RData +rm -r tests/Rplot.pdf From noreply at r-forge.r-project.org Mon Mar 17 03:15:26 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 03:15:26 +0100 (CET) Subject: [Phylobase-commits] r872 - pkg Message-ID: <20140317021526.176EF186824@r-forge.r-project.org> Author: francois Date: 2014-03-17 03:15:25 +0100 (Mon, 17 Mar 2014) New Revision: 872 Modified: pkg/cleanup Log: fixed typo Modified: pkg/cleanup =================================================================== --- pkg/cleanup 2014-03-17 02:14:42 UTC (rev 871) +++ pkg/cleanup 2014-03-17 02:15:25 UTC (rev 872) @@ -61,4 +61,4 @@ rm -f src/ncl/ncl/.deps rm -f src/ncl/ncl/Makefile rm -f tests/.RData -rm -r tests/Rplot.pdf +rm -r tests/Rplots.pdf From noreply at r-forge.r-project.org Mon Mar 17 06:27:20 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 06:27:20 +0100 (CET) Subject: [Phylobase-commits] r873 - pkg/tests Message-ID: <20140317052720.71A06186A2B@r-forge.r-project.org> Author: francois Date: 2014-03-17 06:27:19 +0100 (Mon, 17 Mar 2014) New Revision: 873 Removed: pkg/tests/RUnit-tests.R pkg/tests/RUnit-tests.Rout.save Modified: pkg/tests/misctests.R pkg/tests/phylo4dtests.R pkg/tests/phylosubtest.R pkg/tests/phylotorture.R pkg/tests/plottest.R Log: removed old files. Deleted: pkg/tests/RUnit-tests.R =================================================================== --- pkg/tests/RUnit-tests.R 2014-03-17 02:15:25 UTC (rev 872) +++ pkg/tests/RUnit-tests.R 2014-03-17 05:27:19 UTC (rev 873) @@ -1,7 +0,0 @@ -require(RUnit) -## TODO -- find solution to run these tests on R-forge - -##testsuite <- defineTestSuite("phylobase", dirs="/home/francois/Work/R-dev/phylobase/branches/fm-branch/RUnit-tests", -## testFileRegexp="^test", testFuncRegexp="^test") -##testRslt <- runTestSuite(testsuite) -##printTextProtocol(testRslt) Deleted: pkg/tests/RUnit-tests.Rout.save =================================================================== --- pkg/tests/RUnit-tests.Rout.save 2014-03-17 02:15:25 UTC (rev 872) +++ pkg/tests/RUnit-tests.Rout.save 2014-03-17 05:27:19 UTC (rev 873) @@ -1,32 +0,0 @@ - -R version 2.12.0 (2010-10-15) -Copyright (C) 2010 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: x86_64-pc-linux-gnu (64-bit) - -R is free software and comes with ABSOLUTELY NO WARRANTY. -You are welcome to redistribute it under certain conditions. -Type 'license()' or 'licence()' for distribution details. - - Natural language support but running in an English locale - -R is a collaborative project with many contributors. -Type 'contributors()' for more information and -'citation()' on how to cite R or R packages in publications. - -Type 'demo()' for some demos, 'help()' for on-line help, or -'help.start()' for an HTML browser interface to help. -Type 'q()' to quit R. - -> require(RUnit) -Loading required package: RUnit -> ## TODO -- find solution to run these tests on R-forge -> -> ##testsuite <- defineTestSuite("phylobase", dirs="/home/francois/Work/R-dev/phylobase/branches/fm-branch/RUnit-tests", -> ## testFileRegexp="^test", testFuncRegexp="^test") -> ##testRslt <- runTestSuite(testsuite) -> ##printTextProtocol(testRslt) -> -> proc.time() - user system elapsed - 0.34 0.02 0.36 Modified: pkg/tests/misctests.R =================================================================== --- pkg/tests/misctests.R 2014-03-17 02:15:25 UTC (rev 872) +++ pkg/tests/misctests.R 2014-03-17 05:27:19 UTC (rev 873) @@ -1,112 +1,97 @@ -library(phylobase) -library(ape) -set.seed(1) +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) -data(geospiza) +R is free software and comes with ABSOLUTELY NO WARRANTY. +You are welcome to redistribute it under certain conditions. +Type 'license()' or 'licence()' for distribution details. -## make sure geospiza is properly formatted -if(is.character(checkval <- checkPhylo4(geospiza))) - stop(checkval) - + Natural language support but running in an English locale -geospiza0 <- - list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tipData(geospiza)) -## push data back into list form as in geiger +R is a collaborative project with many contributors. +Type 'contributors()' for more information and +'citation()' on how to cite R or R packages in publications. -t1 <- try(p1 <- phylo4d(geospiza0$geospiza.tree,geospiza0$geospiza.data)) -## Error in checkData(res, ...) : -## Tip data names are a subset of tree tip labels. +Type 'demo()' for some demos, 'help()' for on-line help, or +'help.start()' for an HTML browser interface to help. +Type 'q()' to quit R. -p2 <- as(geospiza0$geospiza.tree,"phylo4") -plot(p2) +> ## RUnit script obtained from: +> ## http://wiki.r-project.org/rwiki/doku.php?id=developers:runit +> +> ## unit tests will not be done if RUnit is not available +> if(require("RUnit", quietly=TRUE)) { ++ ++ ## --- Setup --- ++ ++ pkg <- "phylobase" ++ if(Sys.getenv("RCMDCHECK") == "FALSE") { ++ ## Path to unit tests for standalone running under Makefile (not R CMD check) ++ ## PKG/tests/../inst/unitTests ++ path <- file.path(getwd(), "..", "inst", "unitTests") ++ } else { ++ ## Path to unit tests for R CMD check ++ ## PKG.Rcheck/tests/../PKG/unitTests ++ path <- system.file(package=pkg, "unitTests") ++ } ++ cat("\nRunning unit tests\n") ++ print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path)) ++ ++ library(package=pkg, character.only=TRUE) ++ ++ ## If desired, load the name space to allow testing of private functions ++ ## if (is.element(pkg, loadedNamespaces())) ++ ## attach(loadNamespace(pkg), name=paste("namespace", pkg, sep=":"), pos=3) ++ ## ++ ## or simply call PKG:::myPrivateFunction() in tests ++ ++ ## --- Testing --- ++ ++ ## Define tests ++ testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), ++ dirs=path) ++ ## Run ++ tests <- runTestSuite(testSuite) ++ ++ ## Default report name ++ pathReport <- file.path(path, "report") ++ ++ ## Report to stdout and text files ++ cat("------------------- UNIT TEST SUMMARY ---------------------\n\n") ++ printTextProtocol(tests, showDetails=FALSE) ++ printTextProtocol(tests, showDetails=FALSE, ++ fileName=paste(pathReport, "Summary.txt", sep="")) ++ printTextProtocol(tests, showDetails=TRUE, ++ fileName=paste(pathReport, ".txt", sep="")) ++ ++ ## Report to HTML file ++ printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep="")) ++ ++ ## Return stop() to cause R CMD check stop in case of ++ ## - failures i.e. FALSE to unit tests or ++ ## - errors i.e. R errors ++ tmp <- getErrors(tests) ++ if(tmp$nFail > 0 | tmp$nErr > 0) { ++ stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, ++ ", #R errors: ", tmp$nErr, ")\n\n", sep="")) ++ } ++ } else { ++ warning("cannot run unit tests -- package RUnit is not available") ++ } -lab1 <- tipLabels(p2) -lab2 <- rownames(geospiza0$geospiza.data) +Running unit tests +$pkg +[1] "phylobase" -lab1[!lab1 %in% lab2] ## missing data -lab2[!lab2 %in% lab1] ## extra data (none) -p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="warn") -p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="OK") +$getwd +[1] "/home/francois/R-dev/phylobase/pkg/tests" -plot(p1) -plot(p1,show.node.label=TRUE) -## one way to deal with it: +$pathToUnitTests +[1] "/home/francois/.R/library/phylobase/unitTests" -p1B <- prune(p1,tip="olivacea") -## or ... -p1C <- na.omit(p1) - -labels(p1C, "all") <- tolower(labels(p1C, "all")) - -## trace("prune",browser,signature="phylo4d") -r1 <- read.tree(text="((t4:0.3210275554,(t2:0.2724586465,t3:0.2724586465):0.0485689089):0.1397952619,(t5:0.07551818331,t1:0.07551818331):0.385304634);") - -## trace("phylo4d", browser, signature = "phylo") -## untrace("phylo4d", signature = "phylo") -tipdat <- data.frame(a=1:5, row.names=r1$tip.label) -q1 <- phylo4d(r1,tip.data=tipdat, node.data=data.frame(a=6:9), match.data=FALSE) -q2 <- prune(q1,1) -summary(q2) - -tipdat2 <- tipdat -row.names(tipdat2)[1] <- "s1" -t1 <- try(q1 <- phylo4d(r1,tip.data=tipdat2)) - -plot(q2) -plot(q2,type="cladogram") -## plot(p2,type="dotchart",labels.nodes=nodeLabels(p2)) -## trace("plot", browser, signature = c("phylo4d","missing")) -tipLabels(q1) <- paste("q",1:5,sep="") -nodeLabels(q1) <- paste("n",1:4,sep="") -p3 <- phylo4d(r1,tip.data=tipdat,node.data=data.frame(b=6:9), match.data=FALSE) -summary(p3) - -plot(p1) - -plot(subset(p1,tips.include=c("fuliginosa","fortis","magnirostris", - "conirostris","scandens"))) -## better error? -## Error in phy$edge[, 2] : incorrect number of dimensions - -if(dev.cur() == 1) get(getOption("device"))() -plot(subset(p2,tips.include=c("fuliginosa","fortis","magnirostris", - "conirostris","scandens"))) - -plot(p2,show.node.label=TRUE) - -tree.owls <- read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);") - -z <- as(tree.owls,"phylo4") - -example("phylo4d") -obj1 <- obj2 <- obj3 <- phylo4d(z, data.frame(wing=1:4,color=factor(c("b","w","b","b")), tail=runif(4)*10), match.data=FALSE) - -obj2 at data <- as.data.frame(obj2 at data[,1]) -obj3 at data <- cbind(obj1 at data,obj2 at data) -obj4 <- obj1 -obj4 at data[2,3] <- NA -obj4 at data[1,1] <- NA - -nodeLabels(obj4) <- character(0) - -obj5 <- obj1 -tipData(obj4) <- subset(tipData(obj4),select=sapply(tipData(obj4),class)=="numeric") - -treePlot(obj4) - -E <- matrix(c( - 8, 9, - 9, 10, - 10, 1, - 10, 2, - 9, 3, - 9, 4, - 8, 11, - 11, 5, - 11, 6, - 11, 7, - 0, 8), ncol=2,byrow=TRUE) - -P2 <- phylo4(E) +Warning messages: +1: replacing previous import by ?Rcpp::evalCpp? when loading ?phylobase? +2: replacing previous import by ?ade4::newick2phylog? when loading ?phylobase? +Execution halted Modified: pkg/tests/phylo4dtests.R =================================================================== --- pkg/tests/phylo4dtests.R 2014-03-17 02:15:25 UTC (rev 872) +++ pkg/tests/phylo4dtests.R 2014-03-17 05:27:19 UTC (rev 873) @@ -1,5 +1,5 @@ library(phylobase) -require(ape) +library(ape) tree.phylo <- read.tree(text="(((A,B)C,D),E);") #only one node is labelled tree <- as(tree.phylo, "phylo4") Modified: pkg/tests/phylosubtest.R =================================================================== --- pkg/tests/phylosubtest.R 2014-03-17 02:15:25 UTC (rev 872) +++ pkg/tests/phylosubtest.R 2014-03-17 05:27:19 UTC (rev 873) @@ -1,4 +1,5 @@ -require(phylobase) +library(phylobase) +library(ape) data(geospiza) gtree <- extractTree(geospiza) Modified: pkg/tests/phylotorture.R =================================================================== --- pkg/tests/phylotorture.R 2014-03-17 02:15:25 UTC (rev 872) +++ pkg/tests/phylotorture.R 2014-03-17 05:27:19 UTC (rev 873) @@ -1,29 +1,38 @@ ## torture-testing phylo4 objects. -require(phylobase) -require(ape) -set.seed(1001) -p1 <- list() -n <- 10 +library(phylobase) +library(ape) + +set.seed(10101) +n <- 200 +p1 <- vector("list", n) ## don't want to slow down R CMD check by doing this every time: ## n <- 10000 for (i in 1:n) { -## e2 <- c(sample(1:5,replace=FALSE,size=5),sample(6:10,replace=FALSE,size=5)) -## e1 <- sample(6:10,replace=TRUE - e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2) - p1[[i]] <- try(phylo4(e),silent=TRUE) + if (i <= n/2) { + e <- matrix(sample(1:10, replace=TRUE, size=10), ncol=2) + } + else { + e <- cbind(sample(rep(11:19, 2)), sample(1:19)) + e <- rbind(c(0, sample(11:19, 1)), e) + } + p1[[i]] <- try(phylo4(e), silent=TRUE) } OKvals <- sapply(p1, class) != "try-error" ## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with ## R check because of different width of terminal/output, trying something simpler: message(unique(sapply(p1[!OKvals], as.character))) +unname(table(sapply(p1[!OKvals], as.character))) +if (sum(OKvals)) message("There are ", sum(OKvals), " valid trees...") if (any(OKvals)) { p2 <- p1[OKvals] length(p2) - has.poly <- sapply(p2,hasPoly) - has.sing <- sapply(p2,hasSingle) - has.retic <- sapply(p2,hasRetic) - ## + has.poly <- sapply(p2, hasPoly) + has.sing <- sapply(p2, hasSingle) + has.retic <- sapply(p2, hasRetic) + message("number of trees with polytomies: ", sum(has.poly)) + message("number of trees with singletons: ", sum(has.sing)) + message("number of trees with reticulation: ", sum(has.retic)) if (any(has.sing)) { p4 <- p2[has.sing] plot(p4[[1]]) ## gives descriptive error @@ -73,9 +82,9 @@ ## warning, but no error ## plot(broke2) ## seems to hang R CMD check?? ## generates error, but it's about wrong number of tips, not wrong value at root. -print(try(as(broke2, "phylo4"), silent=TRUE)) +message(try(as(broke2, "phylo4"), silent=TRUE)) ## error regarding number of tip labels vs edges and nodes -print(try(phylo4(broke2$edge), silent=TRUE)) +message(try(phylo4(broke2$edge), silent=TRUE)) # switch root node value (6) with next internal node (7): @@ -99,15 +108,15 @@ broke4$edge[broke4$edge==4] <- 14 broke4$edge[broke4$edge==5] <- 15 -print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root -print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root +message(try(as(broke4, "phylo4"), silent=TRUE)) +message(try(phylo4(broke4$edge), silent=TRUE)) # print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG! ### foo <- new('phylo4') -set.seed(1001) + foo at edge <- rcoal(10)$edge -print(try(plot(foo))) +message(try(plot(foo))) foo at label <- c(rep('blah',10), rep("",9)) @@ -116,5 +125,5 @@ ## with "Error in if (which(nAncest == 0) != nTips + 1) { : ## argument is of length zero" -edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2) +edge <- matrix(c(3, 1, 3, 2), byrow=TRUE, ncol=2) try(p2 <- phylo4(edge), silent=TRUE) Modified: pkg/tests/plottest.R =================================================================== --- pkg/tests/plottest.R 2014-03-17 02:15:25 UTC (rev 872) +++ pkg/tests/plottest.R 2014-03-17 05:27:19 UTC (rev 873) @@ -1,5 +1,5 @@ library(phylobase) -## library(ape) +library(ape) data(geospiza) g1 <- as(geospiza,"phylo4") From noreply at r-forge.r-project.org Mon Mar 17 13:48:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 13:48:09 +0100 (CET) Subject: [Phylobase-commits] r874 - pkg/tests Message-ID: <20140317124809.A8ED4185F4A@r-forge.r-project.org> Author: francois Date: 2014-03-17 13:48:09 +0100 (Mon, 17 Mar 2014) New Revision: 874 Removed: pkg/tests/nexusdata.R Log: remove old test file Deleted: pkg/tests/nexusdata.R =================================================================== --- pkg/tests/nexusdata.R 2014-03-17 05:27:19 UTC (rev 873) +++ pkg/tests/nexusdata.R 2014-03-17 12:48:09 UTC (rev 874) @@ -1,17 +0,0 @@ -## try to read NEXUS files -## library(phylobase) -## fn <- system.file("nexusfiles/treepluscharV01.nex",package="phylobase") -## td<-NexusToPhylo4D(fn) -## summary(td) -## would try plotting, but typically don't have enough room -## to plot data -## Error in .local(x, ...) : -## No room left to plot data; please try reducing ratio.tree or cex.label. -## plot(as(td,"phylo4")) - -## try to read a nexus file where the newick string describing the tree is split -## across several lines -## multiLine <- system.file("nexusfiles/MultiLineTrees.nex",package="phylobase") -## multiLineTrees <-NexusToPhylo4(multiLine) -## summary(multiLineTrees) - From noreply at r-forge.r-project.org Mon Mar 17 14:13:03 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 14:13:03 +0100 (CET) Subject: [Phylobase-commits] r875 - pkg/tests Message-ID: <20140317131303.26841184965@r-forge.r-project.org> Author: francois Date: 2014-03-17 14:13:02 +0100 (Mon, 17 Mar 2014) New Revision: 875 Modified: pkg/tests/misctests.R pkg/tests/misctests.Rout.save pkg/tests/phylo4dtests.Rout.save pkg/tests/phylosubtest.Rout.save pkg/tests/phylotorture.Rout.save pkg/tests/plottest.Rout.save pkg/tests/roundtrip.R pkg/tests/roundtrip.Rout.save pkg/tests/testprune.Rout.save Log: updated tests and output Modified: pkg/tests/misctests.R =================================================================== --- pkg/tests/misctests.R 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/misctests.R 2014-03-17 13:13:02 UTC (rev 875) @@ -1,97 +1,112 @@ +library(phylobase) +library(ape) -R version 3.0.3 (2014-03-06) -- "Warm Puppy" -Copyright (C) 2014 The R Foundation for Statistical Computing -Platform: x86_64-pc-linux-gnu (64-bit) +set.seed(1) -R is free software and comes with ABSOLUTELY NO WARRANTY. -You are welcome to redistribute it under certain conditions. -Type 'license()' or 'licence()' for distribution details. +data(geospiza) - Natural language support but running in an English locale +## make sure geospiza is properly formatted +if(is.character(checkval <- checkPhylo4(geospiza))) + stop(checkval) + -R is a collaborative project with many contributors. -Type 'contributors()' for more information and -'citation()' on how to cite R or R packages in publications. +geospiza0 <- + list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tipData(geospiza)) +## push data back into list form as in geiger -Type 'demo()' for some demos, 'help()' for on-line help, or -'help.start()' for an HTML browser interface to help. -Type 'q()' to quit R. +t1 <- try(p1 <- phylo4d(geospiza0$geospiza.tree,geospiza0$geospiza.data)) +## Error in checkData(res, ...) : +## Tip data names are a subset of tree tip labels. -> ## RUnit script obtained from: -> ## http://wiki.r-project.org/rwiki/doku.php?id=developers:runit -> -> ## unit tests will not be done if RUnit is not available -> if(require("RUnit", quietly=TRUE)) { -+ -+ ## --- Setup --- -+ -+ pkg <- "phylobase" -+ if(Sys.getenv("RCMDCHECK") == "FALSE") { -+ ## Path to unit tests for standalone running under Makefile (not R CMD check) -+ ## PKG/tests/../inst/unitTests -+ path <- file.path(getwd(), "..", "inst", "unitTests") -+ } else { -+ ## Path to unit tests for R CMD check -+ ## PKG.Rcheck/tests/../PKG/unitTests -+ path <- system.file(package=pkg, "unitTests") -+ } -+ cat("\nRunning unit tests\n") -+ print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path)) -+ -+ library(package=pkg, character.only=TRUE) -+ -+ ## If desired, load the name space to allow testing of private functions -+ ## if (is.element(pkg, loadedNamespaces())) -+ ## attach(loadNamespace(pkg), name=paste("namespace", pkg, sep=":"), pos=3) -+ ## -+ ## or simply call PKG:::myPrivateFunction() in tests -+ -+ ## --- Testing --- -+ -+ ## Define tests -+ testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), -+ dirs=path) -+ ## Run -+ tests <- runTestSuite(testSuite) -+ -+ ## Default report name -+ pathReport <- file.path(path, "report") -+ -+ ## Report to stdout and text files -+ cat("------------------- UNIT TEST SUMMARY ---------------------\n\n") -+ printTextProtocol(tests, showDetails=FALSE) -+ printTextProtocol(tests, showDetails=FALSE, -+ fileName=paste(pathReport, "Summary.txt", sep="")) -+ printTextProtocol(tests, showDetails=TRUE, -+ fileName=paste(pathReport, ".txt", sep="")) -+ -+ ## Report to HTML file -+ printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep="")) -+ -+ ## Return stop() to cause R CMD check stop in case of -+ ## - failures i.e. FALSE to unit tests or -+ ## - errors i.e. R errors -+ tmp <- getErrors(tests) -+ if(tmp$nFail > 0 | tmp$nErr > 0) { -+ stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, -+ ", #R errors: ", tmp$nErr, ")\n\n", sep="")) -+ } -+ } else { -+ warning("cannot run unit tests -- package RUnit is not available") -+ } +p2 <- as(geospiza0$geospiza.tree,"phylo4") +plot(p2) -Running unit tests -$pkg -[1] "phylobase" +lab1 <- tipLabels(p2) +lab2 <- rownames(geospiza0$geospiza.data) -$getwd -[1] "/home/francois/R-dev/phylobase/pkg/tests" +lab1[!lab1 %in% lab2] ## missing data +lab2[!lab2 %in% lab1] ## extra data (none) +p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="warn") +p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="OK") -$pathToUnitTests -[1] "/home/francois/.R/library/phylobase/unitTests" +plot(p1) +plot(p1,show.node.label=TRUE) +## one way to deal with it: +p1B <- prune(p1,tip="olivacea") -Warning messages: -1: replacing previous import by ?Rcpp::evalCpp? when loading ?phylobase? -2: replacing previous import by ?ade4::newick2phylog? when loading ?phylobase? -Execution halted +## or ... +p1C <- na.omit(p1) + +labels(p1C, "all") <- tolower(labels(p1C, "all")) + +## trace("prune",browser,signature="phylo4d") +r1 <- read.tree(text="((t4:0.3210275554,(t2:0.2724586465,t3:0.2724586465):0.0485689089):0.1397952619,(t5:0.07551818331,t1:0.07551818331):0.385304634);") + +## trace("phylo4d", browser, signature = "phylo") +## untrace("phylo4d", signature = "phylo") +tipdat <- data.frame(a=1:5, row.names=r1$tip.label) +q1 <- phylo4d(r1,tip.data=tipdat, node.data=data.frame(a=6:9), match.data=FALSE) +q2 <- prune(q1,1) +summary(q2) + +tipdat2 <- tipdat +row.names(tipdat2)[1] <- "s1" +t1 <- try(q1 <- phylo4d(r1,tip.data=tipdat2)) + +plot(q2) +plot(q2,type="cladogram") +## plot(p2,type="dotchart",labels.nodes=nodeLabels(p2)) +## trace("plot", browser, signature = c("phylo4d","missing")) +tipLabels(q1) <- paste("q",1:5,sep="") +nodeLabels(q1) <- paste("n",1:4,sep="") +p3 <- phylo4d(r1,tip.data=tipdat,node.data=data.frame(b=6:9), match.data=FALSE) +summary(p3) + +plot(p1) + +plot(subset(p1,tips.include=c("fuliginosa","fortis","magnirostris", + "conirostris","scandens"))) +## better error? +## Error in phy$edge[, 2] : incorrect number of dimensions + +if(dev.cur() == 1) get(getOption("device"))() +plot(subset(p2,tips.include=c("fuliginosa","fortis","magnirostris", + "conirostris","scandens"))) + +plot(p2,show.node.label=TRUE) + +tree.owls <- read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);") + +z <- as(tree.owls,"phylo4") + +example("phylo4d") +obj1 <- obj2 <- obj3 <- phylo4d(z, data.frame(wing=1:4,color=factor(c("b","w","b","b")), tail=runif(4)*10), match.data=FALSE) + +obj2 at data <- as.data.frame(obj2 at data[,1]) +obj3 at data <- cbind(obj1 at data,obj2 at data) +obj4 <- obj1 +obj4 at data[2,3] <- NA +obj4 at data[1,1] <- NA + +nodeLabels(obj4) <- character(0) + +obj5 <- obj1 +tipData(obj4) <- subset(tipData(obj4),select=sapply(tipData(obj4),class)=="numeric") + +treePlot(obj4) + +E <- matrix(c( + 8, 9, + 9, 10, + 10, 1, + 10, 2, + 9, 3, + 9, 4, + 8, 11, + 11, 5, + 11, 6, + 11, 7, + 0, 8), ncol=2,byrow=TRUE) + +P2 <- phylo4(E) Modified: pkg/tests/misctests.Rout.save =================================================================== --- pkg/tests/misctests.Rout.save 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/misctests.Rout.save 2014-03-17 13:13:02 UTC (rev 875) @@ -1,8 +1,7 @@ -R Under development (unstable) (2012-11-20 r61133) -- "Unsuffered Consequences" -Copyright (C) 2012 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: i686-pc-linux-gnu (32-bit) +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -20,16 +19,14 @@ > library(phylobase) Loading required package: grid -Loading required package: ape -Loading required package: Rcpp +> library(ape) -Attaching package: ?phylobase? +Attaching package: ?ape? -The following object is masked from ?package:ape?: +The following object is masked from ?package:phylobase?: edges -> library(ape) > > set.seed(1) > @@ -189,7 +186,7 @@ phyl4d> treeOwls <- "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);" -phyl4d> tree.owls.bis <- read.tree(text=treeOwls) +phyl4d> tree.owls.bis <- ape::read.tree(text=treeOwls) phyl4d> try(phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3)), silent=TRUE) label node ancestor edge.length node.type wing @@ -414,12 +411,10 @@ 26 N26 26 25 0.05167 internal 27 N27 27 26 0.01500 internal -phyl4d> require(ape) ## for rcoal - phyl4d> ## generate a tree and some data phyl4d> set.seed(1) -phyl4d> p3 <- rcoal(5) +phyl4d> p3 <- ape::rcoal(5) phyl4d> dat <- data.frame(a = rnorm(5), b = rnorm(5), row.names = p3$tip.label) @@ -497,4 +492,4 @@ > > proc.time() user system elapsed - 3.260 2.556 5.671 + 8.550 0.204 8.738 Modified: pkg/tests/phylo4dtests.Rout.save =================================================================== --- pkg/tests/phylo4dtests.Rout.save 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/phylo4dtests.Rout.save 2014-03-17 13:13:02 UTC (rev 875) @@ -1,8 +1,7 @@ -R Under development (unstable) (2012-11-20 r61133) -- "Unsuffered Consequences" -Copyright (C) 2012 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: i686-pc-linux-gnu (32-bit) +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -20,16 +19,14 @@ > library(phylobase) Loading required package: grid -Loading required package: ape -Loading required package: Rcpp +> library(ape) -Attaching package: ?phylobase? +Attaching package: ?ape? -The following object is masked from ?package:ape?: +The following object is masked from ?package:phylobase?: edges -> require(ape) > tree.phylo <- read.tree(text="(((A,B)C,D),E);") #only one node is labelled > tree <- as(tree.phylo, "phylo4") > @@ -92,4 +89,4 @@ > > proc.time() user system elapsed - 1.908 2.216 3.978 + 5.490 0.101 5.564 Modified: pkg/tests/phylosubtest.Rout.save =================================================================== --- pkg/tests/phylosubtest.Rout.save 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/phylosubtest.Rout.save 2014-03-17 13:13:02 UTC (rev 875) @@ -1,8 +1,7 @@ -R Under development (unstable) (2012-11-20 r61133) -- "Unsuffered Consequences" -Copyright (C) 2012 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: i686-pc-linux-gnu (32-bit) +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -18,15 +17,13 @@ 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. -> require(phylobase) -Loading required package: phylobase +> library(phylobase) Loading required package: grid -Loading required package: ape -Loading required package: Rcpp +> library(ape) -Attaching package: ?phylobase? +Attaching package: ?ape? -The following object is masked from ?package:ape?: +The following object is masked from ?package:phylobase?: edges @@ -47,4 +44,4 @@ > > proc.time() user system elapsed - 1.704 2.288 3.855 + 5.208 0.106 5.285 Modified: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/phylotorture.Rout.save 2014-03-17 13:13:02 UTC (rev 875) @@ -18,12 +18,9 @@ Type 'q()' to quit R. > ## torture-testing phylo4 objects. -> require(phylobase) -Loading required package: phylobase +> library(phylobase) Loading required package: grid -Loading required package: Rcpp -> require(ape) -Loading required package: ape +> library(ape) Attaching package: ?ape? @@ -31,26 +28,23 @@ edges -> set.seed(1001) -> p1 <- list() -> n <- 10 +> +> set.seed(10101) +> n <- 200 +> p1 <- vector("list", n) > ## don't want to slow down R CMD check by doing this every time: > ## n <- 10000 > for (i in 1:n) { -+ ## e2 <- c(sample(1:5,replace=FALSE,size=5),sample(6:10,replace=FALSE,size=5)) -+ ## e1 <- sample(6:10,replace=TRUE -+ e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2) -+ p1[[i]] <- try(phylo4(e),silent=TRUE) ++ if (i <= n/2) { ++ e <- matrix(sample(1:10, replace=TRUE, size=10), ncol=2) ++ } ++ else { ++ e <- cbind(sample(rep(11:19, 2)), sample(1:19)) ++ e <- rbind(c(0, sample(11:19, 1)), e) ++ } ++ p1[[i]] <- try(phylo4(e), silent=TRUE) + } -Warning messages: -1: In checkTree(object) : Tree contains singleton nodes. -2: In checkTree(object) : Tree contains singleton nodes. -3: In checkTree(object) : Tree contains singleton nodes. -4: In checkTree(object) : Tree contains singleton nodes. -5: In checkTree(object) : Tree contains singleton nodes. -6: In checkTree(object) : Tree contains singleton nodes. -7: In checkTree(object) : Tree contains singleton nodes. -8: In checkTree(object) : Tree contains singleton nodes. +There were 50 or more warnings (use warnings() to see the first 50) > OKvals <- sapply(p1, class) != "try-error" > ## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with > ## R check because of different width of terminal/output, trying something simpler: @@ -61,14 +55,20 @@ 'names' attribute [2] must be the same length as the vector [1] Error in .local(x, ...) : Nodes incorrectly labeled. +> unname(table(sapply(p1[!OKvals], as.character))) +[1] 3 53 44 +> if (sum(OKvals)) message("There are ", sum(OKvals), " valid trees...") +There are 100 valid trees... > > if (any(OKvals)) { + p2 <- p1[OKvals] + length(p2) -+ has.poly <- sapply(p2,hasPoly) -+ has.sing <- sapply(p2,hasSingle) -+ has.retic <- sapply(p2,hasRetic) -+ ## ++ has.poly <- sapply(p2, hasPoly) ++ has.sing <- sapply(p2, hasSingle) ++ has.retic <- sapply(p2, hasRetic) ++ message("number of trees with polytomies: ", sum(has.poly)) ++ message("number of trees with singletons: ", sum(has.sing)) ++ message("number of trees with reticulation: ", sum(has.retic)) + if (any(has.sing)) { + p4 <- p2[has.sing] + plot(p4[[1]]) ## gives descriptive error @@ -82,6 +82,9 @@ + ## plot(p2[[13]]) + } + } +number of trees with polytomies: 100 +number of trees with singletons: 0 +number of trees with reticulation: 100 > > ## elements 8 and 34 are > ## what SHOULD the rules for trees be? @@ -135,19 +138,14 @@ > ## warning, but no error > ## plot(broke2) ## seems to hang R CMD check?? > ## generates error, but it's about wrong number of tips, not wrong value at root. -> print(try(as(broke2, "phylo4"), silent=TRUE)) -[1] "Error in .createLabels(value = tip.label, ntips = ntips, nnodes = nnodes, : \n Number of labels does not match number of nodes.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - +> message(try(as(broke2, "phylo4"), silent=TRUE)) +Error in .createLabels(value = tip.label, ntips = ntips, nnodes = nnodes, : + Number of labels does not match number of nodes. + > ## error regarding number of tip labels vs edges and nodes -> print(try(phylo4(broke2$edge), silent=TRUE)) -[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" -attr(,"class") -[1] "try-error" -attr(,"condition") - +> message(try(phylo4(broke2$edge), silent=TRUE)) +Error in .local(x, ...) : Nodes incorrectly labeled. + > > # switch root node value (6) with next internal node (7): > @@ -181,31 +179,22 @@ > broke4$edge[broke4$edge==4] <- 14 > broke4$edge[broke4$edge==5] <- 15 > -> print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root -[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" -attr(,"class") -[1] "try-error" -attr(,"condition") - -> print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root -[1] "Error in .local(x, ...) : Nodes incorrectly labeled. \n" -attr(,"class") -[1] "try-error" -attr(,"condition") - +> message(try(as(broke4, "phylo4"), silent=TRUE)) +Error in .local(x, ...) : Nodes incorrectly labeled. + +> message(try(phylo4(broke4$edge), silent=TRUE)) +Error in .local(x, ...) : Nodes incorrectly labeled. + > # print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG! > > ### > foo <- new('phylo4') -> set.seed(1001) +> > foo at edge <- rcoal(10)$edge -> print(try(plot(foo))) +> message(try(plot(foo))) Error in treePlot(x, ...) : treePlot function requires a rooted tree. -[1] "Error in treePlot(x, ...) : treePlot function requires a rooted tree.\n" -attr(,"class") -[1] "try-error" -attr(,"condition") - +Error in treePlot(x, ...) : treePlot function requires a rooted tree. + > > foo at label <- c(rep('blah',10), rep("",9)) > @@ -214,9 +203,9 @@ > ## with "Error in if (which(nAncest == 0) != nTips + 1) { : > ## argument is of length zero" > -> edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2) +> edge <- matrix(c(3, 1, 3, 2), byrow=TRUE, ncol=2) > try(p2 <- phylo4(edge), silent=TRUE) > > proc.time() user system elapsed - 5.557 0.099 5.638 + 6.842 0.111 6.930 Modified: pkg/tests/plottest.Rout.save =================================================================== --- pkg/tests/plottest.Rout.save 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/plottest.Rout.save 2014-03-17 13:13:02 UTC (rev 875) @@ -1,8 +1,7 @@ -R Under development (unstable) (2012-11-20 r61133) -- "Unsuffered Consequences" -Copyright (C) 2012 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: i686-pc-linux-gnu (32-bit) +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -20,16 +19,14 @@ > library(phylobase) Loading required package: grid -Loading required package: ape -Loading required package: Rcpp +> library(ape) -Attaching package: ?phylobase? +Attaching package: ?ape? -The following object is masked from ?package:ape?: +The following object is masked from ?package:phylobase?: edges -> ## library(ape) > > data(geospiza) > g1 <- as(geospiza,"phylo4") @@ -87,4 +84,4 @@ > > proc.time() user system elapsed - 2.136 2.312 4.300 + 6.264 0.102 6.336 Modified: pkg/tests/roundtrip.R =================================================================== --- pkg/tests/roundtrip.R 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/roundtrip.R 2014-03-17 13:13:02 UTC (rev 875) @@ -1,4 +1,5 @@ library(phylobase) +library(ape) ## set.seed(1) ## t0A <- rcoal(5) Modified: pkg/tests/roundtrip.Rout.save =================================================================== --- pkg/tests/roundtrip.Rout.save 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/roundtrip.Rout.save 2014-03-17 13:13:02 UTC (rev 875) @@ -1,8 +1,7 @@ -R Under development (unstable) (2012-11-19 r61131) -- "Unsuffered Consequences" -Copyright (C) 2012 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: i686-pc-linux-gnu (32-bit) +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -20,12 +19,11 @@ > library(phylobase) Loading required package: grid -Loading required package: ape -Loading required package: Rcpp +> library(ape) -Attaching package: ?phylobase? +Attaching package: ?ape? -The following object is masked from ?package:ape?: +The following object is masked from ?package:phylobase?: edges @@ -79,4 +77,4 @@ > > proc.time() user system elapsed - 1.252 1.692 2.908 + 5.491 0.205 5.671 Modified: pkg/tests/testprune.Rout.save =================================================================== --- pkg/tests/testprune.Rout.save 2014-03-17 12:48:09 UTC (rev 874) +++ pkg/tests/testprune.Rout.save 2014-03-17 13:13:02 UTC (rev 875) @@ -1,8 +1,7 @@ -R Under development (unstable) (2012-11-20 r61133) -- "Unsuffered Consequences" -Copyright (C) 2012 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: i686-pc-linux-gnu (32-bit) +R version 3.0.3 (2014-03-06) -- "Warm Puppy" +Copyright (C) 2014 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -20,16 +19,14 @@ > library(phylobase) Loading required package: grid -Loading required package: ape -Loading required package: Rcpp +> library(ape) -Attaching package: ?phylobase? +Attaching package: ?ape? -The following object is masked from ?package:ape?: +The following object is masked from ?package:phylobase?: edges -> library(ape) > > set.seed(1) > r1 <- rcoal(5) @@ -86,4 +83,4 @@ > > proc.time() user system elapsed - 1.852 2.220 3.939 + 5.442 0.090 5.550 From noreply at r-forge.r-project.org Mon Mar 17 14:14:13 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 14:14:13 +0100 (CET) Subject: [Phylobase-commits] r876 - pkg/tests Message-ID: <20140317131413.63F77184D15@r-forge.r-project.org> Author: francois Date: 2014-03-17 14:14:12 +0100 (Mon, 17 Mar 2014) New Revision: 876 Removed: pkg/tests/dUnit.Rout.save pkg/tests/nexusdata.Rout.save pkg/tests/roundtripUnit-tests.Rout.save Log: file cleanup Deleted: pkg/tests/dUnit.Rout.save =================================================================== --- pkg/tests/dUnit.Rout.save 2014-03-17 13:13:02 UTC (rev 875) +++ pkg/tests/dUnit.Rout.save 2014-03-17 13:14:12 UTC (rev 876) @@ -1 +0,0 @@ -Fatal error: cannot open file 'dUnit.R': No such file or directory Deleted: pkg/tests/nexusdata.Rout.save =================================================================== --- pkg/tests/nexusdata.Rout.save 2014-03-17 13:13:02 UTC (rev 875) +++ pkg/tests/nexusdata.Rout.save 2014-03-17 13:14:12 UTC (rev 876) @@ -1,41 +0,0 @@ - -R Under development (unstable) (2012-11-20 r61133) -- "Unsuffered Consequences" -Copyright (C) 2012 The R Foundation for Statistical Computing -ISBN 3-900051-07-0 -Platform: i686-pc-linux-gnu (32-bit) - -R is free software and comes with ABSOLUTELY NO WARRANTY. -You are welcome to redistribute it under certain conditions. -Type 'license()' or 'licence()' for distribution details. - - Natural language support but running in an English locale - -R is a collaborative project with many contributors. -Type 'contributors()' for more information and -'citation()' on how to cite R or R packages in publications. - -Type 'demo()' for some demos, 'help()' for on-line help, or -'help.start()' for an HTML browser interface to help. -Type 'q()' to quit R. - -> ## try to read NEXUS files -> ## library(phylobase) -> ## fn <- system.file("nexusfiles/treepluscharV01.nex",package="phylobase") -> ## td<-NexusToPhylo4D(fn) -> ## summary(td) -> ## would try plotting, but typically don't have enough room -> ## to plot data -> ## Error in .local(x, ...) : -> ## No room left to plot data; please try reducing ratio.tree or cex.label. -> ## plot(as(td,"phylo4")) -> -> ## try to read a nexus file where the newick string describing the tree is split -> ## across several lines -> ## multiLine <- system.file("nexusfiles/MultiLineTrees.nex",package="phylobase") -> ## multiLineTrees <-NexusToPhylo4(multiLine) -> ## summary(multiLineTrees) -> -> -> proc.time() - user system elapsed - 0.304 0.372 0.519 Deleted: pkg/tests/roundtripUnit-tests.Rout.save =================================================================== --- pkg/tests/roundtripUnit-tests.Rout.save 2014-03-17 13:13:02 UTC (rev 875) +++ pkg/tests/roundtripUnit-tests.Rout.save 2014-03-17 13:14:12 UTC (rev 876) @@ -1 +0,0 @@ -Fatal error: cannot open file 'roundtripUnit-tests.R': No such file or directory From noreply at r-forge.r-project.org Mon Mar 17 14:15:10 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 14:15:10 +0100 (CET) Subject: [Phylobase-commits] r877 - pkg/man Message-ID: <20140317131510.2692C185E9F@r-forge.r-project.org> Author: francois Date: 2014-03-17 14:15:09 +0100 (Mon, 17 Mar 2014) New Revision: 877 Modified: pkg/man/as-methods.Rd pkg/man/extract.tree.Rd pkg/man/hasSingles.Rd pkg/man/multiPhylo-class.Rd pkg/man/phylo4-display.Rd pkg/man/phylo4d-class.Rd pkg/man/phylo4d.Rd pkg/man/phylomat-class.Rd pkg/man/printphylo4.Rd pkg/man/reorder-methods.Rd pkg/man/treewalk.Rd Log: cleanup/added pointers to ape in examples Modified: pkg/man/as-methods.Rd =================================================================== --- pkg/man/as-methods.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/as-methods.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -112,7 +112,7 @@ \examples{ trString <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);" -tree.owls <- read.tree(text=trString) +tree.owls <- ape::read.tree(text=trString) ## round trip conversion tree_in_phylo <- tree.owls # tree is a phylo object (tree_in_phylo4 <- as(tree.owls,"phylo4")) # phylo converted to phylo4 Modified: pkg/man/extract.tree.Rd =================================================================== --- pkg/man/extract.tree.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/extract.tree.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -16,7 +16,7 @@ \author{ Ben Bolker } \seealso{\code{\link{phylo4}}, \code{\link{phylo4d}}, \code{\link{coerce-methods}} for translation functions. } \examples{ -tree.phylo <- read.tree(text = "((a,b),c);") +tree.phylo <- ape::read.tree(text = "((a,b),c);") tree <- as(tree.phylo, "phylo4") plot(tree) tip.data <- data.frame(size = c(1, 2, 3), row.names = c("a", "b", "c")) Modified: pkg/man/hasSingles.Rd =================================================================== --- pkg/man/hasSingles.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/hasSingles.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -34,8 +34,7 @@ other cases to represent events occurring along a branch.) } \examples{ -library(ape) -tree.owls.bis <- read.tree(text = "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);") +tree.owls.bis <- ape::read.tree(text = "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);") owls4 <- as(tree.owls.bis, "phylo4") hasPoly(owls4) hasSingle(owls4) Modified: pkg/man/multiPhylo-class.Rd =================================================================== --- pkg/man/multiPhylo-class.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/multiPhylo-class.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -59,7 +59,7 @@ % \examples{ % ### An extract from Sibley and Ahlquist (1990) % cat("(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);", file = "ex.tre", sep = "\n") -% tree.owls <- read.tree("ex.tre", keep.multi = TRUE) +% tree.owls <- ape::read.tree("ex.tre", keep.multi = TRUE) % tree.owls % (as(tree.owls, "multiPhylo4")) % } Modified: pkg/man/phylo4-display.Rd =================================================================== --- pkg/man/phylo4-display.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/phylo4-display.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -74,7 +74,7 @@ \examples{ tOwls <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);" - tree.owls <- read.tree(text=tOwls) + tree.owls <- ape::read.tree(text=tOwls) P1 <- as(tree.owls, "phylo4") P1 summary(P1) Modified: pkg/man/phylo4d-class.Rd =================================================================== --- pkg/man/phylo4d-class.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/phylo4d-class.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -42,8 +42,7 @@ \author{Ben Bolker, Thibaut Jombart} \examples{ - library(ape) - example(read.tree) + example(read.tree, "ape") obj <- phylo4d(as(tree.owls.bis,"phylo4"), data.frame(wing=1:3)) obj names(obj) Modified: pkg/man/phylo4d.Rd =================================================================== --- pkg/man/phylo4d.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/phylo4d.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -126,7 +126,7 @@ } \examples{ treeOwls <- "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);" -tree.owls.bis <- read.tree(text=treeOwls) +tree.owls.bis <- ape::read.tree(text=treeOwls) try(phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3)), silent=TRUE) obj <- phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3), match.data=FALSE) obj @@ -178,10 +178,9 @@ (exGeo7 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=FALSE)) (exGeo8 <- phylo4d(trGeo, tip.data=tDt, match.data=FALSE)) -require(ape) ## for rcoal ## generate a tree and some data set.seed(1) -p3 <- rcoal(5) +p3 <- ape::rcoal(5) dat <- data.frame(a = rnorm(5), b = rnorm(5), row.names = p3$tip.label) dat.defaultnames <- dat row.names(dat.defaultnames) <- NULL Modified: pkg/man/phylomat-class.Rd =================================================================== --- pkg/man/phylomat-class.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/phylomat-class.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -31,7 +31,7 @@ \author{Ben Bolker} \examples{ trString <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);" - tree.owls <- read.tree(text=trString) + tree.owls <- ape::read.tree(text=trString) o2 <- as(tree.owls,"phylo4") ov <- as(o2,"phylo4vcov") o3 <- as(ov,"phylo4") Modified: pkg/man/printphylo4.Rd =================================================================== --- pkg/man/printphylo4.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/printphylo4.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -38,7 +38,7 @@ \note{This is the default show() method for phylo4, phylo4d. It prints the user-supplied information for building a phylo4 object. For a full description of the phylo4 S4 object and slots, see \code{\link{phylo4}}. } \examples{ -tree.phylo <- read.tree(text="((a,b),c);") +tree.phylo <- ape::read.tree(text="((a,b),c);") tree <- as(tree.phylo, "phylo4") ##plot(tree,show.node=TRUE) ## plotting broken with empty node labels: FIXME tip.data <- data.frame(size=c(1,2,3), row.names=c("a", "b", "c")) Modified: pkg/man/reorder-methods.Rd =================================================================== --- pkg/man/reorder-methods.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/reorder-methods.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -61,7 +61,7 @@ \code{\link{children}} \code{\link{descendants}} } \examples{ -phy <- phylo4(rtree(5)) +phy <- phylo4(ape::rtree(5)) edges(reorder(phy, "preorder")) edges(reorder(phy, "postorder")) } Modified: pkg/man/treewalk.Rd =================================================================== --- pkg/man/treewalk.Rd 2014-03-17 13:14:12 UTC (rev 876) +++ pkg/man/treewalk.Rd 2014-03-17 13:15:09 UTC (rev 877) @@ -102,9 +102,6 @@ shortestPath(geospiza, "fortis", "fuliginosa") shortestPath(geospiza, "F", "L") - ## FIXME - ## if(require(ape)){ edgelabels() } - ## branch length from a tip to the root sumEdgeLength(geospiza, ancestors(geospiza, "fortis", type="ALL")) From noreply at r-forge.r-project.org Mon Mar 17 14:18:21 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 14:18:21 +0100 (CET) Subject: [Phylobase-commits] r878 - pkg/R Message-ID: <20140317131821.E759A186D47@r-forge.r-project.org> Author: francois Date: 2014-03-17 14:18:21 +0100 (Mon, 17 Mar 2014) New Revision: 878 Added: pkg/R/phylobase-package.R Modified: pkg/R/checkdata.R pkg/R/class-phylo4.R pkg/R/class-phylo4d.R pkg/R/class-phylomats.R pkg/R/formatData.R pkg/R/methods-multiphylo4.R pkg/R/methods-phylo4.R pkg/R/methods-phylo4d.R pkg/R/phylobase.options.R pkg/R/readNCL.R pkg/R/setAs-Methods.R pkg/R/subset.R pkg/R/tbind.R pkg/R/treePlot.R pkg/R/treestruc.R pkg/R/treewalk.R pkg/R/zzz.R Log: transfered doc to roxygen format (not tested if it compiles) + cleanup Modified: pkg/R/checkdata.R =================================================================== --- pkg/R/checkdata.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/checkdata.R 2014-03-17 13:18:21 UTC (rev 878) @@ -1,4 +1,48 @@ ## REQUIRED for all trees + + +#' Validity checking for phylo4 objects +#' +#' Basic checks on the validity of S4 phylogenetic objects +#' +#' +#' @aliases checkPhylo4 checkTree checkPhylo4Data +#' @param object A prospective phylo4 or phylo4d object +#' @return As required by \code{\link[methods]{validObject}}, returns an error +#' string (describing problems) or TRUE if everything is OK. +#' @note +#' +#' These functions are only intended to be called by other phylobase functions. +#' +#' \code{checkPhylo4} is an (inflexible) wrapper for \code{checkTree}. The +#' rules for \code{phylo4} objects essentially follow those for \code{phylo} +#' objects from the \code{ape} package, which are in turn defined in +#' \url{http://ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf}. These are +#' essentially that: \itemize{ \item if the tree has edge lengths defined, the +#' number of edge lengths must match the number of edges; \item the number of +#' tip labels must match the number of tips; \item in a tree with \code{ntips} +#' tips and \code{nnodes} (total) nodes, nodes 1 to \code{ntips} must be tips +#' \item if the tree is rooted, the root must be node number \code{ntips+1} and +#' the root node must be the first row of the edge matrix \item tip labels, +#' node labels, edge labels, edge lengths must have proper internal names (i.e. +#' internal names that match the node numbers they document) \item tip and node +#' labels must be unique } +#' +#' You can alter some of the default options by using the function +#' \code{phylobase.options}. +#' +#' For \code{phylo4d} objects, \code{checkTree} also calls +#' \code{checkPhylo4Data} to check the validity of the data associated with the +#' tree. It ensures that (1) the data associated with the tree have the correct +#' dimensions, (2) that the row names for the data are correct. +#' @author Ben Bolker, Steven Kembel, Francois Michonneau +#' @seealso the \code{\link{phylo4}} constructor and \linkS4class{phylo4} +#' class; \code{\link{formatData}}, the \code{\link{phylo4d}} constructor and +#' the \linkS4class{phylo4d} class do checks for the data associated with +#' trees. See \code{\link{coerce-methods}} for translation functions and +#' \code{\link{phylobase.options} to change some of the default options of the +#' validator.} +#' @keywords misc checkPhylo4 <- function(object) { ct <- checkTree(object) Modified: pkg/R/class-phylo4.R =================================================================== --- pkg/R/class-phylo4.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/class-phylo4.R 2014-03-17 13:18:21 UTC (rev 878) @@ -1,3 +1,20 @@ +#' The phylo4 class +#' +#' Classes for phylogenetic trees +#' +#' +#' @name phylo4-class +#' @aliases phylo4_orderings phylo-class phylo4-class +#' @docType class +#' @section Objects from the Class: Phylogenetic tree objects can be created by +#' calls to the \code{\link{phylo4}} constructor function. Translation +#' functions from other phylogenetic packages are also available. See +#' \code{\link{coerce-methods}}. +#' @author Ben Bolker, Thibaut Jombart +#' @seealso The \code{\link{phylo4}} constructor, the \code{\link{checkPhylo4}} +#' function to check the validity of \code{phylo4} objects. See also the +#' \code{\link{phylo4d}} constructor and the \linkS4class{phylo4d} class. +#' @keywords classes setClass("phylo4", representation(edge = "matrix", edge.length = "numeric", @@ -95,6 +112,84 @@ ## phylo4 constructor ##################### + +#' Create a phylogenetic tree +#' +#' \code{phylo4} is a generic constructor that creates a phylogenetic tree +#' object for use in phylobase methods. Phylobase contains functions for input +#' of phylogenetic trees and data, manipulation of these objects including +#' pruning and subsetting, and plotting. The phylobase package also contains +#' translation functions to forms used in other comparative phylogenetic method +#' packages. +#' +#' The minimum information necessary to create a phylobase tree object is a +#' valid edge matrix. The edge matrix describes the topology of the phylogeny. +#' Each row describes a branch of the phylogeny, with the (descendant) node +#' number in column 2 and its ancestor's node number in column 1. These numbers +#' are used internally and must be unique for each node. +#' +#' The labels designate either nodes or edges. The vector \code{node.label} +#' names internal nodes, and together with \code{tip.label}, name all nodes in +#' the tree. The vector \code{edge.label} names all branches in the tree. All +#' label vectors are optional, and if they are not given, internally-generated +#' labels will be assigned. The labels, whether user-specified or internally +#' generated, must be unique as they are used to join species data with +#' phylogenetic trees. +#' +#' @name phylo4-methods +#' @aliases phylo4 phylo4-methods phylo4,matrix-method phylo4,phylo-method +#' @docType methods +#' @param x a matrix of edges or an object of class \code{phylo} (see above) +#' @param edge A numeric, two-column matrix with as many rows as branches in +#' the phylogeny. +#' @param edge.length Edge (branch) length. (Optional) +#' @param tip.label A character vector of species names (names of "tip" nodes). +#' (Optional) +#' @param node.label A character vector of internal node names. (Optional) +#' @param edge.label A character vector of edge (branch) names. (Optional) +#' @param order character: tree ordering (allowable values are listed in +#' \code{phylo4_orderings}, currently "unknown", "preorder" (="cladewise" in +#' \code{ape}), and "postorder", with "cladewise" and "pruningwise" also +#' allowed for compatibility with \code{ape}) +#' @param check.node.labels if \code{x} is of class \code{phylo}, either "keep" +#' (the default) or "drop" node labels. This argument is useful if the +#' \code{phylo} object has non-unique node labels. +#' @param annote any additional annotation data to be passed to the new object +#' @note Translation functions are available from many valid tree formats. See +#' \link{coerce-methods}. +#' @section Methods: \describe{ \item{x = "matrix"}{creates a phylobase tree +#' from a matrix of edges} +#' +#' \item{x = "phylo"}{creates a phylobase tree from an object of class +#' \code{phylo}} } +#' @author phylobase team +#' @seealso \code{\link{coerce-methods}} for translation functions. The +#' \linkS4class{phylo4} class, the \code{\link{formatData}} function to check +#' the validity of \code{phylo4} objects. See also the \code{\link{phylo4d}} +#' constructor, and \linkS4class{phylo4d} class. +#' @keywords classes +#' @examples +#' +#' # a three species tree: +#' mytree <- phylo4(x=matrix(data=c(4,1, 4,5, 5,2, 5,3, 0,4), ncol=2, +#' byrow=TRUE), tip.label=c("speciesA", "speciesB", "speciesC")) +#' mytree +#' plot(mytree) +#' +#' # another way to specify the same tree: +#' mytree <- phylo4(x=cbind(c(4, 4, 5, 5, 0), c(1, 5, 2, 3, 4)), +#' tip.label=c("speciesA", "speciesB", "speciesC")) +#' +#' # another way: +#' mytree <- phylo4(x=rbind(c(4, 1), c(4, 5), c(5, 2), c(5, 3), c(0, 4)), +#' tip.label=c("speciesA", "speciesB", "speciesC")) +#' +#' # with branch lengths: +#' mytree <- phylo4(x=rbind(c(4, 1), c(4, 5), c(5, 2), c(5, 3), c(0, 4)), +#' tip.label=c("speciesA", "speciesB", "speciesC"), edge.length=c(1, .2, +#' .8, .8, NA)) +#' plot(mytree) +#' ## generic setGeneric("phylo4", function(x, ...) { standardGeneric("phylo4")} ) Modified: pkg/R/class-phylo4d.R =================================================================== --- pkg/R/class-phylo4d.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/class-phylo4d.R 2014-03-17 13:18:21 UTC (rev 878) @@ -1,6 +1,7 @@ ################################### ## phylo4d class ## extend: phylo with data +#' phylo4d class setClass("phylo4d", representation(data="data.frame", metadata = "list"), @@ -15,6 +16,32 @@ ###################### ## phylo4d constructor ###################### + +#' phylo4d class +#' +#' S4 class for phylogenetic tree and data. +#' +#' +#' @name phylo4d-class +#' @docType class +#' @section Objects from the Class: Objects can be created from various trees +#' and a data.frame using the constructor \code{phylo4d}, or using +#' \code{new("phylo4d", \dots{})} for empty objects. +#' @author Ben Bolker, Thibaut Jombart +#' @seealso \code{\link{coerce-methods}} for translation functions. The +#' \code{\link{phylo4d}} constructor and the \code{\link{formatData}} function +#' to check the validity of trees and data. See also the \code{\link{phylo4}} +#' constructor, the \linkS4class{phylo4} class, and the +#' \code{\link{checkPhylo4}} function to check the validity of \code{phylo4} +#' trees. +#' @keywords classes +#' @examples +#' example(read.tree, "ape") +#' obj <- phylo4d(as(tree.owls.bis,"phylo4"), data.frame(wing=1:3)) +#' obj +#' names(obj) +#' summary(obj) + ## TEST ME ## '...' recognized args for data are tipdata and nodedata. ## other recognized options are those known by the phylo4 constructor Modified: pkg/R/class-phylomats.R =================================================================== --- pkg/R/class-phylomats.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/class-phylomats.R 2014-03-17 13:18:21 UTC (rev 878) @@ -1,4 +1,45 @@ +#' matrix classes for phylobase +#' +#' Classes representing phylogenies as matrices +#' +#' +#' @name phylomat-class +#' @aliases phylo4vcov-class as_phylo4vcov +#' @docType class +#' @param from a \code{phylo4} object +#' @param \dots optional arguments, to be passed to \code{vcov.phylo} in +#' \code{ape} (the main useful option is \code{cor}, which can be set to +#' \code{TRUE} to compute a correlation rather than a variance-covariance +#' matrix) +#' @section Objects from the Class: These are square matrices (with rows and +#' columns corresponding to tips, and internal nodes implicit) with different +#' meanings depending on the type (variance-covariance matrix, distance matrix, +#' etc.). +#' @author Ben Bolker +#' @keywords classes +#' @examples +#' +#' tree.owls <- ape::read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);") +#' o2 <- as(tree.owls,"phylo4") +#' ov <- as(o2,"phylo4vcov") +#' o3 <- as(ov,"phylo4") +#' ## these are not completely identical, but are +#' ## topologically identical ... +#' +#' ## edge matrices are in a different order: +#' ## cf. o2 at edge and o3 at edge +#' ## BUT the edge matrices are otherwise identical +#' identical(o2 at edge[order(o2 at edge[,2]),], +#' o3 at edge[order(o3 at edge[,2]),]) +#' +#' ## There is left/right ambiguity here in the tree orders: +#' ## in o2 the 5->6->7->1 lineage +#' ## (terminating in Strix aluco) +#' ## is first, in o3 the 5->6->3 lineage +#' ## (terminating in Athene noctua) is first. +#' +#' ## define class for phylogenetic var-cov matrices setClass("phylo4vcov", representation("matrix", Modified: pkg/R/formatData.R =================================================================== --- pkg/R/formatData.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/formatData.R 2014-03-17 13:18:21 UTC (rev 878) @@ -1,3 +1,58 @@ +#' Format data for use in phylo4d objects +#' +#' Associates data with tree nodes and applies consistent formatting rules. +#' +#' +#' \code{formatData} is an internal function that should not be called directly +#' by the user. It is used to format data provided by the user before +#' associating it with a tree, and is called internally by the \code{phylo4d}, +#' \code{tdata}, and \code{addData} methods. However, users may pass additional +#' arguments to these methods in order to control how the data are matched to +#' nodes. +#' +#' Rules for matching rows of data to tree nodes are determined jointly by the +#' \code{match.data} and \code{rownamesAsLabels} arguments. If +#' \code{match.data} is TRUE, data frame rows will be matched exclusively +#' against tip and node labels if \code{rownamesAsLabels} is also TRUE, whereas +#' any all-digit row names will be matched against tip and node numbers if +#' \code{rownamesAsLabels} is FALSE (the default). If \code{match.data} is +#' FALSE, \code{rownamesAsLabels} has no effect, and row matching is purely +#' positional with respect to the order returned by \code{nodeId(phy, type)}. +#' +#' \code{formatData} (1) converts labels provided in the data into node +#' numbers, (2) makes sure that the data are appropriately matched against tip +#' and/or internal nodes, (3) checks for differences between data and tree, (4) +#' creates a data frame with the correct dimensions given a tree. +#' +#' @param phy a valid \code{phylo4} object +#' @param dt a data frame, matrix, vector, or factor +#' @param type type of data to attach +#' @param match.data (logical) should the rownames of the data frame be used to +#' be matched against tip and internal node identifiers? See details. +#' @param rownamesAsLabels (logical), should the row names of the data provided +#' be matched only to labels (TRUE), or should any number-like row names be +#' matched to node numbers (FALSE and default) +#' @param label.type character, \code{rownames} or \code{column}: should the +#' labels be taken from the row names of \code{dt} or from the +#' \code{label.column} column of \code{dt}? +#' @param label.column if \code{label.type=="column"}, column specifier (number +#' or name) of the column containing tip labels +#' @param missing.data action to take if there are missing data or if there are +#' data labels that don't match +#' @param extra.data action to take if there are extra data or if there are +#' labels that don't match +#' @param keep.all (logical), should the returned data have rows for all nodes +#' (with NA values for internal rows when type='tip', and vice versa) (TRUE and +#' default) or only rows corresponding to the type argument +#' @return \code{formatData} returns a data frame having node numbers as row +#' names. The data frame is also formatted to have the correct dimension given +#' the \code{phylo4} object provided. +#' @author Francois Michonneau +#' @seealso the \code{\link{phylo4d}} constructor, the \linkS4class{phylo4d} +#' class. See also the \code{\link{checkPhylo4}}, the \code{\link{phylo4}} +#' constructor and the \linkS4class{phylo4} class. See +#' \code{\link{coerce-methods}} for translation functions. +#' @keywords misc formatData <- function(phy, dt, type=c("tip", "internal", "all"), match.data=TRUE, rownamesAsLabels=FALSE, label.type=c("rownames", "column"), Modified: pkg/R/methods-multiphylo4.R =================================================================== --- pkg/R/methods-multiphylo4.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/methods-multiphylo4.R 2014-03-17 13:18:21 UTC (rev 878) @@ -0,0 +1,11 @@ + +#' multiPhylo4 and extended classes +#' +#' Classes for lists of phylogenetic trees. These classes and methods are +#' planned for a future version of \code{phylobase}. +#' +#' +#' @name multiPhylo-class +#' @aliases multiPhylo-class multiPhylo4-class multiPhylo4d-class tbind +#' @docType class +#' @keywords classes Modified: pkg/R/methods-phylo4.R =================================================================== --- pkg/R/methods-phylo4.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/methods-phylo4.R 2014-03-17 13:18:21 UTC (rev 878) @@ -54,6 +54,75 @@ ### 8. Tree properties ### 8.1. isUltrametric() +#' +#' @name phylo4-accessors +#' @aliases nNodes nNodes-methods nNodes,phylo4-method nTips nTips-methods +#' nTips,phylo4-method nTips,phylo-method depthTips depthTips-methods +#' depthTips,phylo4-method depthTips,phylo4d-method edges edges-methods +#' edges,phylo4-method nEdges nEdges-methods nEdges,phylo4-method nodeDepth +#' nodeDepth-methods nodeDepth,phylo4-method edgeOrder edgeOrder,phylo4-method +#' hasEdgeLength hasEdgeLength-methods hasEdgeLength,phylo4-method edgeLength +#' edgeLength-methods edgeLength,phylo4-method edgeLength<- +#' edgeLength<-,phylo4-method edgeLength<-,phylo4,ANY-method nodeType +#' nodeType,phylo4-method isRooted isRooted-methods isRooted,phylo4-method +#' rootEdge rootEdge-methods rootEdge,phylo4-method rootNode rootNode-methods +#' rootNode,phylo4-method rootNode<- rootNode<-,phylo4-method isUltrametric +#' isUltrametric-methods isUltrametric,phylo4-method +#' @docType methods +#' @param x a phylo4/phylo4d object +#' @param node which edge to extract (indexed by descendant node) +#' @param value a vector of edge lengths or a node number +#' @param use.names Should the names of \code{value} be used to match edge +#' lengths provided? +#' @param drop.root logical: drop root row from edge matrix? +#' @param tol tolerance in rounding error to determine whether the tree is +#' ultrametric +#' @param \dots additional parameters passed (currently ignored) +#' @section Methods: \describe{ \item{nTips}{\code{signature(object="phylo4")}: +#' number of tips} +#' +#' \item{depthTips}{\code{signature(object="phylo4")}: distance between the +#' tips and the root} +#' +#' \item{nNodes}{\code{signature(object="phylo4")}: number of internal nodes} +#' +#' \item{nEdges}{\code{signature(object = "phylo4")}: number of edges} +#' +#' \item{edges}{\code{signature(object = "phylo4")}: returns the edge matrix} +#' +#' \item{edgeOrder}{\code{signature(object = "phylo4")}: returns the order in +#' which the edges are stored} +#' +#' \item{hasEdgeLength}{\code{signature(object = "phylo4")}: whether tree has +#' edge (branch) lengths} +#' +#' \item{edgeLength}{\code{signature(object = "phylo4")}: edge (branch) lengths +#' (or NAs if missing) ordered according to the edge matrix} +#' +#' \item{nodeType}{\code{signature(object = "phylo4")}: named vector which has +#' the type of node (internal, tip, root) for value, and the node number for +#' name} +#' +#' \item{nodeDepth}{\code{signature(object = "phylo4")}: named vector which +#' gives the distance between nodes and the root} +#' +#' \item{isRooted}{\code{signature(object = "phylo4")}: whether tree is rooted +#' (i.e. has explicit root edge defined \emph{or} root node has <= 2 +#' descendants)} +#' +#' \item{rootEdge}{\code{signature(object = "phylo4")}: root edge} +#' +#' \item{isUltrametric}{\code{signature(object = "phylo4")}: whether the tree +#' is ultrametric} } +#' @keywords methods +#' @examples +#' +#' data(geospiza) +#' edgeLength(geospiza, 5) +#' edgeLength(geospiza, "olivacea") +#' edgeLength(geospiza, 5:7) +#' + ######################################################### ### Tip accessors ######################################################### @@ -142,6 +211,24 @@ }) +## nodeId +setGeneric("nodeIdCpp", function(x, type=c("all", "tip", "internal", + "root")) { + standardGeneric("nodeIdCpp") +}) + +setMethod("nodeIdCpp", signature(x="phylo4"), + function(x, type=c("all", "tip", "internal", "root")) { + type <- match.arg(type) + E <- edges(x) + nid <- switch(type, + all = getAllNodesFast(x at edge, isRooted(x)), + tip = tipsFast(x at edge[,1]), + internal = setdiff(getAllNodesFast(x at edge, isRooted(x)), tipsFast(x at edge[,1])), + root = if (!isRooted(x)) NA else unname(E[E[, 1] == 0, 2])) + nid + }) + setMethod("nodeDepth", signature(x="phylo4"), function(x, node) { if (!hasEdgeLength(x)) @@ -275,6 +362,92 @@ ### Label accessors ######################################################### +#' Labels for phylo4/phylo4d objects +#' +#' Methods for creating, accessing and updating labels in phylo4/phylo4d +#' objects +#' +#' +#' In phylo4/phylo4d objects, tips must have labels (that's why there is no +#' method for hasTipLabels), internal nodes and edges can have labels. +#' +#' Labels must be provided as a vector of class \code{character}. The length of +#' the vector must match the number of elements they label. +#' +#' The option \code{use.names} allows the user to match a label to a particular +#' node. In this case, the vector must have names that match the node numbers. +#' +#' The function \code{labels} is mostly intended to be used internally. +#' +#' @name phylo4-labels +#' @aliases labels<- labels,phylo4-method +#' labels<-,phylo4,ANY,ANY,character-method +#' labels<-,phylo4d,ANY,ANY,character-method hasDuplicatedLabels +#' hasDuplicatedLabels-methods hasDuplicatedLabels,phylo4-method hasNodeLabels +#' hasNodeLabels-methods hasNodeLabels,phylo4-method nodeLabels +#' nodeLabels-methods nodeLabels,phylo4-method nodeLabels<- +#' nodeLabels<-,phylo4,character-method nodeLabels<-,phylo4d,ANY-method +#' tipLabels tipLabels-methods tipLabels,phylo4-method tipLabels<- +#' tipLabels<-,phylo4,character-method tipLabels<-,phylo4d,character-method +#' hasEdgeLabels hasEdgeLabels-methods hasEdgeLabels,phylo4-method edgeLabels +#' edgeLabels<- edgeLabels-methods edgeLabels,phylo4-method +#' edgeLabels<-,phylo4,character-method +#' @docType methods +#' @param x a phylo4 or phylo4d object. +#' @param object a phylo4 or phylo4d object. +#' @param type which type of labels: \code{all} (tips and internal nodes), +#' \code{tip} (tips only), \code{internal} (internal nodes only). +#' @param value a vector of class \code{character}, see Details for more +#' information. +#' @param use.names should the names of the vector used to create/update labels +#' be used to match the labels? See Details for more information. +#' @section Methods: \describe{ \item{labels}{\code{signature(object = +#' "phylo4")}: tip and/or internal node labels, ordered by node ID} +#' +#' \item{hasDuplicatedLabels}{\code{signature(object = "phylo4")}: are any +#' labels duplicated?} +#' +#' \item{tipLabels}{\code{signature(object = "phylo4")}: tip labels, ordered by +#' node ID} +#' +#' \item{hasNodeLabels}{\code{signature(object = "phylo4")}: whether tree has +#' (internal) node labels} \item{nodeLabels}{\code{signature(object = +#' "phylo4")}: internal node labels, ordered by node ID} +#' +#' \item{hasEdgeLabels}{\code{signature(object = "phylo4")}: whether tree has +#' (internal) edge labels} \item{edgeLabels}{\code{signature(object = +#' "phylo4")}: internal edge labels, ordered according to the edge matrix} } +#' @examples +#' +#' +#' data(geospiza) +#' +#' ## Return labels from geospiza +#' tipLabels(geospiza) +#' +#' ## Internal node labels in geospiza are empty +#' nodeLabels(geospiza) +#' +#' ## Creating internal node labels +#' ndLbl <- paste("n", 1:nNodes(geospiza), sep="") +#' nodeLabels(geospiza) <- ndLbl +#' nodeLabels(geospiza) +#' +#' ## naming the labels +#' names(ndLbl) <- nodeId(geospiza, "internal") +#' +#' ## shuffling the labels +#' (ndLbl <- sample(ndLbl)) +#' +#' ## by default, the labels are attributed in the order +#' ## they are given: +#' nodeLabels(geospiza) <- ndLbl +#' nodeLabels(geospiza) +#' +#' ## but use.names puts them in the correct order +#' labels(geospiza, "internal", use.names=TRUE) <- ndLbl +#' nodeLabels(geospiza) +#' ## return labels in increasing node order setMethod("labels", signature(object="phylo4"), function(object, type = c("all", "tip", "internal")) { @@ -399,6 +572,57 @@ ######################################################### ### print + + +#' print a phylogeny +#' +#' Prints a phylo4 or phylo4d object in data.frame format with user-friendly +#' column names +#' +#' This is a user-friendly version of the tree representation, useful for +#' checking that objects were read in completely and translated correctly. The +#' phylogenetic tree is represented as a list of numbered nodes, linked in a +#' particular way through time (or rates of evolutionary change). The topology +#' is given by the pattern of links from each node to its ancestor. Also given +#' are the taxon names, node type (root/internal/tip) and phenotypic data (if +#' any) associated with the node, and the branch length from the node to its +#' ancestor. A list of nodes (descendants) and ancestors is minimally required +#' for a phylo4 object. +#' +#' @param x a \code{phylo4} tree or \code{phylo4d} tree+data object +#' @param edgeOrder in the data frame returned, the option 'pretty' returns the +#' internal nodes followed by the tips, the option 'real' returns the nodes in +#' the order they are stored in the edge matrix. +#' @param printall default prints entire tree. printall=FALSE returns the first +#' 6 rows +#' @return A data.frame with a row for each node (descendant), sorted as +#' follows: root first, then other internal nodes, and finally tips.\cr The +#' returned data.frame has the following columns:\cr \item{label}{Label for the +#' taxon at the node (usually species name).} \item{node}{Node number, i.e. the +#' number identifying the node in \code{x at edge}.} \item{ancestor}{Node number +#' of the node's ancestor.} \item{branch.length}{The branch length connecting +#' the node to its ancestor (NAs if missing).} \item{node.type}{"root", +#' "internal", or "tip". (internally generated)} \item{data}{phenotypic data +#' associated with the nodes, with separate columns for each variable.} +#' @note This is the default show() method for phylo4, phylo4d. It prints the +#' user-supplied information for building a phylo4 object. For a full +#' description of the phylo4 S4 object and slots, see \code{\link{phylo4}}. +#' @author Marguerite Butler Thibaut Jombart +#' \email{jombart@@biomserv.univ-lyon1.fr} Steve Kembel +#' @keywords methods +#' @examples +#' +#' +#' tree.phylo <- ape::read.tree(text="((a,b),c);") +#' tree <- as(tree.phylo, "phylo4") +#' ##plot(tree,show.node=TRUE) ## plotting broken with empty node labels: FIXME +#' tip.data <- data.frame(size=c(1,2,3), row.names=c("a", "b", "c")) +#' treedata <- phylo4d(tree, tip.data) +#' plot(treedata) +#' print(treedata) +#' +#' +#' @export printphylo4 printphylo4 <- function(x, edgeOrder=c("pretty", "real"), printall=TRUE) { if(!nrow(edges(x))) { msg <- paste("Empty \'", class(x), "\' object\n", sep="") @@ -440,6 +664,83 @@ }) ### summary +#' Displaying phylo4 object +#' +#' Display methods for phylo4 and phylo4d phylogenetic trees +#' +#' +#' @name phylo4-display +#' @aliases print,phylo4-method show,phylo4-method head,phylo4-method +#' tail,phylo4-method summary,phylo4-method names,phylo4-method +#' @docType methods +#' @param x a phylo4 object +#' @param object a phylo4 object +#' @param edgeOrder Character string indicating whether the edges should be +#' printed as ordered in the tree "real" (e.g. preorder or postorder), or +#' "pretty" printed with tips collated together +#' @param printall If TRUE all tip labels are printed +#' @param quiet a logical stating whether the results of the summary should be +#' printed to the screen (FALSE, default) or not (TRUE) +#' @return +#' +#' The \code{summary} method invisibly returns a list with the following +#' components: +#' +#' \item{list("name")}{the name of the object} \item{list("nb.tips")}{the +#' number of tips} \item{list("nb.nodes")}{the number of nodes} +#' \item{list("mean.el")}{mean of edge lengths} \item{list("var.el")}{variance +#' of edge lengths (estimate for population)} \item{list("sumry.el")}{summary +#' (i.e. range and quartiles) of the edge lengths} +#' \item{list("degree")}{(optional) degree (i.e. number of descendants) of each +#' node; displayed only when there are polytomies} +#' \item{list("polytomy")}{(optional) type of polytomy for each node: +#' \sQuote{node}, \sQuote{terminal} (all descendants are tips) or +#' \sQuote{internal} (at least one descendant is an internal node); displayed +#' only when there are polytomies} +#' +#' The \code{names} method returns a vector of characters corresponding to the +#' names of the slots. +#' @section Methods: \describe{ \item{print}{\code{signature(x = "phylo4")}: +#' print method} \item{show}{\code{signature(object = "phylo4")}: show method } +#' \item{summary}{\code{signature(object = "phylo4")}: summary method} +#' \item{names}{\code{signature(x = "phylo4")}: gives the slot names} +#' \item{head}{\code{signature(object = "phylo4")}: show first few nodes} +#' \item{tail}{\code{signature(object = "phylo4")}: show last few nodes} } +#' @author Ben Bolker, Thibaut Jombart +#' @seealso The \code{\link{phylo4}} constructor, the \code{\link{checkPhylo4}} +#' function to check the validity of \code{phylo4} objects. See also the +#' \code{\link{phylo4d}} constructor and the \linkS4class{phylo4d} class. +#' @keywords methods +#' @examples +#' +#' +#' tOwls <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);" +#' tree.owls <- ape::read.tree(text=tOwls) +#' P1 <- as(tree.owls, "phylo4") +#' P1 +#' summary(P1) +#' +#' +#' ## summary of a polytomous tree +#' E <- matrix(c( +#' 8, 9, +#' 9, 10, +#' 10, 1, +#' 10, 2, +#' 9, 3, +#' 9, 4, +#' 8, 11, +#' 11, 5, +#' 11, 6, +#' 11, 7, +#' 0, 8), ncol=2, byrow=TRUE) +#' +#' P2 <- phylo4(E) +#' nodeLabels(P2) <- as.character(nodeId(P2, "internal")) +#' plot(P2, show.node.label=TRUE) +#' sumryP2 <- summary(P2) +#' sumryP2 +#' setMethod("summary", signature(object="phylo4"), function(object, quiet=FALSE) { @@ -538,6 +839,51 @@ ### Ordering ######################################################### +#' reordering trees within phylobase objects +#' +#' Methods for reordering trees into various traversal orders +#' +#' The \code{reorder} method takes a \code{phylo4} or \code{phylo4d} tree and +#' orders the edge matrix (i.e. \code{edges(x)}) in the requested traversal +#' order. Currently only two orderings are permitted, and both require rooted +#' trees. In "postorder", a node's descendants come before that node, thus the +#' root, which is ancestral to all nodes, comes last. In "preorder", a node is +#' visited before its descendants, thus the root comes first. +#' +#' A method is also defined that takes an \code{ape phylo} object. This also +#' takes an order argument, however, 'pruningwise' and 'cladewise' are the only +#' acceptable parameters. This is because this method actually uses the +#' \code{ape reorder()} command to complete the ordering. +#' +#' @name reorder-methods +#' @aliases reorder-methods reorder,phylo-method reorder,phylo4-method +#' reorder,phylo4d-method +#' @docType methods +#' @param x a \code{phylo4} or \code{phylo4d} object +#' @param order The desired traversal order; currently only 'preorder' and +#' 'postorder' are allowed for \code{phylo4} and \code{phylo4d} objects, +#' whereas only 'cladewise' and 'pruningwise' are allowed for \code{phylo} +#' objects +#' @return A \code{phylo4} or \code{phylo4d} object with the edge, label, +#' length and data slots ordered as \code{order}, which is itself recorded in +#' the order slot. +#' @note The "preorder" parameter corresponds to "cladewise" in the \code{ape} +#' package, and "postorder" corresponds (almost but close enough?) to +#' "pruningwise". +#' +#' See \url{http://ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf} +#' @section Methods: \describe{ \item{x = "phylo"}{reorders a \code{phylo} +#' object} \item{x = "phylo4"}{reorders a \linkS4class{phylo4} object} \item{x +#' = "phylo4d"}{reorders a \linkS4class{phylo4d} object} } +#' @author Peter Cowan, Jim Regetz +#' @seealso \code{\link[ape]{reorder.phylo}} in the \code{ape} package. +#' \code{\link{ancestors}} \code{\link{ancestor}} \code{\link{siblings}} +#' \code{\link{children}} \code{\link{descendants}} +#' @keywords methods +#' @examples +#' phy <- phylo4(ape::rtree(5)) +#' edges(reorder(phy, "preorder")) +#' edges(reorder(phy, "postorder")) orderIndex <- function(x, order=c("preorder", "postorder")) { order <- match.arg(order) Modified: pkg/R/methods-phylo4d.R =================================================================== --- pkg/R/methods-phylo4d.R 2014-03-17 13:15:09 UTC (rev 877) +++ pkg/R/methods-phylo4d.R 2014-03-17 13:18:21 UTC (rev 878) @@ -1,3 +1,56 @@ + +#' Retrieving or updating tip and node data in phylo4d objects +#' +#' Methods to retrieve or update tip, node or all data associated with a +#' phylogenetic tree stored as a phylo4d object +#' +#' +#' @aliases tdata tdata-method tdata,phylo4d-method tdata<- +#' tdata<-,phylo4d-method tdata<-,phylo4d,ANY-method tipData tipData-method +#' tipData,phylo4d-method tipData<- tipData<-,phylo4d-method +#' tipData<-,phylo4d,ANY-method nodeData nodeData-method +#' nodeData,phylo4d-method nodeData<- nodeData<-,phylo4d-method +#' nodeData<-,phylo4d,ANY-method +#' @param x A \code{phylo4d} object +#' @param type The type of data to retrieve or update: \dQuote{\code{all}} +#' (default) for data associated with both tip and internal nodes, +#' \dQuote{\code{tip}} for data associated with tips only, +#' \dQuote{\code{internal}} for data associated with internal nodes only. +#' @param label.type How should the tip/node labels from the tree be returned? +#' \dQuote{\code{row.names}} returns them as row names of the data frame, [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/phylobase -r 878 From noreply at r-forge.r-project.org Mon Mar 17 14:19:26 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 14:19:26 +0100 (CET) Subject: [Phylobase-commits] r879 - pkg Message-ID: <20140317131926.86E92186DBF@r-forge.r-project.org> Author: francois Date: 2014-03-17 14:19:26 +0100 (Mon, 17 Mar 2014) New Revision: 879 Modified: pkg/DESCRIPTION pkg/NAMESPACE pkg/cleanup Log: updated DESCRIPTION, NAMESPACE and cleanup Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2014-03-17 13:18:21 UTC (rev 878) +++ pkg/DESCRIPTION 2014-03-17 13:19:26 UTC (rev 879) @@ -1,14 +1,14 @@ Package: phylobase Type: Package Title: Base package for phylogenetic structures and comparative data -Version: 0.6.7-1 -Date: 2014-03-14 +Version: 0.6.8 +Date: 2014-03-17 +Imports: ade4, + ape (>= 3.0), + Rcpp (>= 0.11.0), + methods Depends: - methods, - grid, - Rcpp (>= 0.11.0), - ape (>= 2.1) -Imports: ade4 + grid LinkingTo: Rcpp Suggests: MASS, @@ -39,6 +39,7 @@ 'setAs-Methods.R' 'pdata.R' 'subset.R' + 'phylobase-package.R' 'phylobase.options.R' 'prune.R' 'treePlot.R' Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2014-03-17 13:18:21 UTC (rev 878) +++ pkg/NAMESPACE 2014-03-17 13:19:26 UTC (rev 879) @@ -6,10 +6,12 @@ import(methods) import(ape) +import(Rcpp) + importFrom(graphics, plot) importFrom(stats, reorder) importFrom(utils, head, tail) -importFrom(Rcpp, evalCpp) +importFrom(ade4, newick2phylog) #---------------------------------------------------------------------- @@ -90,7 +92,8 @@ ## options export(phylobase.options) -importFrom(ade4,newick2phylog) + + ## commented out in source code, probably should be omitted here #export(phyloStripchart) #export(internEdges, terminEdges, isPoly) Modified: pkg/cleanup =================================================================== --- pkg/cleanup 2014-03-17 13:18:21 UTC (rev 878) +++ pkg/cleanup 2014-03-17 13:19:26 UTC (rev 879) @@ -61,4 +61,4 @@ rm -f src/ncl/ncl/.deps rm -f src/ncl/ncl/Makefile rm -f tests/.RData -rm -r tests/Rplots.pdf +rm -f tests/Rplots.pdf From noreply at r-forge.r-project.org Mon Mar 17 14:29:22 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 17 Mar 2014 14:29:22 +0100 (CET) Subject: [Phylobase-commits] r880 - pkg/tests Message-ID: <20140317132922.BFC60186F51@r-forge.r-project.org> Author: francois Date: 2014-03-17 14:29:22 +0100 (Mon, 17 Mar 2014) New Revision: 880 Modified: pkg/tests/phylotorture.R pkg/tests/phylotorture.Rout.save Log: final tweaks to phylotorture Modified: pkg/tests/phylotorture.R =================================================================== --- pkg/tests/phylotorture.R 2014-03-17 13:19:26 UTC (rev 879) +++ pkg/tests/phylotorture.R 2014-03-17 13:29:22 UTC (rev 880) @@ -21,7 +21,7 @@ ## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with ## R check because of different width of terminal/output, trying something simpler: message(unique(sapply(p1[!OKvals], as.character))) -unname(table(sapply(p1[!OKvals], as.character))) +sort(unname(table(sapply(p1[!OKvals], as.character)))) if (sum(OKvals)) message("There are ", sum(OKvals), " valid trees...") if (any(OKvals)) { Modified: pkg/tests/phylotorture.Rout.save =================================================================== --- pkg/tests/phylotorture.Rout.save 2014-03-17 13:19:26 UTC (rev 879) +++ pkg/tests/phylotorture.Rout.save 2014-03-17 13:29:22 UTC (rev 880) @@ -55,8 +55,8 @@ 'names' attribute [2] must be the same length as the vector [1] Error in .local(x, ...) : Nodes incorrectly labeled. -> unname(table(sapply(p1[!OKvals], as.character))) -[1] 3 53 44 +> sort(unname(table(sapply(p1[!OKvals], as.character)))) +[1] 3 44 53 > if (sum(OKvals)) message("There are ", sum(OKvals), " valid trees...") There are 100 valid trees... > From noreply at r-forge.r-project.org Wed Mar 19 03:59:02 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 03:59:02 +0100 (CET) Subject: [Phylobase-commits] r881 - pkg/src Message-ID: <20140319025903.DE20E186F70@r-forge.r-project.org> Author: francois Date: 2014-03-19 03:58:59 +0100 (Wed, 19 Mar 2014) New Revision: 881 Modified: pkg/src/GetNCL.cpp pkg/src/Makevars pkg/src/Makevars.win Log: upgrading code to Rcpp 0.11 standards. Modified: pkg/src/GetNCL.cpp =================================================================== --- pkg/src/GetNCL.cpp 2014-03-17 13:29:22 UTC (rev 880) +++ pkg/src/GetNCL.cpp 2014-03-19 02:58:59 UTC (rev 881) @@ -1,3 +1,5 @@ +// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- + #include #include "ncl/nxsmultiformat.h" @@ -63,10 +65,9 @@ } -extern "C" SEXP GetNCL(SEXP params, SEXP paramsVecR) { +//[[Rcpp::export]] +Rcpp::List GetNCL (SEXP params, SEXP paramsVecR) { - BEGIN_RCPP - Rcpp::List list(params); Rcpp::LogicalVector paramsVec(paramsVecR); @@ -115,6 +116,7 @@ std::string fileFormatString = list["fileFormat"]; if (!fileFormatString.empty()) { + fileFormat = MultiFormatReader::formatNameToCode(fileFormatString); if (fileFormat == MultiFormatReader::UNSUPPORTED_FORMAT) { @@ -125,39 +127,38 @@ return res; } } -/* -fileFormatString should be one of these: "nexus", - "dnafasta", - "aafasta", - "rnafasta", - "dnaphylip", - "rnaphylip", - "aaphylip", - "discretephylip", - "dnaphylipinterleaved", - "rnaphylipinterleaved", - "aaphylipinterleaved", - "discretephylipinterleaved", - "dnarelaxedphylip", - "rnarelaxedphylip", - "aarelaxedphylip", - "discreterelaxedphylip", - "dnarelaxedphylipinterleaved", - "rnarelaxedphylipinterleaved", - "aarelaxedphylipinterleaved", - "discreterelaxedphylipinterleaved", - "dnaaln", - "rnaaln", - "aaaln", - "phyliptree", - "relaxedphyliptree", - "nexml", - "dnafin", - "aafin", - "rnafin" - }; - */ +/* fileFormatString should be one of these: + "nexus", + "dnafasta", + "aafasta", + "rnafasta", + "dnaphylip", + "rnaphylip", + "aaphylip", + "discretephylip", + "dnaphylipinterleaved", + "rnaphylipinterleaved", + "aaphylipinterleaved", + "discretephylipinterleaved", + "dnarelaxedphylip", + "rnarelaxedphylip", + "aarelaxedphylip", + "discreterelaxedphylip", + "dnarelaxedphylipinterleaved", + "rnarelaxedphylipinterleaved", + "aarelaxedphylipinterleaved", + "discreterelaxedphylipinterleaved", + "dnaaln", + "rnaaln", + "aaaln", + "phyliptree", + "relaxedphyliptree", + "nexml", + "dnafin", + "aafin", + "rnafin" + }; */ try { nexusReader.ReadFilepath(const_cast < char* > (filename.c_str()), fileFormat); } @@ -218,7 +219,8 @@ NxsSimpleTree simpleTree(ftd, -1, -1.0); std::vector ndVector = simpleTree.GetPreorderTraversal(); unsigned internalNdIndex = nTax; - for (std::vector::const_iterator ndIt = ndVector.begin(); ndIt != ndVector.end(); ++ndIt) + for (std::vector::const_iterator ndIt = ndVector.begin(); + ndIt != ndVector.end(); ++ndIt) { NxsSimpleNode * nd = (NxsSimpleNode *) *ndIt; unsigned nodeIndex; @@ -330,6 +332,7 @@ else { if (nCharStates == 1) { tmpCharString += charBlock->GetState(taxon, eachChar, 0); + } else { tmpCharString += "?"; //FIXME @@ -348,8 +351,8 @@ } std::string charString = "c(" + tmpCharString + ");"; dataChr.push_back (charString); - } - } + } + } } } } @@ -368,8 +371,5 @@ Rcpp::Named("stateLabels") = stateLabels, Rcpp::Named("dataChr") = dataChr, Rcpp::Named("Test") = test); - return res; - - END_RCPP - + return res; } Modified: pkg/src/Makevars =================================================================== --- pkg/src/Makevars 2014-03-17 13:29:22 UTC (rev 880) +++ pkg/src/Makevars 2014-03-19 02:58:59 UTC (rev 881) @@ -1,2 +1,2 @@ -PKG_CPPFLAGS=-I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS -#PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"` +## PKG_CPPFLAGS=-I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS +## PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"` Modified: pkg/src/Makevars.win =================================================================== --- pkg/src/Makevars.win 2014-03-17 13:29:22 UTC (rev 880) +++ pkg/src/Makevars.win 2014-03-19 02:58:59 UTC (rev 881) @@ -1,5 +1,5 @@ ## PKG_LIBS = -s $(shell Rscript -e 'Rcpp:::LdFlags()') -L"$(RHOME)/bin" -lR --no-export-all-symbols --add-stdcall-alias -PKG_CXXFLAGS = -I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS +## PKG_CXXFLAGS = -I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS ## PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()") From noreply at r-forge.r-project.org Wed Mar 19 03:59:35 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 03:59:35 +0100 (CET) Subject: [Phylobase-commits] r882 - pkg/src/ncl Message-ID: <20140319025935.D53D3186FA7@r-forge.r-project.org> Author: francois Date: 2014-03-19 03:59:34 +0100 (Wed, 19 Mar 2014) New Revision: 882 Modified: pkg/src/ncl/nxsassumptionsblock.h Log: trying to fix build issue with clang c++11 Modified: pkg/src/ncl/nxsassumptionsblock.h =================================================================== --- pkg/src/ncl/nxsassumptionsblock.h 2014-03-19 02:58:59 UTC (rev 881) +++ pkg/src/ncl/nxsassumptionsblock.h 2014-03-19 02:59:34 UTC (rev 882) @@ -323,7 +323,7 @@ NxsAssumptionsBlockAPI *GetAssumptionsBlockForTreesBlock(NxsTreesBlockAPI *, NxsBlockLinkStatus, NxsToken &token); NxsAssumptionsBlockAPI *CreateNewAssumptionsBlock(NxsToken &token); - NxsAssumptionsBlockAPI *DealWithPossibleParensInCharDependentCmd(NxsToken &token, const char *cmd, const std::vector *unsupported = NULL, bool * isVect = false); + NxsAssumptionsBlockAPI *DealWithPossibleParensInCharDependentCmd(NxsToken &token, const char *cmd, const std::vector *unsupported = NULL, bool * isVect = NULL); bool HasAssumptionsBlockCommands() const; bool HasSetsBlockCommands() const; bool HasCodonsBlockCommands() const; From noreply at r-forge.r-project.org Wed Mar 19 04:15:05 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 04:15:05 +0100 (CET) Subject: [Phylobase-commits] r883 - pkg/src Message-ID: <20140319031505.97195186DA9@r-forge.r-project.org> Author: francois Date: 2014-03-19 04:15:05 +0100 (Wed, 19 Mar 2014) New Revision: 883 Modified: pkg/src/Makevars pkg/src/Makevars.win Log: revert Makevars files Modified: pkg/src/Makevars =================================================================== --- pkg/src/Makevars 2014-03-19 02:59:34 UTC (rev 882) +++ pkg/src/Makevars 2014-03-19 03:15:05 UTC (rev 883) @@ -1,2 +1,2 @@ -## PKG_CPPFLAGS=-I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS +PKG_CPPFLAGS=-I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS ## PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"` Modified: pkg/src/Makevars.win =================================================================== --- pkg/src/Makevars.win 2014-03-19 02:59:34 UTC (rev 882) +++ pkg/src/Makevars.win 2014-03-19 03:15:05 UTC (rev 883) @@ -1,5 +1,5 @@ ## PKG_LIBS = -s $(shell Rscript -e 'Rcpp:::LdFlags()') -L"$(RHOME)/bin" -lR --no-export-all-symbols --add-stdcall-alias -## PKG_CXXFLAGS = -I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS +PKG_CXXFLAGS = -I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS ## PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()") From noreply at r-forge.r-project.org Wed Mar 19 04:31:41 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 04:31:41 +0100 (CET) Subject: [Phylobase-commits] r884 - pkg/R Message-ID: <20140319033141.1687A18706B@r-forge.r-project.org> Author: francois Date: 2014-03-19 04:31:40 +0100 (Wed, 19 Mar 2014) New Revision: 884 Modified: pkg/R/readNCL.R Log: make call to GetNCL more transparent Modified: pkg/R/readNCL.R =================================================================== --- pkg/R/readNCL.R 2014-03-19 03:15:05 UTC (rev 883) +++ pkg/R/readNCL.R 2014-03-19 03:31:40 UTC (rev 884) @@ -138,7 +138,7 @@ ## of characters) ## $stateLabels: the labels for the states of the characters, i.e. the levels of the factors to be returned ## $dataChr: string that contains the data to be returned - ncl <- .Call("GetNCL", fileName, parameters, PACKAGE="phylobase") + ncl <- GetNCL(fileName, parameters) ## Return Error message if (length(ncl) == 1 && names(ncl) == "ErrorMsg") { From noreply at r-forge.r-project.org Wed Mar 19 04:35:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 04:35:06 +0100 (CET) Subject: [Phylobase-commits] r885 - pkg/src Message-ID: <20140319033506.750A818707A@r-forge.r-project.org> Author: francois Date: 2014-03-19 04:35:05 +0100 (Wed, 19 Mar 2014) New Revision: 885 Modified: pkg/src/checkPhylo4.cpp Log: remove another warning during clang c++11 compilation Modified: pkg/src/checkPhylo4.cpp =================================================================== --- pkg/src/checkPhylo4.cpp 2014-03-19 03:31:40 UTC (rev 884) +++ pkg/src/checkPhylo4.cpp 2014-03-19 03:35:05 UTC (rev 885) @@ -264,6 +264,7 @@ } return c1; } + return ""; } //[[Rcpp::export]] From noreply at r-forge.r-project.org Wed Mar 19 05:01:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 05:01:33 +0100 (CET) Subject: [Phylobase-commits] r886 - pkg Message-ID: <20140319040133.8375A186A65@r-forge.r-project.org> Author: francois Date: 2014-03-19 05:01:28 +0100 (Wed, 19 Mar 2014) New Revision: 886 Modified: pkg/NAMESPACE Log: correct incantation of Rcpp in namespace Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2014-03-19 03:35:05 UTC (rev 885) +++ pkg/NAMESPACE 2014-03-19 04:01:28 UTC (rev 886) @@ -6,8 +6,8 @@ import(methods) import(ape) -import(Rcpp) +importFrom(Rcpp, evalCpp) importFrom(graphics, plot) importFrom(stats, reorder) importFrom(utils, head, tail) From noreply at r-forge.r-project.org Wed Mar 19 05:02:54 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 05:02:54 +0100 (CET) Subject: [Phylobase-commits] r887 - in pkg: R src Message-ID: <20140319040254.E3F2B186AAE@r-forge.r-project.org> Author: francois Date: 2014-03-19 05:02:53 +0100 (Wed, 19 Mar 2014) New Revision: 887 Modified: pkg/R/RcppExports.R pkg/src/RcppExports.cpp Log: updated RcppExports to accommodate GetNCL Modified: pkg/R/RcppExports.R =================================================================== --- pkg/R/RcppExports.R 2014-03-19 04:01:28 UTC (rev 886) +++ pkg/R/RcppExports.R 2014-03-19 04:02:53 UTC (rev 887) @@ -77,3 +77,7 @@ .Call('phylobase_checkTreeCpp', PACKAGE = 'phylobase', obj, opts) } +GetNCL <- function(params, paramsVecR) { + .Call('phylobase_GetNCL', PACKAGE = 'phylobase', params, paramsVecR) +} + Modified: pkg/src/RcppExports.cpp =================================================================== --- pkg/src/RcppExports.cpp 2014-03-19 04:01:28 UTC (rev 886) +++ pkg/src/RcppExports.cpp 2014-03-19 04:02:53 UTC (rev 887) @@ -297,3 +297,19 @@ return __sexp_result; END_RCPP } +// GetNCL +Rcpp::List GetNCL(SEXP params, SEXP paramsVecR); +RcppExport SEXP phylobase_GetNCL(SEXP paramsSEXP, SEXP paramsVecRSEXP) { +BEGIN_RCPP + SEXP __sexp_result; + { + Rcpp::RNGScope __rngScope; + Rcpp::traits::input_parameter< SEXP >::type params(paramsSEXP ); + Rcpp::traits::input_parameter< SEXP >::type paramsVecR(paramsVecRSEXP ); + Rcpp::List __result = GetNCL(params, paramsVecR); + PROTECT(__sexp_result = Rcpp::wrap(__result)); + } + UNPROTECT(1); + return __sexp_result; +END_RCPP +} From noreply at r-forge.r-project.org Wed Mar 19 16:35:22 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 19 Mar 2014 16:35:22 +0100 (CET) Subject: [Phylobase-commits] r888 - pkg Message-ID: <20140319153522.7DC2F186A5D@r-forge.r-project.org> Author: francois Date: 2014-03-19 16:35:22 +0100 (Wed, 19 Mar 2014) New Revision: 888 Modified: pkg/NEWS Log: updated NEWS file Modified: pkg/NEWS =================================================================== --- pkg/NEWS 2014-03-19 04:02:53 UTC (rev 887) +++ pkg/NEWS 2014-03-19 15:35:22 UTC (rev 888) @@ -7,6 +7,25 @@ * * ************************************************* + CHANGES IN phylobase VERSION 0.6.8 + + * Not many user-visible changes, most are related to improving speeds + during test of object validation (most tests done in C++) and to getNode + that is used by many functions. + + * Changes to package structure to make it compatible with devtools + (switching testing to testthat -- partial at this stage) and docs to + roxygen format (partial at this stage). + + * Changes to package structure to comply with new Rcpp standards + + CHANGES IN phylobase VERSION 0.6.5 + + * Updates from cout/cerr to Rcpp::Rcout/Rcerr + + * Comments in Nexus tree strings are being removed before being processed by + readNCL + CHANGES IN phylobase VERSION 0.6.3 * Fixed bugs in getNode in cases where labels included regexpr From noreply at r-forge.r-project.org Thu Mar 20 17:41:19 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 20 Mar 2014 17:41:19 +0100 (CET) Subject: [Phylobase-commits] r889 - pkg/R Message-ID: <20140320164119.310B7183E97@r-forge.r-project.org> Author: francois Date: 2014-03-20 17:41:15 +0100 (Thu, 20 Mar 2014) New Revision: 889 Modified: pkg/R/treewalk.R Log: fix doc for treewalk Modified: pkg/R/treewalk.R =================================================================== --- pkg/R/treewalk.R 2014-03-19 15:35:22 UTC (rev 888) +++ pkg/R/treewalk.R 2014-03-20 16:41:15 UTC (rev 889) @@ -76,7 +76,7 @@ #' ## identify an edge from its terminal node #' getEdge(geospiza, c("olivacea", "B", "fortis")) #' getNode(geospiza, c("olivacea", "B", "fortis")) -#' geospiza at edge[c(26, 1, 11),] +#' edges(geospiza)[c(26, 1, 11),] #' #' ## quickly get all tip node IDs and tip edge IDs #' nodeId(geospiza, "tip") From noreply at r-forge.r-project.org Thu Mar 20 17:41:54 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 20 Mar 2014 17:41:54 +0100 (CET) Subject: [Phylobase-commits] r890 - pkg/R Message-ID: <20140320164154.C4434184232@r-forge.r-project.org> Author: francois Date: 2014-03-20 17:41:54 +0100 (Thu, 20 Mar 2014) New Revision: 890 Modified: pkg/R/class-phylomats.R pkg/R/methods-phylo4.R Log: fix docs Modified: pkg/R/class-phylomats.R =================================================================== --- pkg/R/class-phylomats.R 2014-03-20 16:41:15 UTC (rev 889) +++ pkg/R/class-phylomats.R 2014-03-20 16:41:54 UTC (rev 890) @@ -28,10 +28,12 @@ #' ## topologically identical ... #' #' ## edge matrices are in a different order: -#' ## cf. o2 at edge and o3 at edge +#' ## cf. edges(o2) and edges(o3) #' ## BUT the edge matrices are otherwise identical -#' identical(o2 at edge[order(o2 at edge[,2]),], -#' o3 at edge[order(o3 at edge[,2]),]) +#' o2edges <- edges(o2) +#' o3edges <- edges(o3) +#' identical(o2edges[order(o2edges[,2]),], +#' o3edges[order(o3edges[,2]),]) #' #' ## There is left/right ambiguity here in the tree orders: #' ## in o2 the 5->6->7->1 lineage Modified: pkg/R/methods-phylo4.R =================================================================== --- pkg/R/methods-phylo4.R 2014-03-20 16:41:15 UTC (rev 889) +++ pkg/R/methods-phylo4.R 2014-03-20 16:41:54 UTC (rev 890) @@ -599,7 +599,7 @@ #' follows: root first, then other internal nodes, and finally tips.\cr The #' returned data.frame has the following columns:\cr \item{label}{Label for the #' taxon at the node (usually species name).} \item{node}{Node number, i.e. the -#' number identifying the node in \code{x at edge}.} \item{ancestor}{Node number +#' number identifying the node in edge matrix.} \item{ancestor}{Node number #' of the node's ancestor.} \item{branch.length}{The branch length connecting #' the node to its ancestor (NAs if missing).} \item{node.type}{"root", #' "internal", or "tip". (internally generated)} \item{data}{phenotypic data From noreply at r-forge.r-project.org Thu Mar 20 17:43:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 20 Mar 2014 17:43:46 +0100 (CET) Subject: [Phylobase-commits] r891 - pkg/src Message-ID: <20140320164347.03F791851FF@r-forge.r-project.org> Author: francois Date: 2014-03-20 17:43:46 +0100 (Thu, 20 Mar 2014) New Revision: 891 Modified: pkg/src/checkPhylo4.cpp Log: remove exotic calls that failed with Prof. Ripley's compilers Modified: pkg/src/checkPhylo4.cpp =================================================================== --- pkg/src/checkPhylo4.cpp 2014-03-20 16:41:54 UTC (rev 890) +++ pkg/src/checkPhylo4.cpp 2014-03-20 16:43:46 UTC (rev 891) @@ -1,11 +1,9 @@ // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- #include -#include // std::cout #include // std::count_if #include // std::vector #include // -#include template std::string NumberToString ( T Number ) { @@ -214,55 +212,68 @@ return is_true(any(Rcpp::duplicated(label))); } -std::string edgeIdCppInternal (int tmp1, int tmp2) { - std::string tmp1S = static_cast( &(std::ostringstream() << tmp1) )->str(); - std::string tmp2S = static_cast( &(std::ostringstream() << tmp2) )->str(); - tmp1S.append("-"); - tmp1S.append(tmp2S); - return tmp1S; +Rcpp::CharacterVector edgeIdCppInternal (Rcpp::IntegerVector tmp1, Rcpp::IntegerVector tmp2) { + Rcpp::CharacterVector tmpV1 = Rcpp::as< Rcpp::CharacterVector >(tmp1); + Rcpp::CharacterVector tmpV2 = Rcpp::as< Rcpp::CharacterVector >(tmp2); + int Ne = tmp1.size(); + Rcpp::CharacterVector res(Ne); + for (int i = 0; i < Ne; i++) { + std::string tmpS1; + tmpS1 = tmpV1[i]; + std::string tmpS2; + tmpS2 = tmpV2[i]; + std::string tmpS; + tmpS = tmpS1.append("-"); + tmpS = tmpS.append(tmpS2); + res[i] = tmpS; + } + return res; } //[[Rcpp::export]] Rcpp::CharacterVector edgeIdCpp (Rcpp::IntegerMatrix edge, std::string type) { Rcpp::IntegerVector ances = getAnces(edge); Rcpp::IntegerVector desc = getDesc(edge); - + int nedge; + if (type == "tip" || type == "internal") { Rcpp::IntegerVector tips = tipsFast(ances); - int ntips = tips.size(); + nedge = tips.size(); Rcpp::IntegerVector ans = match(tips, desc); if (type == "tip") { - Rcpp::CharacterVector c1(ntips); - for (int j = 0; j < ntips; j++) { - int tmp1 = ances[ans[j]-1]; - int tmp2 = desc[ans[j]-1]; - c1[j] = edgeIdCppInternal(tmp1, tmp2); + Rcpp::IntegerVector tmpAnces(nedge); + Rcpp::IntegerVector tmpDesc(nedge); + for (int j = 0; j < nedge; j++) { + tmpAnces[j] = ances[ans[j]-1]; + tmpDesc[j] = desc[ans[j]-1]; } - return c1; + Rcpp::CharacterVector c1(nedge); + c1 = edgeIdCppInternal(tmpAnces, tmpDesc); + return c1; } else if (type == "internal") { - int nedge = ances.size(); - Rcpp::IntegerVector idEdge = Rcpp::seq_len(nedge); + int allEdges = ances.size(); + Rcpp::IntegerVector idEdge = Rcpp::seq_len(allEdges); Rcpp::IntegerVector intnd = Rcpp::setdiff(idEdge, ans); - int nnd = intnd.size(); - Rcpp::CharacterVector c1(nnd); - for (int j = 0; j < nnd; j++) { - int tmp1 = ances[intnd[j]-1]; - int tmp2 = desc[intnd[j]-1]; - c1[j] = edgeIdCppInternal(tmp1, tmp2); - } - return c1; + nedge = intnd.size(); + Rcpp::IntegerVector tmpAnces(nedge); + Rcpp::IntegerVector tmpDesc(nedge); + for (int j = 0; j < nedge; j++) { + tmpAnces[j] = ances[intnd[j]-1]; + tmpDesc[j] = desc[intnd[j]-1]; + } + Rcpp::CharacterVector c1(nedge); + c1 = edgeIdCppInternal(tmpAnces, tmpDesc); + return c1; } } else { - int nedge = ances.size(); - Rcpp::CharacterVector c1(nedge); - for (int j = 0; j < nedge; j++) { - int tmp1 = ances[j]; - int tmp2 = desc[j]; - c1[j] = edgeIdCppInternal(tmp1, tmp2); - } - return c1; + nedge = ances.size(); + Rcpp::IntegerVector tmpAnces = ances; + Rcpp::IntegerVector tmpDesc = desc; + Rcpp::CharacterVector c1(nedge); + c1 = edgeIdCppInternal(tmpAnces, tmpDesc); + return c1; } return ""; } From noreply at r-forge.r-project.org Thu Mar 20 17:45:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 20 Mar 2014 17:45:08 +0100 (CET) Subject: [Phylobase-commits] r892 - pkg Message-ID: <20140320164508.EFD2F1849A4@r-forge.r-project.org> Author: francois Date: 2014-03-20 17:45:08 +0100 (Thu, 20 Mar 2014) New Revision: 892 Modified: pkg/DESCRIPTION Log: update DESCRIPTION file Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2014-03-20 16:43:46 UTC (rev 891) +++ pkg/DESCRIPTION 2014-03-20 16:45:08 UTC (rev 892) @@ -2,13 +2,14 @@ Type: Package Title: Base package for phylogenetic structures and comparative data Version: 0.6.8 -Date: 2014-03-17 -Imports: ade4, - ape (>= 3.0), - Rcpp (>= 0.11.0), - methods +Date: 2014-03-20 +Imports: + ade4, + ape (>= 3.0), + Rcpp (>= 0.11.0), + methods Depends: - grid + grid LinkingTo: Rcpp Suggests: MASS, From noreply at r-forge.r-project.org Thu Mar 20 21:39:00 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 20 Mar 2014 21:39:00 +0100 (CET) Subject: [Phylobase-commits] r893 - pkg Message-ID: <20140320203900.AA85118694E@r-forge.r-project.org> Author: francois Date: 2014-03-20 21:39:00 +0100 (Thu, 20 Mar 2014) New Revision: 893 Added: pkg/.Rbuildignore Log: adding .Rbuildignore file Added: pkg/.Rbuildignore =================================================================== --- pkg/.Rbuildignore (rev 0) +++ pkg/.Rbuildignore 2014-03-20 20:39:00 UTC (rev 893) @@ -0,0 +1,6 @@ +TAGS +TODO +cleanup +^\. +.?svn.? +~$ From noreply at r-forge.r-project.org Thu Mar 20 23:08:16 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 20 Mar 2014 23:08:16 +0100 (CET) Subject: [Phylobase-commits] r894 - in tags: . phylobase-0.6.8 phylobase-0.6.8/R phylobase-0.6.8/src phylobase-0.6.8/src/ncl Message-ID: <20140320220817.12A09186F93@r-forge.r-project.org> Author: francois Date: 2014-03-20 23:08:16 +0100 (Thu, 20 Mar 2014) New Revision: 894 Added: tags/phylobase-0.6.8/ tags/phylobase-0.6.8/.Rbuildignore tags/phylobase-0.6.8/DESCRIPTION tags/phylobase-0.6.8/NAMESPACE tags/phylobase-0.6.8/NEWS tags/phylobase-0.6.8/R/RcppExports.R tags/phylobase-0.6.8/R/class-phylomats.R tags/phylobase-0.6.8/R/methods-phylo4.R tags/phylobase-0.6.8/R/readNCL.R tags/phylobase-0.6.8/R/treewalk.R tags/phylobase-0.6.8/src/GetNCL.cpp tags/phylobase-0.6.8/src/Makevars tags/phylobase-0.6.8/src/Makevars.win tags/phylobase-0.6.8/src/RcppExports.cpp tags/phylobase-0.6.8/src/checkPhylo4.cpp tags/phylobase-0.6.8/src/ncl/nxsassumptionsblock.h Removed: tags/phylobase-0.6.8/DESCRIPTION tags/phylobase-0.6.8/NAMESPACE tags/phylobase-0.6.8/NEWS tags/phylobase-0.6.8/R/RcppExports.R tags/phylobase-0.6.8/R/class-phylomats.R tags/phylobase-0.6.8/R/methods-phylo4.R tags/phylobase-0.6.8/R/readNCL.R tags/phylobase-0.6.8/R/treewalk.R tags/phylobase-0.6.8/src/GetNCL.cpp tags/phylobase-0.6.8/src/Makevars tags/phylobase-0.6.8/src/Makevars.win tags/phylobase-0.6.8/src/RcppExports.cpp tags/phylobase-0.6.8/src/checkPhylo4.cpp tags/phylobase-0.6.8/src/ncl/nxsassumptionsblock.h Log: tagging the 0.6.8 CRAN release. Copied: tags/phylobase-0.6.8/.Rbuildignore (from rev 893, pkg/.Rbuildignore) =================================================================== --- tags/phylobase-0.6.8/.Rbuildignore (rev 0) +++ tags/phylobase-0.6.8/.Rbuildignore 2014-03-20 22:08:16 UTC (rev 894) @@ -0,0 +1,6 @@ +TAGS +TODO +cleanup +^\. +.?svn.? +~$ Deleted: tags/phylobase-0.6.8/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2014-03-17 13:29:22 UTC (rev 880) +++ tags/phylobase-0.6.8/DESCRIPTION 2014-03-20 22:08:16 UTC (rev 894) @@ -1,51 +0,0 @@ -Package: phylobase -Type: Package -Title: Base package for phylogenetic structures and comparative data -Version: 0.6.8 -Date: 2014-03-17 -Imports: ade4, - ape (>= 3.0), - Rcpp (>= 0.11.0), - methods -Depends: - grid -LinkingTo: Rcpp -Suggests: - MASS, - testthat (>= 0.8.1), - RUnit -Author: R Hackathon et al. (alphabetically: Ben Bolker, Marguerite Butler, - Peter Cowan, Damien de Vienne, Dirk Eddelbuettel, Mark Holder, Thibaut - Jombart, Steve Kembel, Francois Michonneau, David Orme, Brian O'Meara, - Emmanuel Paradis, Jim Regetz, Derrick Zwickl) -Maintainer: Francois Michonneau -Description: Provides a base S4 class for comparative methods, incorporating - one or more trees and trait data -License: GPL (>= 2) -Collate: - 'RcppExports.R' - 'phylo4.R' - 'checkdata.R' - 'formatData.R' - 'class-multiphylo4.R' - 'class-oldclasses.R' - 'class-phylo4.R' - 'class-phylo4d.R' - 'class-phylomats.R' - 'methods-multiphylo4.R' - 'methods-oldclasses.R' - 'methods-phylo4.R' - 'methods-phylo4d.R' - 'setAs-Methods.R' - 'pdata.R' - 'subset.R' - 'phylobase-package.R' - 'phylobase.options.R' - 'prune.R' - 'treePlot.R' - 'treestruc.R' - 'treewalk.R' - 'readNCL.R' - 'tbind.R' - 'zzz.R' -URL: http://phylobase.R-forge.R-project.org Copied: tags/phylobase-0.6.8/DESCRIPTION (from rev 892, pkg/DESCRIPTION) =================================================================== --- tags/phylobase-0.6.8/DESCRIPTION (rev 0) +++ tags/phylobase-0.6.8/DESCRIPTION 2014-03-20 22:08:16 UTC (rev 894) @@ -0,0 +1,52 @@ +Package: phylobase +Type: Package +Title: Base package for phylogenetic structures and comparative data +Version: 0.6.8 +Date: 2014-03-20 +Imports: + ade4, + ape (>= 3.0), + Rcpp (>= 0.11.0), + methods +Depends: + grid +LinkingTo: Rcpp +Suggests: + MASS, + testthat (>= 0.8.1), + RUnit +Author: R Hackathon et al. (alphabetically: Ben Bolker, Marguerite Butler, + Peter Cowan, Damien de Vienne, Dirk Eddelbuettel, Mark Holder, Thibaut + Jombart, Steve Kembel, Francois Michonneau, David Orme, Brian O'Meara, + Emmanuel Paradis, Jim Regetz, Derrick Zwickl) +Maintainer: Francois Michonneau +Description: Provides a base S4 class for comparative methods, incorporating + one or more trees and trait data +License: GPL (>= 2) +Collate: + 'RcppExports.R' + 'phylo4.R' + 'checkdata.R' + 'formatData.R' + 'class-multiphylo4.R' + 'class-oldclasses.R' + 'class-phylo4.R' + 'class-phylo4d.R' + 'class-phylomats.R' + 'methods-multiphylo4.R' + 'methods-oldclasses.R' + 'methods-phylo4.R' + 'methods-phylo4d.R' + 'setAs-Methods.R' + 'pdata.R' + 'subset.R' + 'phylobase-package.R' + 'phylobase.options.R' + 'prune.R' + 'treePlot.R' + 'treestruc.R' + 'treewalk.R' + 'readNCL.R' + 'tbind.R' + 'zzz.R' +URL: http://phylobase.R-forge.R-project.org Deleted: tags/phylobase-0.6.8/NAMESPACE =================================================================== --- pkg/NAMESPACE 2014-03-17 13:29:22 UTC (rev 880) +++ tags/phylobase-0.6.8/NAMESPACE 2014-03-20 22:08:16 UTC (rev 894) @@ -1,119 +0,0 @@ -# ---------------------------------------------------------------------- - -useDynLib(phylobase) - -#---------------------------------------------------------------------- - -import(methods) -import(ape) -import(Rcpp) - -importFrom(graphics, plot) -importFrom(stats, reorder) -importFrom(utils, head, tail) -importFrom(ade4, newick2phylog) - -#---------------------------------------------------------------------- - -exportClasses(phylo4, phylo4d, multiPhylo4, multiPhylo4d) - -#---------------------------------------------------------------------- - -# utility methods -exportMethods(print, head, tail, reorder, plot, summary) - -# tree constructor methods -exportMethods(phylo4, phylo4d) - -# counting methods -exportMethods(nTips, nNodes, nEdges, depthTips) - -# edge methods -exportMethods(edges, edgeId, hasEdgeLength, edgeLength, "edgeLength<-", - sumEdgeLength, edgeOrder) - -# root methods -exportMethods(isRooted, rootNode, "rootNode<-") -#export(rootEdge) # no methods defined yet? - -# node methods -exportMethods(nodeId, nodeType, nodeDepth) - -# tree properties methods -exportMethods(isUltrametric) - -# tree data methods -exportMethods(tdata, "tdata<-", tipData, "tipData<-", nodeData, - "nodeData<-", hasTipData, hasNodeData, addData, nData) - -# subset methods -exportMethods(subset, prune, "[") - -# pdata methods -exportMethods("[<-", "[[", "[[<-") - -# label methods -exportMethods(labels, "labels<-", nodeLabels, "nodeLabels<-", - tipLabels, "tipLabels<-", edgeLabels, "edgeLabels<-", - hasNodeLabels, hasEdgeLabels, hasDuplicatedLabels) - -#---------------------------------------------------------------------- - -# tree structure functions -export(hasPoly, hasSingle, hasRetic) - -# treewalk functions -export(getNode, ancestor, children, descendants, siblings, ancestors, - MRCA, shortestPath, getEdge) - -# Import functions -export(readNexus) -export(readNewick) -export(readNCL) - -# pdata functions -export(pdata, check_pdata) - -# plotting functions -export(treePlot, plotOneTree, tip.data.plot) -export(phyloXXYY, phylobubbles) - -# misc functions -export(extractTree, tbind) -export(checkPhylo4, checkTree, checkPhylo4Data, formatData) -export(as_phylo4vcov) -export(printphylo4) - -#---------------------------------------------------------------------- - -# misc objects -export(phylo4_orderings) - -## options -export(phylobase.options) - - - -## commented out in source code, probably should be omitted here -#export(phyloStripchart) -#export(internEdges, terminEdges, isPoly) - -## presumably these should remain hidden -##export(.createLabels, .createEdge, .phylo4Data, orderIndex, .genlab, -## .chnumsort, .phylo4ToDataFrame, .bubLegendGrob) -## hidden: drawDetails.bubLegend) - -## recently removed: -## tree.plot -## segs -## checkData -## attachData -## orderIndex - -#---------------------------------------------------------------------- -## For reference, quick & dirty UNIX-y commandline statements to pull -## out methods and functions from package code; use in pkg/R/ dir: -# grep "^ *setMethod" *.R | sed 's/setMethod(//' | sed 's/.*:["]\([^,]*\)["].*/\1/' | sort | uniq -# grep "^ *setReplaceMethod" *.R | sed 's/setReplaceMethod(//' | sed 's/.*:["]\([^,]*\)["].*/\1/' | sort | uniq -# grep "^[^ ].*<- *function *(" *.R | sed 's/.*R://' - Copied: tags/phylobase-0.6.8/NAMESPACE (from rev 886, pkg/NAMESPACE) =================================================================== --- tags/phylobase-0.6.8/NAMESPACE (rev 0) +++ tags/phylobase-0.6.8/NAMESPACE 2014-03-20 22:08:16 UTC (rev 894) @@ -0,0 +1,119 @@ +# ---------------------------------------------------------------------- + +useDynLib(phylobase) + +#---------------------------------------------------------------------- + +import(methods) +import(ape) + +importFrom(Rcpp, evalCpp) +importFrom(graphics, plot) +importFrom(stats, reorder) +importFrom(utils, head, tail) +importFrom(ade4, newick2phylog) + +#---------------------------------------------------------------------- + +exportClasses(phylo4, phylo4d, multiPhylo4, multiPhylo4d) + +#---------------------------------------------------------------------- + +# utility methods +exportMethods(print, head, tail, reorder, plot, summary) + +# tree constructor methods +exportMethods(phylo4, phylo4d) + +# counting methods +exportMethods(nTips, nNodes, nEdges, depthTips) + +# edge methods +exportMethods(edges, edgeId, hasEdgeLength, edgeLength, "edgeLength<-", + sumEdgeLength, edgeOrder) + +# root methods +exportMethods(isRooted, rootNode, "rootNode<-") +#export(rootEdge) # no methods defined yet? + +# node methods +exportMethods(nodeId, nodeType, nodeDepth) + +# tree properties methods +exportMethods(isUltrametric) + +# tree data methods +exportMethods(tdata, "tdata<-", tipData, "tipData<-", nodeData, + "nodeData<-", hasTipData, hasNodeData, addData, nData) + +# subset methods +exportMethods(subset, prune, "[") + +# pdata methods +exportMethods("[<-", "[[", "[[<-") + +# label methods +exportMethods(labels, "labels<-", nodeLabels, "nodeLabels<-", + tipLabels, "tipLabels<-", edgeLabels, "edgeLabels<-", + hasNodeLabels, hasEdgeLabels, hasDuplicatedLabels) + +#---------------------------------------------------------------------- + +# tree structure functions +export(hasPoly, hasSingle, hasRetic) + +# treewalk functions +export(getNode, ancestor, children, descendants, siblings, ancestors, + MRCA, shortestPath, getEdge) + +# Import functions +export(readNexus) +export(readNewick) +export(readNCL) + +# pdata functions +export(pdata, check_pdata) + +# plotting functions +export(treePlot, plotOneTree, tip.data.plot) +export(phyloXXYY, phylobubbles) + +# misc functions +export(extractTree, tbind) +export(checkPhylo4, checkTree, checkPhylo4Data, formatData) +export(as_phylo4vcov) +export(printphylo4) + +#---------------------------------------------------------------------- + +# misc objects +export(phylo4_orderings) + +## options +export(phylobase.options) + + + +## commented out in source code, probably should be omitted here +#export(phyloStripchart) +#export(internEdges, terminEdges, isPoly) + +## presumably these should remain hidden +##export(.createLabels, .createEdge, .phylo4Data, orderIndex, .genlab, +## .chnumsort, .phylo4ToDataFrame, .bubLegendGrob) +## hidden: drawDetails.bubLegend) + +## recently removed: +## tree.plot +## segs +## checkData +## attachData +## orderIndex + +#---------------------------------------------------------------------- +## For reference, quick & dirty UNIX-y commandline statements to pull +## out methods and functions from package code; use in pkg/R/ dir: +# grep "^ *setMethod" *.R | sed 's/setMethod(//' | sed 's/.*:["]\([^,]*\)["].*/\1/' | sort | uniq +# grep "^ *setReplaceMethod" *.R | sed 's/setReplaceMethod(//' | sed 's/.*:["]\([^,]*\)["].*/\1/' | sort | uniq +# grep "^[^ ].*<- *function *(" *.R | sed 's/.*R://' + Deleted: tags/phylobase-0.6.8/NEWS =================================================================== --- pkg/NEWS 2014-03-17 13:29:22 UTC (rev 880) +++ tags/phylobase-0.6.8/NEWS 2014-03-20 22:08:16 UTC (rev 894) @@ -1,230 +0,0 @@ - - - - ************************************************* - * * - * 0.6 SERIES NEWS * - * * - ************************************************* - - CHANGES IN phylobase VERSION 0.6.3 - - * Fixed bugs in getNode in cases where labels included regexpr - metacharacters and when a tip was labelled 0 - - * New methods: depthTips, nodeDepth and isUltrametric - - - CHANGES IN phylobase VERSION 0.6.2 - - * Improve handling of errors returned by NCL (NxsException) - - * Fix bug in case state labels are missing from the NEXUS file - - * Upgrade to NCL 2.1.14 - - CHANGES IN phylobase VERSION 0.6.1 - - * Fix bugs that prevented building on Windows 64-bit systems - - - CHANGES IN phylobase VERSION 0.6 - -MAJOR CHANGES - - * Updated to the Nexus Class Library (NCL) 2.1.12. - - * Changed the way NCL is built during the installation process. - - * Complete rewrite of the function readNexus which brings many new - functionalities. - - * Nodes labels do not have to be unique. - - -NEW FEATURES - - * In readNexus, the option return.labels gives the state labels of the - characters. - - * It is now possible to import several types of data blocks in a single - NEXUS file with readNexus. - - * The function phylobase.options() provides global options to control the - behavior of the phylo4/phylo4d validator. - - * The new method hasDuplicatedLabels() indicates whether any node labels - are duplicated. - - * The new method nData() returns the number of datasets associated with - a tree. - - * The column that contains the labels can now be specified by its name in - the function formatData() - -CHANGES - - * The function getNode() has been modified to allow node matching in the - case of non-unique labels. - - * Many new unit tests. - -BUG FIXES - - * Far too many to document. See the SVN log for details. - -KNOWN ISSUES - - * Unrooted trees are not supported by all functions, e.g. plot() and - reorder(). - - * Factors are not supported by the default plotting method. - - - ************************************************* - * * - * 0.5 SERIES NEWS * - * * - ************************************************* - - CHANGES IN phylobase VERSION 0.5 - -MAJOR CHANGES - - * A var-cov matrix tree class, phylo4vcov, and methods for converting to - and from other classes now exists. - - * Replaced separate the tip.label and node.label slots with a unified - label slot in the phylo4 class definition. - - * Replaced separate the tip.data and node.data into a single data slot in - the phylo4d class definition. - - * The phylo4 class grew a annotate slot. - - * The phylo4d class grew a metadata slot. - - * Added an order slot to the phylo4 class definition and updated as() - methods to assign the proper order (if possible) when converting - between ape and phylobase tree formats. - - * The Nnode slot was removed from the phylo4 class definition. - - * An explicit root edge has been added to the edge matrix with 0 as the - ancestor and nTips(phy) + 1 as the rood node. - - * The edgeLabels() and edgeLength() accessors now return vectors with - named elements in the same order as rows of the edge matrix, even when - some/all values are missing. - - * The labels() accessor and nodeID() methods now always return labels in - ascending order of node ID - - * Many function and argument names and defaults have been changed to make - them more consistent most functions follow the getNode() pattern. - - * The plotting functions have been replaced (see below). - - * Now, data are matched against node numbers instead of node labels. - - * Tip and internal node labels have now internal names that are character - strings of the node number they correspond to. Thus it is possible to - store labels in any order and assignment of labels more robust. - - * We now use the RUnit package (not required for normal use) for adding - unit tests. Adding unit tests to inst/unitTests/ is now preferred over - the tests/ directory. - - * Numerous changes to pruning and tree subsetting code. It is - considerably more robust and no longer relies on calls to APE. - -NEW FEATURES - - * Added a function nodeType() for identifying whether a node is root, - tip or internal. - - * Changed nodeNumbers to nodeId() and extended it abilities. - - * Added method reorder() for converting edge matrices into preorder or - postorder. - - * Added the edgeOrder accessor to get the order of a phylobase object. - - * Added a package help file accessible from ?phylobase. - - * Added labels()<- for assigning labels. - - * Added edgeLength()<- for assigning edgeLengths. - - * Added a phylo4() method for importing APE phylo objects. - - * Added a hasTipData() method. - - * Added a edgeId() method. - - * Created the addData() method for adding data to phylo4 objects. - - * Added tipData and nodeData getter/setter methods - - * If all node.labels are numerical values, they are automatically - converted as data. Useful when importing consensus tree from MrBayes. - - * It is now possible to print tree objects in edge order using the - edgeOrder argument in printphylo4(). - - * reorder(), descendants(), ancestors(), and portions of the plotting code - have been recoded in C to improve performance. - - * Added a developer vignette to document and guide development of the - phylobase package. - - * The previous plotting functions, based on base graphics, have been - replaced with function based on the grid graphics device. - - * A S4 generic plot() function, calling treePlot() has been added it - dispatches a plotting function based on object class and arguments. - - * Plots using grid based code can be inserted at the tree tips using the - tip.plot.fun argument in plot() - - * The getNode() method has been enhanced to allow matching against - specific node types, and if the requested node is missing, all nodes of - specified type are returned. - - * Changed getEdge() to allow no node argument, which returns all edges - appropriate for the given type. - -CHANGES - - * Node labels are, if not supplied, a vector of NA. - - * printphylo() is now deprecated, print() and summary() now alsow work on - empty objects. - - * phylo4() is now and S4 generic with signature "matrix". - - * phylobase now uses a NAMESPACE file. - - * Legacy plotting code (0.4) can be found in the SVN repo tags directory. - - * The tdata default "type" argument changed to 'all'. - - * Row names now stored internally as numeric, not character. - -BUG FIXES - - * Far too many to document. See the SVN log for details. - -KNOWN ISSUES - - * Unrooted trees are not supported by all functions, e.g. plot() and - reorder(). - - * Factors are not supported by the default plotting method. - - * The Nexus Class Library is build for the system default ARCH which may - or may not be the architecture that R and the rest of the package is - built with. If this occurs the package will fail to load. - - * Unique labels are required for internal nodes, this behavior will be - changed in the future. Copied: tags/phylobase-0.6.8/NEWS (from rev 888, pkg/NEWS) =================================================================== --- tags/phylobase-0.6.8/NEWS (rev 0) +++ tags/phylobase-0.6.8/NEWS 2014-03-20 22:08:16 UTC (rev 894) @@ -0,0 +1,249 @@ + + + + ************************************************* + * * + * 0.6 SERIES NEWS * + * * + ************************************************* + + CHANGES IN phylobase VERSION 0.6.8 + + * Not many user-visible changes, most are related to improving speeds + during test of object validation (most tests done in C++) and to getNode + that is used by many functions. + + * Changes to package structure to make it compatible with devtools + (switching testing to testthat -- partial at this stage) and docs to + roxygen format (partial at this stage). + + * Changes to package structure to comply with new Rcpp standards + + CHANGES IN phylobase VERSION 0.6.5 + + * Updates from cout/cerr to Rcpp::Rcout/Rcerr + + * Comments in Nexus tree strings are being removed before being processed by + readNCL + + CHANGES IN phylobase VERSION 0.6.3 + + * Fixed bugs in getNode in cases where labels included regexpr + metacharacters and when a tip was labelled 0 + + * New methods: depthTips, nodeDepth and isUltrametric + + + CHANGES IN phylobase VERSION 0.6.2 + + * Improve handling of errors returned by NCL (NxsException) + + * Fix bug in case state labels are missing from the NEXUS file + + * Upgrade to NCL 2.1.14 + + CHANGES IN phylobase VERSION 0.6.1 + + * Fix bugs that prevented building on Windows 64-bit systems + + + CHANGES IN phylobase VERSION 0.6 + +MAJOR CHANGES + + * Updated to the Nexus Class Library (NCL) 2.1.12. + + * Changed the way NCL is built during the installation process. + + * Complete rewrite of the function readNexus which brings many new + functionalities. + + * Nodes labels do not have to be unique. + + +NEW FEATURES + + * In readNexus, the option return.labels gives the state labels of the + characters. + + * It is now possible to import several types of data blocks in a single + NEXUS file with readNexus. + + * The function phylobase.options() provides global options to control the + behavior of the phylo4/phylo4d validator. + + * The new method hasDuplicatedLabels() indicates whether any node labels + are duplicated. + + * The new method nData() returns the number of datasets associated with + a tree. + + * The column that contains the labels can now be specified by its name in + the function formatData() + +CHANGES + + * The function getNode() has been modified to allow node matching in the + case of non-unique labels. + + * Many new unit tests. + +BUG FIXES + + * Far too many to document. See the SVN log for details. + +KNOWN ISSUES + + * Unrooted trees are not supported by all functions, e.g. plot() and + reorder(). + + * Factors are not supported by the default plotting method. + + + ************************************************* + * * + * 0.5 SERIES NEWS * + * * + ************************************************* + + CHANGES IN phylobase VERSION 0.5 + +MAJOR CHANGES + + * A var-cov matrix tree class, phylo4vcov, and methods for converting to + and from other classes now exists. + + * Replaced separate the tip.label and node.label slots with a unified + label slot in the phylo4 class definition. + + * Replaced separate the tip.data and node.data into a single data slot in + the phylo4d class definition. + + * The phylo4 class grew a annotate slot. + + * The phylo4d class grew a metadata slot. + + * Added an order slot to the phylo4 class definition and updated as() + methods to assign the proper order (if possible) when converting + between ape and phylobase tree formats. + + * The Nnode slot was removed from the phylo4 class definition. + + * An explicit root edge has been added to the edge matrix with 0 as the + ancestor and nTips(phy) + 1 as the rood node. + + * The edgeLabels() and edgeLength() accessors now return vectors with + named elements in the same order as rows of the edge matrix, even when + some/all values are missing. + + * The labels() accessor and nodeID() methods now always return labels in + ascending order of node ID + + * Many function and argument names and defaults have been changed to make + them more consistent most functions follow the getNode() pattern. + + * The plotting functions have been replaced (see below). + + * Now, data are matched against node numbers instead of node labels. + + * Tip and internal node labels have now internal names that are character + strings of the node number they correspond to. Thus it is possible to + store labels in any order and assignment of labels more robust. + + * We now use the RUnit package (not required for normal use) for adding + unit tests. Adding unit tests to inst/unitTests/ is now preferred over + the tests/ directory. + + * Numerous changes to pruning and tree subsetting code. It is + considerably more robust and no longer relies on calls to APE. + +NEW FEATURES + + * Added a function nodeType() for identifying whether a node is root, + tip or internal. + + * Changed nodeNumbers to nodeId() and extended it abilities. + + * Added method reorder() for converting edge matrices into preorder or + postorder. + + * Added the edgeOrder accessor to get the order of a phylobase object. + + * Added a package help file accessible from ?phylobase. + + * Added labels()<- for assigning labels. + + * Added edgeLength()<- for assigning edgeLengths. + + * Added a phylo4() method for importing APE phylo objects. + + * Added a hasTipData() method. + + * Added a edgeId() method. + + * Created the addData() method for adding data to phylo4 objects. + + * Added tipData and nodeData getter/setter methods + + * If all node.labels are numerical values, they are automatically + converted as data. Useful when importing consensus tree from MrBayes. + + * It is now possible to print tree objects in edge order using the + edgeOrder argument in printphylo4(). + + * reorder(), descendants(), ancestors(), and portions of the plotting code + have been recoded in C to improve performance. + + * Added a developer vignette to document and guide development of the + phylobase package. + + * The previous plotting functions, based on base graphics, have been + replaced with function based on the grid graphics device. + + * A S4 generic plot() function, calling treePlot() has been added it + dispatches a plotting function based on object class and arguments. + + * Plots using grid based code can be inserted at the tree tips using the + tip.plot.fun argument in plot() + + * The getNode() method has been enhanced to allow matching against + specific node types, and if the requested node is missing, all nodes of + specified type are returned. + + * Changed getEdge() to allow no node argument, which returns all edges + appropriate for the given type. + +CHANGES + + * Node labels are, if not supplied, a vector of NA. + + * printphylo() is now deprecated, print() and summary() now alsow work on + empty objects. + + * phylo4() is now and S4 generic with signature "matrix". + + * phylobase now uses a NAMESPACE file. + + * Legacy plotting code (0.4) can be found in the SVN repo tags directory. + + * The tdata default "type" argument changed to 'all'. + + * Row names now stored internally as numeric, not character. + +BUG FIXES + + * Far too many to document. See the SVN log for details. + +KNOWN ISSUES + + * Unrooted trees are not supported by all functions, e.g. plot() and + reorder(). + + * Factors are not supported by the default plotting method. + + * The Nexus Class Library is build for the system default ARCH which may + or may not be the architecture that R and the rest of the package is + built with. If this occurs the package will fail to load. + + * Unique labels are required for internal nodes, this behavior will be + changed in the future. Deleted: tags/phylobase-0.6.8/R/RcppExports.R =================================================================== --- pkg/R/RcppExports.R 2014-03-17 13:29:22 UTC (rev 880) +++ tags/phylobase-0.6.8/R/RcppExports.R 2014-03-20 22:08:16 UTC (rev 894) @@ -1,79 +0,0 @@ -# This file was generated by Rcpp::compileAttributes -# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -isLabelName <- function(lblToCheck, lbl) { - .Call('phylobase_isLabelName', PACKAGE = 'phylobase', lblToCheck, lbl) -} - -nRoots <- function(ances) { - .Call('phylobase_nRoots', PACKAGE = 'phylobase', ances) -} - -tabulateTips <- function(ances) { - .Call('phylobase_tabulateTips', PACKAGE = 'phylobase', ances) -} - -nTipsSafe <- function(ances) { - .Call('phylobase_nTipsSafe', PACKAGE = 'phylobase', ances) -} - -nTipsFastCpp <- function(ances) { - .Call('phylobase_nTipsFastCpp', PACKAGE = 'phylobase', ances) -} - -hasSingleton <- function(ances) { - .Call('phylobase_hasSingleton', PACKAGE = 'phylobase', ances) -} - -hasPolytomy <- function(ances) { - .Call('phylobase_hasPolytomy', PACKAGE = 'phylobase', ances) -} - -tipsSafe <- function(ances, desc) { - .Call('phylobase_tipsSafe', PACKAGE = 'phylobase', ances, desc) -} - -tipsFast <- function(ances) { - .Call('phylobase_tipsFast', PACKAGE = 'phylobase', ances) -} - -getAllNodesSafe <- function(edge) { - .Call('phylobase_getAllNodesSafe', PACKAGE = 'phylobase', edge) -} - -getAllNodesFast <- function(edge, rooted) { - .Call('phylobase_getAllNodesFast', PACKAGE = 'phylobase', edge, rooted) -} - -testEqInt <- function(x, y) { - .Call('phylobase_testEqInt', PACKAGE = 'phylobase', x, y) -} - -all_naC <- function(x) { - .Call('phylobase_all_naC', PACKAGE = 'phylobase', x) -} - -any_naC <- function(x) { - .Call('phylobase_any_naC', PACKAGE = 'phylobase', x) -} - -nb_naC <- function(x) { - .Call('phylobase_nb_naC', PACKAGE = 'phylobase', x) -} - -getRange <- function(x, na_rm) { - .Call('phylobase_getRange', PACKAGE = 'phylobase', x, na_rm) -} - -hasDuplicatedLabelsCpp <- function(label) { - .Call('phylobase_hasDuplicatedLabelsCpp', PACKAGE = 'phylobase', label) -} - -edgeIdCpp <- function(edge, type) { - .Call('phylobase_edgeIdCpp', PACKAGE = 'phylobase', edge, type) -} - -checkTreeCpp <- function(obj, opts) { - .Call('phylobase_checkTreeCpp', PACKAGE = 'phylobase', obj, opts) -} - Copied: tags/phylobase-0.6.8/R/RcppExports.R (from rev 887, pkg/R/RcppExports.R) =================================================================== --- tags/phylobase-0.6.8/R/RcppExports.R (rev 0) +++ tags/phylobase-0.6.8/R/RcppExports.R 2014-03-20 22:08:16 UTC (rev 894) @@ -0,0 +1,83 @@ +# This file was generated by Rcpp::compileAttributes +# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +isLabelName <- function(lblToCheck, lbl) { + .Call('phylobase_isLabelName', PACKAGE = 'phylobase', lblToCheck, lbl) +} + +nRoots <- function(ances) { + .Call('phylobase_nRoots', PACKAGE = 'phylobase', ances) +} + +tabulateTips <- function(ances) { + .Call('phylobase_tabulateTips', PACKAGE = 'phylobase', ances) +} + +nTipsSafe <- function(ances) { + .Call('phylobase_nTipsSafe', PACKAGE = 'phylobase', ances) +} + +nTipsFastCpp <- function(ances) { + .Call('phylobase_nTipsFastCpp', PACKAGE = 'phylobase', ances) +} + +hasSingleton <- function(ances) { + .Call('phylobase_hasSingleton', PACKAGE = 'phylobase', ances) +} + +hasPolytomy <- function(ances) { + .Call('phylobase_hasPolytomy', PACKAGE = 'phylobase', ances) +} + +tipsSafe <- function(ances, desc) { + .Call('phylobase_tipsSafe', PACKAGE = 'phylobase', ances, desc) +} + +tipsFast <- function(ances) { + .Call('phylobase_tipsFast', PACKAGE = 'phylobase', ances) +} + +getAllNodesSafe <- function(edge) { + .Call('phylobase_getAllNodesSafe', PACKAGE = 'phylobase', edge) +} + +getAllNodesFast <- function(edge, rooted) { + .Call('phylobase_getAllNodesFast', PACKAGE = 'phylobase', edge, rooted) +} + +testEqInt <- function(x, y) { + .Call('phylobase_testEqInt', PACKAGE = 'phylobase', x, y) +} + +all_naC <- function(x) { + .Call('phylobase_all_naC', PACKAGE = 'phylobase', x) +} + +any_naC <- function(x) { + .Call('phylobase_any_naC', PACKAGE = 'phylobase', x) +} + +nb_naC <- function(x) { + .Call('phylobase_nb_naC', PACKAGE = 'phylobase', x) +} + +getRange <- function(x, na_rm) { + .Call('phylobase_getRange', PACKAGE = 'phylobase', x, na_rm) +} + +hasDuplicatedLabelsCpp <- function(label) { + .Call('phylobase_hasDuplicatedLabelsCpp', PACKAGE = 'phylobase', label) +} + +edgeIdCpp <- function(edge, type) { + .Call('phylobase_edgeIdCpp', PACKAGE = 'phylobase', edge, type) +} + +checkTreeCpp <- function(obj, opts) { + .Call('phylobase_checkTreeCpp', PACKAGE = 'phylobase', obj, opts) +} + +GetNCL <- function(params, paramsVecR) { + .Call('phylobase_GetNCL', PACKAGE = 'phylobase', params, paramsVecR) +} + Deleted: tags/phylobase-0.6.8/R/class-phylomats.R =================================================================== --- pkg/R/class-phylomats.R 2014-03-17 13:29:22 UTC (rev 880) +++ tags/phylobase-0.6.8/R/class-phylomats.R 2014-03-20 22:08:16 UTC (rev 894) @@ -1,129 +0,0 @@ - -#' matrix classes for phylobase -#' -#' Classes representing phylogenies as matrices -#' -#' -#' @name phylomat-class -#' @aliases phylo4vcov-class as_phylo4vcov -#' @docType class -#' @param from a \code{phylo4} object [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/phylobase -r 894 From noreply at r-forge.r-project.org Mon Mar 31 17:59:34 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 31 Mar 2014 17:59:34 +0200 (CEST) Subject: [Phylobase-commits] r895 - pkg/R Message-ID: <20140331155934.1C910186F3E@r-forge.r-project.org> Author: francois Date: 2014-03-31 17:59:33 +0200 (Mon, 31 Mar 2014) New Revision: 895 Modified: pkg/R/readNCL.R Log: changed print() to message() Modified: pkg/R/readNCL.R =================================================================== --- pkg/R/readNCL.R 2014-03-20 22:08:16 UTC (rev 894) +++ pkg/R/readNCL.R 2014-03-31 15:59:33 UTC (rev 895) @@ -145,7 +145,7 @@ stop(ncl$ErrorMsg) } - if (!quiet) print(ncl) + if (!quiet) message(ncl) ## Disclaimer if (!length(grep("\\{", ncl$dataChr)) && return.labels && !polymorphic.convert) { From noreply at r-forge.r-project.org Mon Mar 31 18:24:15 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 31 Mar 2014 18:24:15 +0200 (CEST) Subject: [Phylobase-commits] r896 - pkg/R Message-ID: <20140331162415.58844186E34@r-forge.r-project.org> Author: francois Date: 2014-03-31 18:24:15 +0200 (Mon, 31 Mar 2014) New Revision: 896 Modified: pkg/R/checkdata.R pkg/R/class-phylo4d.R pkg/R/methods-multiphylo4.R pkg/R/methods-phylo4.R pkg/R/methods-phylo4d.R Log: added @include field in roxygen doc to create proper Collate field in DESCRIPTION Modified: pkg/R/checkdata.R =================================================================== --- pkg/R/checkdata.R 2014-03-31 15:59:33 UTC (rev 895) +++ pkg/R/checkdata.R 2014-03-31 16:24:15 UTC (rev 896) @@ -42,6 +42,8 @@ #' trees. See \code{\link{coerce-methods}} for translation functions and #' \code{\link{phylobase.options} to change some of the default options of the #' validator.} +#' @include RcppExports.R +#' @include phylo4.R #' @keywords misc checkPhylo4 <- function(object) { ct <- checkTree(object) Modified: pkg/R/class-phylo4d.R =================================================================== --- pkg/R/class-phylo4d.R 2014-03-31 15:59:33 UTC (rev 895) +++ pkg/R/class-phylo4d.R 2014-03-31 16:24:15 UTC (rev 896) @@ -35,6 +35,7 @@ #' \code{\link{checkPhylo4}} function to check the validity of \code{phylo4} #' trees. #' @keywords classes +#' @include formatData.R #' @examples #' example(read.tree, "ape") #' obj <- phylo4d(as(tree.owls.bis,"phylo4"), data.frame(wing=1:3)) Modified: pkg/R/methods-multiphylo4.R =================================================================== --- pkg/R/methods-multiphylo4.R 2014-03-31 15:59:33 UTC (rev 895) +++ pkg/R/methods-multiphylo4.R 2014-03-31 16:24:15 UTC (rev 896) @@ -9,3 +9,5 @@ #' @aliases multiPhylo-class multiPhylo4-class multiPhylo4d-class tbind #' @docType class #' @keywords classes +#' @include class-multiphylo4.R +NULL Modified: pkg/R/methods-phylo4.R =================================================================== --- pkg/R/methods-phylo4.R 2014-03-31 15:59:33 UTC (rev 895) +++ pkg/R/methods-phylo4.R 2014-03-31 16:24:15 UTC (rev 896) @@ -115,6 +115,10 @@ #' \item{isUltrametric}{\code{signature(object = "phylo4")}: whether the tree #' is ultrametric} } #' @keywords methods +#' @include RcppExports.R +#' @include phylo4.R +#' @include checkdata.R +#' @include class-phylo4.R #' @examples #' #' data(geospiza) Modified: pkg/R/methods-phylo4d.R =================================================================== --- pkg/R/methods-phylo4d.R 2014-03-31 15:59:33 UTC (rev 895) +++ pkg/R/methods-phylo4d.R 2014-03-31 16:24:15 UTC (rev 896) @@ -43,6 +43,10 @@ #' @author Ben Bolker, Thibaut Jombart, Francois Michonneau #' @seealso \code{\link{phylo4d}} #' @keywords methods +#' @include RcppExports.R +#' @include phylo4.R +#' @include checkdata.R +#' @include class-phylo4d.R #' @examples #' #' data(geospiza)