R/mvr.R

   1 ## mvr.R (2011-10-11)
   2
   3 ##   Minimum Variance Reduction
   4
   5 ## Copyright 2011 Andrei-Alin Popescu
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 mvr <- function(X, V)
  11 {
  12     if (is.matrix(X)) X <- as.dist(X)
  13     if (is.matrix(V)) V <- as.dist(V)
  14     if (any(is.na(X)))
  15         stop("missing values are not allowed in the distance matrix")
  16     if (any(is.na(V)))
  17         stop("missing values are not allowed in the variance matrix")
  18     N <- attr(X, "Size")
  19     labels <- attr(X, "Labels")
  20     if (is.null(labels)) labels <- as.character(1:N)
  21     ans <- .C("mvr", as.double(X), as.double(V), as.integer(N),
  22               integer(2*N - 3), integer(2*N - 3), double(2*N - 3),
  23               DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")
  24     obj <- list(edge = cbind(ans[[4]], ans[[5]]), edge.length = ans[[6]],
  25                 tip.label = labels, Nnode = N - 2L)
  26     class(obj) <- "phylo"
  27     reorder(obj)
  28 }
  29
  30 mvrs <- function(X, V, fs = 15)
  31 {
  32     if (is.matrix(X)) X <- as.dist(X)
  33     if (is.matrix(V)) V <- as.dist(V)
  34
  35     X[is.na(X)] <- -1
  36     X[X < 0] <- -1
  37     X[is.nan(X)] <- -1
  38
  39     N <- attr(X, "Size")
  40     labels <- attr(X, "Labels")
  41     if (is.null(labels)) labels <- as.character(1:N)
  42     ans <- .C("mvrs", as.double(X), as.double(V), as.integer(N),
  43               integer(2*N - 3), integer(2*N - 3), double(2*N - 3),
  44               as.integer(fs), DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")
  45     obj <- list(edge = cbind(ans[[4]], ans[[5]]), edge.length = ans[[6]],
  46                 tip.label = labels, Nnode = N - 2L)
  47     class(obj) <- "phylo"
  48     reorder(obj)
  49 }