Skip to content

Commit 1fb23f7

Browse files
boxuancuiboxuancui
committed
Fixed #181 
1 parent 15cfb3e commit 1fb23f7

7 files changed

Lines changed: 120 additions & 20 deletions

File tree

‎NEWS.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
11
# DataExplorer 0.9.0
2+
## Enhancements
3+
* [#181](https://github.com/boxuancui/DataExplorer/issues/181): Added `by` argument to `plot_histogram` and `plot_density` to break down distributions by a discrete or continuous feature.
4+
25
## Bug Fixes
36
* [#185](https://github.com/boxuancui/DataExplorer/issues/185): Fixed warnings from deprecated `aes_string`.
47

‎R/plot_density.R‎

Lines changed: 35 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
#'
33
#' Plot density estimates for each continuous feature
44
#' @param data input data
5+
#' @param by feature name to be broken down by. If \code{NULL}, no grouping. If a continuous feature, values are grouped into 5 equal ranges; otherwise all categories of a discrete feature are used.
56
#' @param binary_as_factor treat binary as categorical? Default is \code{TRUE}.
67
#' @param geom_density_args a list of other arguments to \link[ggplot2]{geom_density}
78
#' @param scale_x scale of x axis. See \link[ggplot2]{scale_x_continuous} for all options. Default is \code{continuous}.
@@ -21,6 +22,9 @@
2122
#' # Plot iris data
2223
#' plot_density(iris, ncol = 2L)
2324
#'
25+
#' # Plot density by a discrete feature
26+
#' plot_density(iris, by = "Species", ncol = 2L)
27+
#'
2428
#' # Add color to density area
2529
#' plot_density(iris, geom_density_args = list("fill" = "black", "alpha" = 0.6), ncol = 2L)
2630
#'
@@ -30,35 +34,57 @@
3034
#' plot_density(skew, ncol = 2L)
3135
#' plot_density(skew, scale_x = "log10", ncol = 2L)
3236

33-
plot_density <- function(data, binary_as_factor = TRUE,
37+
plot_density <- function(data, by = NULL, binary_as_factor = TRUE,
3438
geom_density_args = list(),
3539
scale_x = "continuous",
3640
title = NULL,
3741
ggtheme = theme_gray(), theme_config = list(),
3842
nrow = 4L, ncol = 4L,
3943
parallel = FALSE) {
4044
## Declare variable first to pass R CMD check
41-
variable <- value <- NULL
45+
variable <- value <- by_f <- NULL
4246
## Check if input is data.table
4347
if (!is.data.table(data)) data <- data.table(data)
4448
## Stop if no continuous features
4549
split_data <- split_columns(data, binary_as_factor = binary_as_factor)
4650
if (split_data$num_continuous == 0) stop("No continuous features found!")
47-
## Get and reshape continuous features
51+
## Get continuous features
4852
continuous <- split_data$continuous
4953
feature_names <- names(continuous)
50-
dt <- suppressWarnings(melt.data.table(continuous, measure.vars = feature_names, variable.factor = FALSE))
54+
if (is.null(by)) {
55+
dt <- suppressWarnings(melt.data.table(continuous, measure.vars = feature_names, variable.factor = FALSE))
56+
dt2 <- dt
57+
} else {
58+
by_feature <- data[[by]]
59+
if (is.null(by_feature)) stop(paste0("Feature \"", by, "\" not found!"))
60+
if (is.numeric(by_feature)) {
61+
dt <- suppressWarnings(melt.data.table(data.table(continuous, "by_f" = cut_interval(by_feature, 5)), id.vars = "by_f", variable.factor = FALSE))
62+
} else {
63+
dt <- suppressWarnings(melt.data.table(data.table(continuous, "by_f" = by_feature), id.vars = "by_f", variable.factor = FALSE))
64+
}
65+
dt2 <- dt[variable != by]
66+
feature_names <- unique(dt2[["variable"]])
67+
}
5168
## Calculate number of pages
52-
layout <- .getPageLayout(nrow, ncol, ncol(continuous))
69+
layout <- .getPageLayout(nrow, ncol, length(feature_names))
5370
## Create ggplot object
5471
plot_list <- .lapply(
5572
parallel = parallel,
5673
X = layout,
5774
FUN = function(x) {
58-
ggplot(dt[variable %in% feature_names[x]], aes(x = value)) +
59-
do.call("geom_density", c("na.rm" = TRUE, geom_density_args)) +
60-
do.call(paste0("scale_x_", scale_x), list()) +
61-
ylab("Density")
75+
if (is.null(by)) {
76+
p <- ggplot(dt2[variable %in% feature_names[x]], aes(x = .data[["value"]])) +
77+
do.call("geom_density", c("na.rm" = TRUE, geom_density_args)) +
78+
do.call(paste0("scale_x_", scale_x), list()) +
79+
ylab("Density")
80+
} else {
81+
p <- ggplot(dt2[variable %in% feature_names[x]], aes(x = .data[["value"]], color = .data[["by_f"]])) +
82+
do.call("geom_density", c("na.rm" = TRUE, geom_density_args)) +
83+
do.call(paste0("scale_x_", scale_x), list()) +
84+
ylab("Density") +
85+
labs(color = by)
86+
}
87+
p
6288
}
6389
)
6490
## Plot objects

‎R/plot_histogram.R‎

Lines changed: 35 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
#'
33
#' Plot histogram for each continuous feature
44
#' @param data input data
5+
#' @param by feature name to be broken down by. If \code{NULL}, no grouping. If a continuous feature, values are grouped into 5 equal ranges; otherwise all categories of a discrete feature are used.
56
#' @param binary_as_factor treat binary as categorical? Default is \code{TRUE}.
67
#' @param geom_histogram_args a list of other arguments to \link[ggplot2]{geom_histogram}
78
#' @param scale_x scale of x axis. See \link[ggplot2]{scale_x_continuous} for all options. Default is \code{continuous}.
@@ -21,41 +22,66 @@
2122
#' # Plot iris data
2223
#' plot_histogram(iris, ncol = 2L)
2324
#'
25+
#' # Plot histogram by a discrete feature
26+
#' plot_histogram(iris, by = "Species", ncol = 2L)
27+
#'
2428
#' # Plot skewed data on log scale
2529
#' set.seed(1)
2630
#' skew <- data.frame(replicate(4L, rbeta(1000, 1, 5000)))
2731
#' plot_histogram(skew, ncol = 2L)
2832
#' plot_histogram(skew, scale_x = "log10", ncol = 2L)
2933

30-
plot_histogram <- function(data, binary_as_factor = TRUE,
34+
plot_histogram <- function(data, by = NULL, binary_as_factor = TRUE,
3135
geom_histogram_args = list("bins" = 30L),
3236
scale_x = "continuous",
3337
title = NULL,
3438
ggtheme = theme_gray(), theme_config = list(),
3539
nrow = 4L, ncol = 4L,
3640
parallel = FALSE) {
3741
## Declare variable first to pass R CMD check
38-
variable <- value <- NULL
42+
variable <- value <- by_f <- NULL
3943
## Check if input is data.table
4044
if (!is.data.table(data)) data <- data.table(data)
4145
## Stop if no continuous features
4246
split_data <- split_columns(data, binary_as_factor = binary_as_factor)
4347
if (split_data$num_continuous == 0) stop("No continuous features found!")
44-
## Get and reshape continuous features
48+
## Get continuous features
4549
continuous <- split_data$continuous
4650
feature_names <- names(continuous)
47-
dt <- suppressWarnings(melt.data.table(continuous, measure.vars = feature_names, variable.factor = FALSE))
51+
if (is.null(by)) {
52+
dt <- suppressWarnings(melt.data.table(continuous, measure.vars = feature_names, variable.factor = FALSE))
53+
dt2 <- dt
54+
} else {
55+
by_feature <- data[[by]]
56+
if (is.null(by_feature)) stop(paste0("Feature \"", by, "\" not found!"))
57+
if (is.numeric(by_feature)) {
58+
dt <- suppressWarnings(melt.data.table(data.table(continuous, "by_f" = cut_interval(by_feature, 5)), id.vars = "by_f", variable.factor = FALSE))
59+
} else {
60+
dt <- suppressWarnings(melt.data.table(data.table(continuous, "by_f" = by_feature), id.vars = "by_f", variable.factor = FALSE))
61+
}
62+
dt2 <- dt[variable != by]
63+
feature_names <- unique(dt2[["variable"]])
64+
}
4865
## Calculate number of pages
49-
layout <- .getPageLayout(nrow, ncol, ncol(continuous))
66+
layout <- .getPageLayout(nrow, ncol, length(feature_names))
5067
## Create ggplot object
5168
plot_list <- .lapply(
5269
parallel = parallel,
5370
X = layout,
5471
FUN = function(x) {
55-
ggplot(dt[variable %in% feature_names[x]], aes(x = value)) +
56-
do.call("geom_histogram", c("na.rm" = TRUE, geom_histogram_args)) +
57-
do.call(paste0("scale_x_", scale_x), list()) +
58-
ylab("Frequency")
72+
if (is.null(by)) {
73+
p <- ggplot(dt2[variable %in% feature_names[x]], aes(x = .data[["value"]])) +
74+
do.call("geom_histogram", c("na.rm" = TRUE, geom_histogram_args)) +
75+
do.call(paste0("scale_x_", scale_x), list()) +
76+
ylab("Frequency")
77+
} else {
78+
p <- ggplot(dt2[variable %in% feature_names[x]], aes(x = .data[["value"]], fill = .data[["by_f"]])) +
79+
do.call("geom_histogram", c("na.rm" = TRUE, "position" = "identity", "alpha" = 0.5, geom_histogram_args)) +
80+
do.call(paste0("scale_x_", scale_x), list()) +
81+
ylab("Frequency") +
82+
labs(fill = by)
83+
}
84+
p
5985
}
6086
)
6187
## Plot objects

‎inst/rmd_template/report.rmd‎

Lines changed: 28 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -104,17 +104,43 @@ if (any(c("plot_bar", "plot_histogram", "plot_density", "plot_qq") %in% names(re
104104
```{r plot_histogram}
105105
if ("plot_histogram" %in% names(report_config)) {
106106
if (intro[["continuous_columns"]] > 0) {
107+
hist_option <- report_config[["plot_histogram"]][setdiff(names(report_config[["plot_histogram"]]), "by")]
107108
cat("#### Histogram", fill = TRUE)
108-
do_call("plot_histogram")
109+
do.call(plot_histogram, c(list("data" = data), hist_option))
110+
}
111+
}
112+
```
113+
114+
```{r plot_response_histogram}
115+
if ("plot_histogram" %in% names(report_config)) {
116+
if (intro[["continuous_columns"]] > 0) {
117+
if (!is.null(response)) {
118+
hist_option <- report_config[["plot_histogram"]][setdiff(names(report_config[["plot_histogram"]]), "by")]
119+
cat(paste0("#### Histogram (by ", response, ")"), fill = TRUE)
120+
do.call(plot_histogram, c(list("data" = data, "by" = response), hist_option))
121+
}
109122
}
110123
}
111124
```
112125

113126
```{r plot_density}
114127
if ("plot_density" %in% names(report_config)) {
115128
if (intro[["continuous_columns"]] > 0) {
129+
density_option <- report_config[["plot_density"]][setdiff(names(report_config[["plot_density"]]), "by")]
116130
cat("#### Density Estimates", fill = TRUE)
117-
do_call("plot_density")
131+
do.call(plot_density, c(list("data" = data), density_option))
132+
}
133+
}
134+
```
135+
136+
```{r plot_response_density}
137+
if ("plot_density" %in% names(report_config)) {
138+
if (intro[["continuous_columns"]] > 0) {
139+
if (!is.null(response)) {
140+
density_option <- report_config[["plot_density"]][setdiff(names(report_config[["plot_density"]]), "by")]
141+
cat(paste0("#### Density Estimates (by ", response, ")"), fill = TRUE)
142+
do.call(plot_density, c(list("data" = data, "by" = response), density_option))
143+
}
118144
}
119145
}
120146
```

‎man/plot_density.Rd‎

Lines changed: 6 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/plot_histogram.Rd‎

Lines changed: 6 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-plot-histogram-density.R‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,3 +35,10 @@ test_that("test binary categories and error messages", {
3535
expect_silent(plot_density(sample.int(n = 2L, size = 26L, replace = TRUE), binary_as_factor = FALSE))
3636
expect_error(plot_density(sample.int(n = 2L, size = 26L, replace = TRUE)))
3737
})
38+
39+
test_that("test by argument for plot_histogram and plot_density", {
40+
expect_silent(plot_histogram(iris, by = "Species", ncol = 2L))
41+
expect_silent(plot_density(iris, by = "Species", ncol = 2L))
42+
expect_error(plot_histogram(iris, by = "Nonexistent"))
43+
expect_error(plot_density(iris, by = "Nonexistent"))
44+
})

0 commit comments

Comments
 (0)