tests/testthat/test-iw-scoring.R

In TreeSearch: Phylogenetic Analysis with Discrete Character Data

test_that("IW Scoring", {
  library("TreeTools", quietly = TRUE)
  data("Lobo", package = "TreeTools")
  dataset <- Lobo.phy
  tree <- NJTree(dataset)
  
  
  .IWScore <- function (edge, morphyObjs, weight, minLength, concavity) {
    steps <- preorder_morphy_by_char(edge, morphyObjs)
    homoplasies <- steps - minLength
    fit <- homoplasies / (homoplasies + concavity)
    sum(fit * weight)
  }
  
  concavity <- 4.5
  epsilon <- sqrt(.Machine$double.eps)
  
  
  tree <- Preorder(RenumberTips(tree, names(dataset)))
  nTip <- NTip(tree)
  edge <- tree$edge
  
  at <- attributes(dataset)
  characters <- PhyToString(dataset, ps = "", useIndex = FALSE,
                            byTaxon = FALSE, concatenate = FALSE)
  startWeights <- at$weight
  morphyObjects <- lapply(characters, SingleCharMorphy)
  on.exit(morphyObjects <- vapply(morphyObjects, UnloadMorphy, integer(1)))
  
  nLevel <- length(at$level)
  nChar <- at$nr
  nTip <- length(dataset)
  cont <- at$contrast
  simpleCont <- ifelse(rowSums(cont) == 1,
                       apply(cont != 0, 1, function (x) colnames(cont)[x][1]),
                       "?")
  
  unlisted <- unlist(dataset, use.names = FALSE)
  tokenMatrix <- matrix(simpleCont[unlisted], nChar, nTip)
  charInfo <- apply(tokenMatrix, 1, CharacterInformation)
  needsInapp <- rowSums(tokenMatrix == "-") > 2
  inappSlowdown <- 3L # A guess
  rawPriority <- charInfo / ifelse(needsInapp, inappSlowdown, 1)
  priority <- startWeights * rawPriority
  informative <- needsInapp | charInfo > 0
  # Will work from end of sequence to start.
  charSeq <- seq_along(charInfo)[informative][order(priority[informative])] - 1L

  
  weight <- startWeights
  minLength <- MinimumLength(dataset, compress = TRUE)
  
  expect_equal(.IWScore(edge, morphyObjects, weight, minLength, concavity),
               morphy_iw(edge, morphyObjects, weight, minLength, charSeq, 
                         concavity, Inf))
  
  expect_equal(Inf, morphy_iw(edge, morphyObjects, weight, minLength, charSeq,
                              concavity, 0))
  
})