Nothing
####**********************************************************************
####**********************************************************************
####
#### ----------------------------------------------------------------
#### Written by:
#### ----------------------------------------------------------------
#### John Ehrlinger, Ph.D.
####
#### email: john.ehrlinger@gmail.com
#### URL: https://github.com/ehrlinger/ggRandomForests
#### ----------------------------------------------------------------
####
####**********************************************************************
####**********************************************************************
#'
#' plot.gg_interaction
#' Plot a \code{\link{gg_interaction}} object,
#'
#' @param x gg_interaction object created from a
#' \code{\link[randomForestSRC]{rfsrc}} object
#' @param xvar variable (or list of variables) of interest.
#' @param lbls A vector of alternative variable names.
#' @param ... arguments passed to the \code{\link{gg_interaction}} function.
#'
#' @return \code{ggplot} object
#'
#' @seealso \code{\link[randomForestSRC]{rfsrc}}
#' \code{\link[randomForestSRC]{find.interaction}}
#' \code{\link[randomForestSRC]{max.subtree}}
#' \code{\link[randomForestSRC]{var.select}}
#' \code{\link[randomForestSRC]{vimp}}
#' \code{\link{plot.gg_interaction}}
#'
#' @references
#' Breiman L. (2001). Random forests, Machine Learning, 45:5-32.
#'
#' Ishwaran H. and Kogalur U.B. (2007). Random survival forests for
#' R, Rnews, 7(2):25-31.
#'
#' Ishwaran H. and Kogalur U.B. (2013). Random Forests for Survival,
#' Regression and Classification (RF-SRC), R package version 1.4.
#'
#' @importFrom ggplot2 ggplot aes_string geom_point geom_smooth labs
#' element_text
#' @importFrom tidyr gather
#'
#' @examples
#' \dontrun{
#' ## Examples from randomForestSRC package...
#' ## ------------------------------------------------------------
#' ## find interactions, classification setting
#' ## ------------------------------------------------------------
#' ## -------- iris data
#' ## iris.obj <- rfsrc(Species ~., data = iris)
#' ## TODO: VIMP interactions not handled yet....
#' ## find.interaction(iris.obj, method = "vimp", nrep = 3)
#' ## interaction_iris <- find.interaction(iris.obj)
#' data(interaction_iris, package="ggRandomForests")
#' gg_dta <- gg_interaction(interaction_iris)
#'
#' plot(gg_dta, xvar="Petal.Width")
#' plot(gg_dta, xvar="Petal.Length")
#' plot(gg_dta, panel=TRUE)
#'
#' ## ------------------------------------------------------------
#' ## find interactions, regression setting
#' ## ------------------------------------------------------------
#' ## -------- air quality data
#' ## airq.obj <- rfsrc(Ozone ~ ., data = airquality)
#' ##
#' ## TODO: VIMP interactions not handled yet....
#' ## find.interaction(airq.obj, method = "vimp", nrep = 3)
#' ## interaction_airq <- find.interaction(airq.obj)
#' data(interaction_airq, package="ggRandomForests")
#' gg_dta <- gg_interaction(interaction_airq)
#'
#' plot(gg_dta, xvar="Temp")
#' plot(gg_dta, xvar="Solar.R")
#' plot(gg_dta, panel=TRUE)
#'
#' ## -------- Boston data
#' data(interaction_boston, package="ggRandomForests")
#' gg_dta <- gg_interaction(interaction_boston)
#'
#' plot(gg_dta, panel=TRUE)
#'
#' ## -------- mtcars data
#' data(interaction_mtcars, package="ggRandomForests")
#' gg_dta <- gg_interaction(interaction_mtcars)
#'
#' plot(gg_dta, panel=TRUE)
#'
#' ## ------------------------------------------------------------
#' ## find interactions, survival setting
#' ## ------------------------------------------------------------
#' ## -------- pbc data
#' ## data(pbc, package = "randomForestSRC")
#' ## pbc.obj <- rfsrc(Surv(days,status) ~ ., pbc, nsplit = 10)
#' ## interaction_pbc <- find.interaction(pbc.obj, nvar = 8)
#' data(interaction_pbc, package="ggRandomForests")
#' gg_dta <- gg_interaction(interaction_pbc)
#'
#' plot(gg_dta, xvar="bili")
#' plot(gg_dta, xvar="copper")
#' plot(gg_dta, panel=TRUE)
#'
#' ## -------- veteran data
#' data(interaction_veteran, package="ggRandomForests")
#' gg_dta <- gg_interaction(interaction_veteran)
#'
#' plot(gg_dta, panel=TRUE)
#'
#' }
#'
#' @export
plot.gg_interaction <- function(x, xvar, lbls, ...) {
object <- x
if (is.matrix(x)) {
# Check to make sure it's the right type of matrix...
if (sum(colnames(x) != rownames(x)) > 0) {
stop("gg_interaction expects a rfsrc object, or a
find.interaction object.")
}
}
if (!inherits(object, "gg_interaction"))
object <- gg_interaction(x, ...)
if (missing(xvar))
xvar <- rownames(object)
if (sum(xvar %in% rownames(object)) == 0) {
stop(paste(
"Invalid xvar (",
xvar,
") specified, covariate not found.",
sep = ""
))
}
if (length(xvar) > 1) {
gg_dta <- data.frame(t(object[which(rownames(object) %in% xvar), ]))
gg_dta$names <- rownames(object)
gg_dta$rank <- seq_len(dim(gg_dta)[1])
gathercols <-
colnames(gg_dta)[-which(colnames(gg_dta) %in% c("rank", "names"))]
gg_dta <- tidyr::gather(gg_dta, "variable", "value", gathercols)
# Correct ordering: Issue #32 code contributed by afb206
gg_dta$variable <-
factor(gg_dta$variable, levels = unique(gg_dta$variable))
gg_dta$value <- as.numeric(gg_dta$value)
gg_dta$names <- factor(gg_dta$names,
levels = unique(gg_dta$names))
gg_plt <- ggplot(gg_dta) +
geom_point(aes_string(x = "names", y = "value")) +
geom_point(
aes_string(x = "names", y = "value"),
data = gg_dta[which(as.character(gg_dta$names) == gg_dta$variable), ],
shape = 3,
size = 5,
color = "red"
) +
theme(text = element_text(size = 10),
axis.text.x = element_text(angle = 90)) +
labs(x = "", y = "Interactive Minimal Depth")
if (!missing(lbls)) {
if (length(lbls) >= length(colnames(object))) {
st_lbls <- lbls[colnames(object)]
names(st_lbls) <- colnames(object)
st_lbls[which(is.na(st_lbls))] <-
names(st_lbls[which(is.na(st_lbls))])
gg_plt <- gg_plt +
scale_x_discrete(labels = st_lbls)
}
}
gg_plt + facet_wrap(~ variable)
} else {
gg_dta <- data.frame(cbind(rank = seq_len(dim(object)[1]),
t(object[which(rownames(object) %in% xvar), ])))
colnames(gg_dta)[2] <- "dpth"
gg_dta$names <- rownames(gg_dta)
gg_dta$dpth <- as.numeric(gg_dta$dpth)
gg_dta$names <- factor(gg_dta$names,
levels = unique(gg_dta$names))
gg_plt <- ggplot(gg_dta) +
geom_point(aes_string(x = "names", y = "dpth")) +
geom_point(
aes_string(x = "names", y = "dpth"),
data = gg_dta[which(rownames(gg_dta) == xvar), ],
shape = 3,
size = 5,
color = "red"
) +
theme(text = element_text(size = 10),
axis.text.x = element_text(angle = 90)) +
labs(x = "", y = "Interactive Minimal Depth")
if (!missing(lbls)) {
if (length(lbls) >= length(gg_dta$names)) {
st_lbls <- lbls[as.character(gg_dta$names)]
names(st_lbls) <- as.character(gg_dta$names)
st_lbls[which(is.na(st_lbls))] <-
names(st_lbls[which(is.na(st_lbls))])
gg_plt <- gg_plt +
scale_x_discrete(labels = st_lbls)
}
}
gg_plt
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.