Diff of /partyMod/R/Print.R [000000] .. [fbf06f]

Switch to side-by-side view

--- a
+++ b/partyMod/R/Print.R
@@ -0,0 +1,151 @@
+
+# $Id$
+
+prettysplit <- function(x, inames = NULL, ilevels = NULL) {
+    if (length(x) == 4)
+        names(x) <- c("variableID", "ordered", "splitpoint", "splitstatistics")
+    if (length(x) == 5)
+        names(x) <- c("variableID", "ordered", "splitpoint", "splitstatistics",
+                      "toleft")
+    if (length(x) == 6)
+        names(x) <- c("variableID", "ordered", "splitpoint", "splitstatistics",
+                      "toleft", "table")
+    if (x$ordered) {
+        class(x) <- "orderedSplit"
+    } else {
+        class(x) <- "nominalSplit"
+    }
+    if (!is.null(ilevels)) {
+        if (!is.null(ilevels[x[["variableID"]]]))
+            attr(x$splitpoint, "levels") <- ilevels[[x[["variableID"]]]]
+    }
+    if (!is.null(inames)) x$variableName <- inames[x[["variableID"]]]
+    return(x)
+}
+
+prettytree <- function(x, inames = NULL, ilevels = NULL) {
+    names(x) <- c("nodeID", "weights", "criterion", "terminal",
+                  "psplit", "ssplits", "prediction", "left", "right")
+    if (is.null(inames) && extends(class(x), "BinaryTree"))
+        inames <- names(x@data@get("input"))
+    names(x$criterion) <- c("statistic", "criterion", "maxcriterion")
+    names(x$criterion$criterion) <- inames
+    names(x$criterion$statistic) <- inames
+
+    if (x$terminal) {
+        class(x) <- "TerminalNode"
+        return(x)
+    }
+
+    x$psplit <- prettysplit(x$psplit, inames = inames, ilevels = ilevels)
+    if (length(x$ssplit) > 0)
+        x$ssplit <- lapply(x$ssplit, prettysplit, inames = inames, 
+                           ilevels = ilevels)
+
+    class(x) <- "SplittingNode"
+    x$left <- prettytree(x$left, inames = inames, ilevels = ilevels)   
+    x$right <- prettytree(x$right, inames = inames, ilevels = ilevels)    
+    return(x)
+}
+ 
+print.TerminalNode <- function(x, n = 1, ...) {
+    cat(paste(paste(rep(" ", n - 1), collapse = ""), x$nodeID, ")* ", 
+                    sep = "", collapse = ""),
+        "weights =", sum(x$weights), "\n")
+}
+ 
+print.SplittingNode <- function(x, n = 1, ...) {
+    cat(paste(paste(rep(" ", n - 1), collapse = ""), x$nodeID, ") ", sep=""))
+    print(x$psplit, left = TRUE)
+    cat(paste("; criterion = ", round(x$criterion$maxcriterion, 3), 
+              ", statistic = ", round(max(x$criterion$statistic), 3), "\n", 
+              collapse = "", sep = ""))
+    print(x$left, n + 2)
+    cat(paste(paste(rep(" ", n - 1), collapse = ""), x$nodeID, ") ", sep=""))
+    print(x$psplit, left = FALSE)
+    cat("\n")
+    print(x$right, n + 2)
+}
+
+print.orderedSplit <- function(x, left = TRUE, ...) {
+    if (!is.null(attr(x$splitpoint, "levels"))) {
+        sp <- attr(x$splitpoint, "levels")[x$splitpoint]
+    } else {
+        sp <- x$splitpoint
+    }
+    if (!is.null(x$toleft)) left <- as.logical(x$toleft) == left
+    if (left) {
+        cat(x$variableName, "<=", sp)
+    } else {
+        cat(x$variableName, ">", sp)
+    }
+}
+
+print.nominalSplit <- function(x, left = TRUE, ...) {
+
+    levels <- attr(x$splitpoint, "levels")
+
+    ### is > 0 for levels available in this node
+    tab <- x$table
+
+    if (left) {
+        lev <- levels[as.logical(x$splitpoint) & (tab > 0)]
+    } else {
+        lev <- levels[!as.logical(x$splitpoint) & (tab > 0)]
+    }
+
+    txt <- paste("{", paste(lev, collapse = ", "), "}", collapse = "", sep = "")
+    cat(x$variableName, "==", txt)
+}
+
+
+print.BinaryTreePartition <- function(x, ...)
+    print(x@tree)
+
+print.BinaryTree <- function(x, ...) {
+    cat("\n")
+    cat("\t Conditional inference tree with", length(unique(where(x))), 
+        "terminal nodes\n\n")
+    y <- x@responses
+    if (y@ninputs > 1) {
+        cat("Responses:", paste(names(y@variables), 
+                                collapse = ", "), "\n")
+    }  else {
+        cat("Response: ", names(y@variables), "\n")
+    }
+    inames <- names(x@data@get("input"))
+    if (length(inames) > 1) {
+        cat("Inputs: ", paste(inames, collapse = ", "), "\n")
+    } else {
+        cat("Input: ", inames, "\n")
+    }
+    cat("Number of observations: ", x@responses@nobs, "\n\n")
+    print(x@tree)
+}
+
+print.RandomForest <- function(x, ...) {
+    cat("\n")
+    cat("\t Random Forest using Conditional Inference Trees\n")
+    cat("\n")
+    cat("Number of trees: ", length(x@ensemble), "\n")
+    cat("\n")
+    y <- x@responses
+    if (y@ninputs > 1) {
+        cat("Responses:", paste(names(y@variables),
+                                collapse = ", "), "\n")
+    }  else {
+        cat("Response: ", names(y@variables), "\n")
+    }
+    inames <- names(x@data@get("input"))
+    if (length(inames) > 1) {
+        cat("Inputs: ", paste(inames, collapse = ", "), "\n")
+    } else {
+        cat("Input: ", inames, "\n")
+    }
+    cat("Number of observations: ", x@responses@nobs, "\n\n")
+    invisible(x)
+}
+
+setMethod("show", "BinaryTree", function(object) print(object))
+setMethod("show", "RandomForest", function(object) print(object))
+