# Copyright 2019 Robert Carnell
#' Plot an Importance Plot object
#'
#' @param x a \code{importance_plot} object
#' @param plot boolean to determine if the plot is displayed, or just returned
#' @param nvar the number of variables to plot in order of importance
#' @param col_imp_alone the color used for the variance explained by each variable
#' alone
#' @param col_imp_cumulative the color used for the cumulative variance explained
#' @param geom_bar_control list of arguments to control the plotting of \code{ggplot2::geom_bar}
#' @param ... future arguments
#'
#' @return the plot
#' @export
#'
#' @method plot importance_plot
#' @import ggplot2
#' @importFrom grid rectGrob grid.newpage grid.draw gpar unit.c unit
#' @importFrom gridExtra arrangeGrob
#' @importFrom scales percent
#' @importFrom grDevices dev.cur dev.off
#' @importFrom rlang .data
#'
#' @examples
#' gtest <- lm(mpg ~ cyl + wt + hp + gear + carb, data = mtcars)
#' gtestreduced <- lm(mpg ~ 1, data = mtcars)
#' imp <- importance(gtest, gtestreduced)
#' plot(imp)
#'
#' gtest <- survival::survreg(survival::Surv(futime, fustat) ~ ecog.ps*rx + age,
#' data = survival::ovarian,
#' dist = "weibull")
#' imp <- importance(gtest, survival::ovarian, nperm = 50)
#' plot(imp)
<- (x, = , nvar = ,
col_imp_alone = "#69BE28",
col_imp_cumulative = "#427730",
geom_bar_control = (fill = "#69BE28"),
)
{
if ((nvar) != 1) {
("nvar must be a length 1 integer or NA")
}
if (x$ %in% ("lm", "glm"))
{
if ((!(nvar)) & nvar <= (x$)/3)
{
temp <- x$[x$$posit == "Cum",]
ind <- (x$$variable %in% temp$variable[1:nvar])
x$ <- x$[ind,]
}
}
{
if ((!(nvar)) & nvar <= (x$))
x$ <- x$[1:nvar,]
}
if (x$ %in% ("lm", "glm"))
{
# if geom_bar_control contains fill, then delete it
ind <- ((geom_bar_control) == "fill")
original_geom_length <- (geom_bar_control)
original_fill <- geom_bar_control$fill
if ((ind) >= 1)
{
geom_bar_control <- geom_bar_control-ind]
# if fill was the default and the only entry skip, otherwise, warn
if ((ind) == 1 && original_geom_length == 1 && original_fill == "#69BE28")
{
# do nothing
} {
("geom_bar_control fill argument is not used with importance_plot with type lm or glm")
}
}
ggp <- ggplot(x$, aes(x = .data$variable, y = .data$value, fill = .data$posit)) + #,
#alpha = "posit")) +
(geom_bar, = ((stat = "identity"), geom_bar_control)) +
coord_flip() +
theme_bw() +
# create legend and turn it off
scale_fill_manual(values = ("Alone" = col_imp_alone,
"Space" = "white",
"Cum" = col_imp_cumulative),
guide = "none") +
# make the middle bar transparent
#scale_alpha_manual(values = list("Alone" = 1, "Space" = 0, "Cum" = 1),
# guide = "none") +
xlab("") +
scale_y_continuous( = scales::percent)
if (x$ == "glm")
{
ggp <- ggp + ylab("Percent of Model Deviance Explained (Importance)")
cats_for_dat3 <- (("Marginal Deviance Explained", "Cumulative Deviance Explained"))
}
{
ggp <- ggp + ylab("Percent of Model Variance Explained (Importance)")
cats_for_dat3 <- (("Marginal Variance Explained", "Cumulative Variance Explained"))
}
dat3 <- (
cats = cats_for_dat3,
heights = (1, 2),
cols = (("A", "B")),
stringsAsFactors = )
# create a dummy legend
ggp2 <- ggplot2::ggplot(dat3,
aes(x = .data$cats, y = .data$heights, fill = .data$cats)) +
(geom_bar, = ((stat = "identity"), geom_bar_control)) +
scale_fill_manual(values = (col_imp_cumulative, col_imp_alone)) +
theme(legend.title = element_blank(), legend.position = "bottom")
# ggplotGrob has a side effect of opening a device if one is not open
close_after <- (::() == 1 & (::()) == "null device")
gt <- ggplot2::ggplotGrob(ggp)
ggp2_grob <- ggplot2::ggplotGrob(ggp2)
if (close_after)
::()
# extract the legend
legend_grob <- ggp2_grob$grobs[grepl("guide-box", ggp2_grob$$)]
select <- (!(legend_grob, , (1), "zeroGrob"))[1]
legend_grob <- legend_grob[select]]
# blank grob
r <- ::(gp = ::(fill = , = ))
# height of legend
legend_height <- (legend_grob$)
# width of xlabs moved to ylabs
vert_axis_label <- gt$grobs[which(ggp2_grob$$ == "ylab-l")]]
vert_axis_label_width <- (vert_axis_label$)
# add the plot and legend together
combined <- gridExtra::arrangeGrob(
gt, r, legend_grob, layout_matrix = ((1,1,2,3), = 2, byrow = ),
heights = ::(::(1, "npc") - legend_height,
legend_height),
widths = ::(vert_axis_label_width,
::(1, "npc") - vert_axis_label_width))
if ()
{
::()
::(combined)
} {
(combined)
}
} if (x$ == "cv.glmnet")
{
ggp <- ggplot(x$, aes(x = .data$variable, y = .data$value)) +
(geom_bar, = ((stat = "identity"), geom_bar_control)) +
coord_flip() +
theme_bw() +
xlab("") +
scale_y_continuous( = scales::percent) +
ylab("Percent Increase in MSE when Variable is permuted (Importance)")
if () {(ggp)} {(ggp)}
} if (x$ == "survreg")
{
ggp <- ggplot(x$, aes(x = .data$variable, y = .data$value)) +
(geom_bar, = ((stat = "identity"), geom_bar_control)) +
coord_flip() +
theme_bw() +
xlab("") +
scale_y_continuous( = scales::percent) +
ylab("Change in Likelihood Ratio when Variable is permuted (Importance)")
if () {(ggp)} {(ggp)}
} if (x$ == "train")
{
ggp <- ggplot(x$, aes(x = .data$, y = .data$Overall)) +
(geom_bar, = ((stat = "identity"), geom_bar_control)) +
coord_flip() +
xlab("") +
ylab("Importance from caret::varImp") +
theme_bw()
if () {(ggp)} {(ggp)}
}
{
("unrecognized importance_plot type in plot.importance_plot")
}
}
