X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2FrTrait.R;fp=R%2FrTrait.R;h=2c18d0940af08ada1fcaf1a67c8cba9b5402b1ed;hb=2e7fdb027f189e7c8eb771dadaf195c43bd41d5f;hp=ec055dcb58a643798cc51976938cc1e19ff4f6af;hpb=29792fb8cef8ddab4553474398369fb6c24c1d8b;p=ape.git

diff --git a/R/rTrait.R b/R/rTrait.R
index ec055dc..2c18d09 100644
--- a/R/rTrait.R
+++ b/R/rTrait.R
@@ -132,3 +132,41 @@ rTraitCont <-
     }
     x
 }
+
+rTraitMult <-
+    function(phy, model, p = 1, root.value = rep(0, p), ancestor = FALSE,
+             as.factor = NULL, ...)
+{
+    phy <- reorder(phy, "pruningwise")
+    n <- length(phy$tip.label)
+    m <- phy$Nnode
+    N <- dim(phy$edge)[1]
+    ROOT <- n + 1L
+
+    x <- matrix(0, n + m, p)
+    x[ROOT, ] <- root.value
+
+    anc <- phy$edge[, 1]
+    des <- phy$edge[, 2]
+
+    el <- phy$edge.length
+    if (is.null(el)) el <- numeric(N)
+
+    for (i in N:1) x[des[i], ] <- model(x[anc[i], ], el[i], ...)
+
+    if (ancestor) {
+        if (is.null(phy$node.label)) phy <- makeNodeLabel(phy)
+        rownames(x) <- c(phy$tip.label, phy$node.label)
+    } else {
+        x <- x[1:n, , drop = FALSE]
+        rownames(x) <- phy$tip.label
+    }
+    x <- as.data.frame(x)
+    if (!is.null(as.factor)) {
+        for (i in as.factor) {
+            y <- x[, i]
+            x[, i] <- factor(y, labels = LETTERS[1:length(unique(y))])
+        }
+    }
+    x
+}