#' model_plot
#' @inheritParams area_plot
#' @param fitted A character value. Evaluates to a numeric column.
#' @param actual A character value. Evaluates to a logical or binary column.
#' @param res_bins Number of bins in the residual distribution. Default value
#' (NA) doesn't show the distribution.
#' @param point_size Numeric. Default is 2.
#'
#' @return A ggplot object.
#' @export
#'
#' @examples
#' y = rnorm(26)
#' df = data.frame(ID = 1:26, actual = y + rnorm(26), fitted = y, id = letters)
#' model_plot(df, "ID", "actual", "fitted")
#' model_plot(df, "id", "actual", "fitted")
#' model_plot(df, "ID", "actual", "fitted", res_bins = 10)
#' model_plot(df, "id", "actual", "fitted", res_bins = 10)
model_plot = function(data,
x,
actual,
fitted,
facet_x = NULL,
point_size = 2,
res_bins = NA_real_,
size = 11) {
gdata = data.frame(ID = eval(parse(text = x), data),
Actual = eval(parse(text = actual), data),
Fitted = eval(parse(text = fitted), data),
stringsAsFactors = FALSE)
gdata[["Residual"]] = gdata[["Actual"]] - gdata[["Fitted"]]
if (!is.null(facet_x)) {
gdata[["facet_x"]] = eval(parse(text = facet_x), data)
}
gdata = gdata %>%
group_by_at(vars(matches("facet_x"))) %>%
mutate(min_af = min(Fitted, Actual, na.rm = TRUE),
max_res = max(Residual, na.rm = TRUE)) %>%
ungroup
if (is.character(gdata[["ID"]]) | is.factor(gdata[["ID"]])) {
gdata[["id"]] = gdata[["ID"]]
gdata[["ID"]] = seq_len(nrow(gdata))
}
g = ggplot(gdata) +
suppressWarnings(geom_line(
aes(ID, Actual,
color = "Actual ",
linetype = "Actual ",
shape = "Actual ",
size = "Actual "),
na.rm = TRUE
)) +
suppressWarnings(geom_point(
aes(ID, Fitted,
color = "Fitted ",
linetype = "Fitted ",
shape = "Fitted ",
size = "Fitted "),
na.rm = TRUE
)) +
suppressWarnings(geom_segment(
aes(ID,
Residual + min_af - max_res,
xend = ID,
yend = min_af - max_res,
color = "Residual ",
linetype = "Residual ",
shape = "Residual ",
size = "Residual "),
na.rm = TRUE
)) +
scale_colour_manual(NULL,
labels = c("Actual ", "Fitted ", "Residual "),
values = c("dodgerblue4",
"tomato2",
"mediumorchid4")) +
scale_linetype_manual(NULL,
labels = c("Actual ", "Fitted ", "Residual "),
values = c(1, 0, 1)) +
scale_shape_manual(NULL,
labels = c("Actual ", "Fitted ", "Residual "),
values = c(NA, 16, 0)) +
scale_size_manual(NULL,
labels = c("Actual ", "Fitted ", "Residual "),
values = point_size ^ c(1, 0.5, 1) * c(0.75, 2, 0.75)) +
scale_y_continuous(labels = ezplot::ez_labels) +
ezplot::theme_ez(size) +
theme(
legend.position = "top",
panel.grid.major.x = element_line(colour = "grey85",
linewidth = if (size > 16) 0.8 else 0.2)
) +
guides(shape = guide_legend(override.aes=list(shape = c(NA, 16, NA)))) +
ylab(NULL) +
xlab(NULL)
if (!is.null(gdata[["id"]])) {
g = g +
scale_x_continuous(breaks = gdata[["ID"]],
labels = gdata[["id"]],
expand = c(0, 0.6)) +
theme(axis.text.x = element_text(angle = 90,
vjust = 0.38,
hjust = 1),
panel.grid.major.x = element_blank())
}
if (!is.na(res_bins)) {
bin_data = gdata %>%
mutate(bins = cut(Residual + min_af - max_res,
breaks = res_bins)) %>%
group_by_at(vars(matches("facet_x"))) %>%
mutate(x_start = max(ID)) %>%
group_by(!!!syms(intersect(c("facet_x", "bins"), names(.)))) %>%
summarize(n = n(),
x_start = x_start[1],
x_range = diff(range(as.numeric(.$ID)))) %>%
ungroup %>%
mutate(xmin = as.numeric(x_start) + 0.02 * x_range,
xmax = xmin + 0.05 * x_range * n / max(n),
ymin = as.numeric(gsub("\\(|,.*", "", bins)),
ymax = as.numeric(gsub(".*,|]", "", bins)))
g = g +
geom_rect(data = bin_data,
aes(xmin = xmin,
xmax = xmax,
ymin = ymin,
ymax = ymax),
fill = "mediumorchid4",
colour = "mediumorchid4")
}
quick_facet(g, scales = "free_y")
}
globalVariables(c("Actual", "Fitted", "Residual", "ID", "min_af", "max_res",
"x_start", "x_range", "xmin", "xmax", "ymin", "ymax", "bins"))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.