# $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))