1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105 | #' Plot the distribution of the independent variable per class from a cutpointr object
#'
#' Given a \code{cutpointr} object this function plots the distribution(s) of the
#' independent variable(s) and the respective cutpoints per class.
#' @param x A cutpointr object.
#' @param display_cutpoint (logical) Whether or not to display the optimal
#' cutpoint as a vertical line.
#' @param ... Additional arguments (unused).
#' @examples
#' opt_cut <- cutpointr(suicide, dsi, suicide)
#' plot_x(opt_cut)
#'
#' ## With subgroup
#' opt_cut_2groups <- cutpointr(suicide, dsi, suicide, gender)
#' plot_x(opt_cut_2groups)
#' @family cutpointr plotting functions
#' @export
plot_x <- function(x, display_cutpoint = TRUE, ...) {
args <- list(...)
predictor <- as.character(x$predictor[1])
outcome <- as.character(x$outcome[1])
if (!(has_column(x, "subgroup"))) {
res_unnested <- x %>%
dplyr::select(.data$data) %>%
tidyr::unnest(.data$data)
transparency <- 1
if (all(na_inf_omit(unlist(dplyr::select(res_unnested, predictor))) %% 1 == 0) |
only_one_unique(
na_inf_omit(unlist(dplyr::select(res_unnested, predictor)))
)) {
all_integer = TRUE
dist_plot <- ggplot2::geom_bar(alpha = transparency, position = "identity")
} else {
all_integer = FALSE
dist_plot <- ggplot2::geom_density(alpha = transparency)
}
dist <- ggplot2::ggplot(res_unnested,
ggplot2::aes(x = !!rlang::ensym(predictor))) +
dist_plot +
# facet by class because always 2
ggplot2::facet_wrap(outcome, scales = "free_y") +
ggplot2::ggtitle("Independent variable",
"optimal cutpoint and distribution by class") +
ggplot2::xlab("value")
if (display_cutpoint) {
cutpoint_dat <- x %>%
dplyr::select(.data$optimal_cutpoint)
if (is.list(x$optimal_cutpoint)) {
cutpoint_dat <- tidyr::unnest(cols = optimal_cutpoint,
data = cutpoint_dat)
}
dist <- dist +
ggplot2::geom_vline(data = cutpoint_dat,
mapping = ggplot2::aes(xintercept = optimal_cutpoint),
show.legend = FALSE)
}
} else if (has_column(x, "subgroup")) {
res_unnested <- x %>%
dplyr::select("data", "subgroup") %>%
tidyr::unnest(.data$data)
res_unnested <- dplyr::full_join(res_unnested,
tibble::as_tibble(x[, c("optimal_cutpoint", "subgroup")]),
by = "subgroup")
transparency <- 0.6
if (all(na_inf_omit(unlist(dplyr::select(res_unnested, predictor))) %% 1 == 0) |
only_one_unique(
na_inf_omit(unlist(dplyr::select(res_unnested, predictor)))
)) {
all_integer = TRUE
dist_plot <- ggplot2::geom_bar(alpha = transparency, position = "identity")
} else {
all_integer = FALSE
dist_plot <- ggplot2::geom_density(alpha = transparency)
}
dist <- ggplot2::ggplot(res_unnested,
ggplot2::aes(x = !!rlang::ensym(predictor),
fill = subgroup,
color = subgroup)) +
dist_plot +
# facet by class because always 2
ggplot2::facet_wrap(outcome, scales = "free_y") +
ggplot2::ggtitle("Independent variable",
"optimal cutpoint and distribution by class") +
ggplot2::xlab("value") +
ggplot2::labs(color = "Subgroup", fill = "Subgroup")
if (display_cutpoint) {
cutpoint_dat <- x %>%
dplyr::select(.data$subgroup, .data$optimal_cutpoint)
if (is.list(x$optimal_cutpoint)) {
cutpoint_dat <- tidyr::unnest(cols = optimal_cutpoint,
data = cutpoint_dat)
}
dist <- dist +
ggplot2::geom_vline(data = cutpoint_dat,
mapping = ggplot2::aes(xintercept = optimal_cutpoint,
color = subgroup),
show.legend = FALSE)
}
}
if (!all_integer) dist <- dist + ggplot2::geom_rug(alpha = 0.5)
return(dist)
}
|