small improvements

.Rbuildignore

@@ -19,3 +19,4 @@
 ^codemeta\.json$
 ^codecov\.yml$
 ^\.out.R
+^CONTRIBUTING.md$

CONTRIBUTING.md

@@ -12,10 +12,11 @@ phangorn is an open source project, maintained by people who care. We are not di
 [website]: https://KlausVigo.github.io/phangorn
 [citation]: https://KlausVigo.github.io/phangorn/authors.html
 [email]: mailto:[email protected]
-
+<!--
 ## Code of conduct
 
 Please note that this project is released with a [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By participating in this project you agree to abide by its terms.
+-->
 
 ## How you can contribute
 

NAMESPACE

@@ -198,6 +198,7 @@ export(optim.parsimony)
 export(optim.pml)
 export(pace)
 export(parsimony)
+export(parsimony_edgelength)
 export(path.dist)
 export(phyDat)
 export(phyDat2MultipleAlignment)

R/distTree.R

@@ -305,9 +305,6 @@ designUnrooted2 <- function(tree, sparse = TRUE) {
 
 
 designTipDated <- function(tree, tip.dates, sparse=TRUE){
-  #, strict=TRUE
-  #if(!is.numeric(tip.dates)) browser()
-  #if(!length(tip.dates) >= Ntip(tree)) browser()
   stopifnot(is.numeric(tip.dates), length(tip.dates) >= Ntip(tree))
   nTip <- Ntip(tree)
   tmp <- function(n){
@@ -367,7 +364,7 @@ designConstrained <- function(tree, sparse=TRUE, tip.dates=NULL,
 #' @export
 nnls.tree <- function(dm, tree, method=c("unrooted", "ultrametric", "tipdated"),
           rooted=NULL, trace=1, weight=NULL, balanced=FALSE, tip.dates=NULL,
-          constraint=NULL) {
+          calibration=NULL) {
   method <- match.arg(method, c("unrooted", "ultrametric", "tipdated"))
   if(has.singles(tree)) tree <- collapse.singles(tree)
   if (is.rooted(tree) && method == "unrooted") tree <- unroot(tree)

R/fitch64.R

@@ -89,7 +89,7 @@ random.addition <- function (data, tree=NULL, method = "fitch")
     tree$edge <- edge
     remaining <- sample(setdiff(label, tree$tip.label))
     tree$tip.label <- c(tree$tip.label, remaining)
-    tree <- relabel(tree, label)
+    tree <- checkLabels(tree, label)
     remaining <- match(remaining, label)
   }
 

R/joint_ASR.R

@@ -139,26 +139,44 @@ joint_sankoff <- function(tree, data, cost=NULL){
 }
 
 
-# alternative to acctran(tree, data)
+#' Assign edge length to tree
+#'
+#' \code{parsimony_edgelength} and \code{acctran} assign edge length to a tree where
+#' the edge length is the number of mutations. \code{parsimony_edgelengths}
+#' assigns edge lengths using a joint reconstruction based on the sankoff
+#' algorithm. Ties are broken at random and trees can be multifurating.
+#' \code{acctran} is based on the fitch algorithm and is faster. However trees
+#' need to be bifurcating and ties are split.
+#' @param tree a tree, i.e. an object of class pml
+#' @param data an object of class phyDat
+#' @return a tree with edge length.
+#' @export
+parsimony_edgelength <- function(tree, data){
+  if(inherits(tree, "phylo")) return(count_mutations(tree, data))
+  if(inherits(tree, "multiPhylo")) {
+    res <- lapply(tree, count_mutations, data=data)
+    class(res) <- "multiPhylo"
+    return(res)
+  }
+  NULL
+}
+
+
 count_mutations <- function(tree, data){
-  site <- "pscore"
   tree <- reorder(tree, "postorder")
   data <- data[tree$tip.label]
   tree_tmp <- makeNodeLabel(tree)
   anc <- joint_sankoff(tree_tmp, data)
+#  ind <-   length(data)+seq_along(anc)
+#  data[ind] <- anc
+#  names(dat[ind]) <- names(anc)
   dat <- rbind(data, anc)
-  nr <- attr(data, "nr")
   l <- length(dat)
-  fun <- function(x, site="pscore", nr){
-    if(site=="pscore") return(f$pscore(x))
-    sites <- f$sitewise_pscore(x)
-    sites[seq_len(nr)]
-  }
   f <- init_fitch(dat, FALSE, FALSE, m=2L)
   el <- numeric(nrow(tree$edge))
   for(i in seq_along(el)){
     edge_i <-  matrix(c(l+1L, l+1L, tree$edge[i,]), 2, 2)
-    el[i] <- fun(edge_i, site, nr)
+    el[i] <- f$pscore(edge_i)
   }
   tree$edge.length <- el
   tree

R/plotAnc.R

@@ -41,7 +41,7 @@ getTransition <- function(scheme, levels){
 #' @param \dots Further arguments passed to or from other methods.
 #' @returns \code{plotAnc} returns silently x.
 #' @author Klaus Schliep \email{klaus.schliep@@gmail.com}
-#' @seealso \code{\link{ancestral.pml}}, \code{\link[ape]{plot.phylo}},
+#' @seealso \code{\link{anc_pml}}, \code{\link[ape]{plot.phylo}},
 #' \code{\link[ape]{image.DNAbin}}, \code{\link[ape]{image.AAbin}}
 #' \code{\link[ggseqlogo]{ggseqlogo}}, \code{\link[ape]{edgelabels}}
 #' @keywords plot