emmanuelparadis / ape

Analysis of Phylogenetics and Evolution
https://emmanuelparadis.github.io/
GNU General Public License v2.0
53 stars 11 forks source link

Issue in tree assignment #78

Closed ms609 closed 1 year ago

ms609 commented 1 year ago

Hi Emmanuel,

Just to bring your attention to a bug report at R that seems to affect "ape". (I don't think it's an ape issue, given that the affected code has not been modified for > 1 year and the bug has just shown up with recent releases of R-devel.)

Link: https://bugs.r-project.org/show_bug.cgi?id=18498

The minimal example in the bug report contains used streamlined versions of [<-.multiPhylo() (ASSIGN) and [[<-.multiPhylo() (ASSIGN2). The root issue is that trees[] <- otherTrees can sometimes replace otherTrees$edge with a NULL value. This is "unexpected" behaviour... but if you can offer any insight, I'd be glad to know!

Cheers,

Martin

MRE copied from bug report

# Install necessary packages
if (!requireNamespace("ape", quietly = TRUE)) install.packages("ape")
if (!requireNamespace("TreeSearch", quietly = TRUE)) install.packages("TreeSearch")

ASSIGN2 <- function(x, ii, val) { 
  oc <- oldClass(x)
  class(x) <- NULL

  Lab <- attr(x, "TipLabel")

  n <- length(Lab)
  o <- match(val$tip.label, Lab)
  val$tip.label <- NULL
  ie <- match(o, val$edge[, 2])
  val$edge[ie, 2] <- seq_len(n)

  x[[ii]] <- val
  class(x) <- oc
  x
}

ASSIGN <- function(x, value) {
  j <- 1L
  for (k in seq_along(x)) {
    val <- value[[j]]
    stopifnot(length(val$edge) > 0)
    x <- ASSIGN2(x, k, val)
    j <- j + 1L
  }
  x
}

library("ape") # The issue does not occur if APE is not loaded.
data("inapplicable.trees", package = "TreeSearch") # For an object that will trigger the error condition
original <- inapplicable.trees[["Vinther2008"]]
## or:
# original <- inapplicable.trees[["Vinther2008"]][8:71]
## The issue is encountered with ...[8:71], but not with smaller subsets

for (.i in 1:8) { ## Iteration 1 tends to succeed; error arises on a later loop
  message("Iteration ", .i)
  stopifnot(!is.null(original[[1]]$edge)) # Passes
  trees <- original
  stopifnot(isTRUE(all.equal(trees[[1]]$edge, original[[1]]$edge))) # OK
  stopifnot(!is.null(original[[1]]$edge)) # Failure occurs here. But `original` has not been modified!
  stopifnot(!is.null(trees[[1]]$edge)) # Also fails.
  tmp <- trees
  trees <- ASSIGN(trees, value = tmp)
}