Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Standardize group arguments in functions #105

Merged
merged 21 commits into from
May 12, 2023
Merged

Standardize group arguments in functions #105

Show file tree
Hide file tree
Changes from 14 commits
Commits
Show all changes
21 commits
Select commit Hold shift + click to select a range
86a0f0d
add check_group_argument()
EmilHvitfeldt May 9, 2023
cc4a9c9
add group argument to all cal_estimate_*() functions
EmilHvitfeldt May 9, 2023
78b62cb
only allow a single col in groups
EmilHvitfeldt May 9, 2023
5ba17f5
test groups argument of cal_estimate_*() functions
EmilHvitfeldt May 9, 2023
044125a
use check_group_argument() in cal_plot_*() functions
EmilHvitfeldt May 9, 2023
6d7b5aa
remove tests that no longer pass
EmilHvitfeldt May 9, 2023
5726549
add tests for cal_plot_*() functions
EmilHvitfeldt May 9, 2023
99245e2
update snapshots
May 9, 2023
550fc5a
use .config as group
EmilHvitfeldt May 10, 2023
00ddfe3
correctly detect number of unique .config
EmilHvitfeldt May 10, 2023
adbda5d
use tune_results_args() in all plot functions
EmilHvitfeldt May 10, 2023
d356a1b
add tests for single .config plots
EmilHvitfeldt May 10, 2023
65fe163
remove group argument in tune_results_args()
EmilHvitfeldt May 10, 2023
e7e7b2c
remove group argument from cal_plot_*.tune_results() functions
EmilHvitfeldt May 10, 2023
e992560
more tests for groups/configs
topepo May 10, 2023
9627748
more tests for groups/configs in estimation
topepo May 10, 2023
04d41fc
make new helpers runable
EmilHvitfeldt May 10, 2023
b4053ea
check_group_argument -> get_group_argument
EmilHvitfeldt May 10, 2023
fd6c045
update tests
EmilHvitfeldt May 10, 2023
639d8b1
add testthat_cal_multiclass_count()
EmilHvitfeldt May 11, 2023
16760a5
use testthat_cal_multiclass_count() in tests
EmilHvitfeldt May 11, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 6 additions & 3 deletions R/cal-estimate-beta.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,8 +34,13 @@ cal_estimate_beta.data.frame <- function(.data,
location_params = 1,
estimate = dplyr::starts_with(".pred_"),
parameters = NULL,
...) {
...,
group = NULL) {
stop_null_parameters(parameters)

check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

All *.data.frame() functions calls check_group_argument() and applies dplyr::group_by() with the group. This does nothing if group = NULL

cal_beta_impl(
.data = .data,
truth = {{ truth }},
Expand All @@ -60,7 +65,6 @@ cal_estimate_beta.tune_results <- function(.data,
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = NULL,
event_level = "first",
parameters = parameters,
...
Expand Down Expand Up @@ -227,7 +231,6 @@ cal_beta_impl_single <- function(.data,
beta_model
}


check_cal_groups <- function(group, .data, call = rlang::env_parent()) {
group <- enquo(group)
if (!any(names(.data) == ".config")) {
Expand Down
16 changes: 12 additions & 4 deletions R/cal-estimate-isotonic.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,8 +42,13 @@ cal_estimate_isotonic.data.frame <- function(.data,
truth = NULL,
estimate = dplyr::starts_with(".pred"),
parameters = NULL,
...) {
...,
group = NULL) {
stop_null_parameters(parameters)

check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

cal_isoreg_impl(
.data = .data,
truth = {{ truth }},
Expand All @@ -64,7 +69,6 @@ cal_estimate_isotonic.tune_results <- function(.data,
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = NULL,
event_level = "first",
parameters = parameters,
...
Expand Down Expand Up @@ -117,8 +121,13 @@ cal_estimate_isotonic_boot.data.frame <- function(.data,
estimate = dplyr::starts_with(".pred"),
times = 10,
parameters = NULL,
...) {
...,
group = NULL) {
stop_null_parameters(parameters)

check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

cal_isoreg_impl(
.data = .data,
truth = {{ truth }},
Expand All @@ -141,7 +150,6 @@ cal_estimate_isotonic_boot.tune_results <- function(.data,
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = NULL,
event_level = "first", # or null for regression
parameters = parameters,
...
Expand Down
12 changes: 9 additions & 3 deletions R/cal-estimate-linear.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
#------------------------------- Methods ---------------------------------------
#' Uses a linear regression model to calibrate numeric predictions
#' @inheritParams cal_estimate_logistic
#' @param .data A `data.frame` object, or `tune_results` object, that contains
#' predictions and probability columns.
#' @param truth The column identifier for the observed outcome data (that is
Expand Down Expand Up @@ -67,7 +68,8 @@ cal_estimate_linear <- function(.data,
estimate = dplyr::matches("^.pred$"),
smooth = TRUE,
parameters = NULL,
...) {
...,
group = NULL) {
UseMethod("cal_estimate_linear")
}

Expand All @@ -78,8 +80,13 @@ cal_estimate_linear.data.frame <- function(.data,
estimate = dplyr::matches("^.pred$"),
smooth = TRUE,
parameters = NULL,
...) {
...,
group = NULL) {
stop_null_parameters(parameters)

check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

cal_linear_impl(
.data = .data,
truth = {{ truth }},
Expand All @@ -102,7 +109,6 @@ cal_estimate_linear.tune_results <- function(.data,
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = NULL,
event_level = NA_character_,
parameters = parameters,
...
Expand Down
11 changes: 9 additions & 2 deletions R/cal-estimate-logistic.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,9 @@
#' @param parameters (Optional) An optional tibble of tuning parameter values
#' that can be used to filter the predicted values before processing. Applies
#' only to `tune_results` objects.
#' @param group The column identifier for the grouping variable. This should be
#' one or more unquoted column name. Default to `NULL`. When `group = NULL` no
#' grouping will take place.
#' @param ... Additional arguments passed to the models or routines used to
#' calculate the new probabilities.
#' @param smooth Applies to the logistic models. It switches between logistic
Expand Down Expand Up @@ -54,8 +57,13 @@ cal_estimate_logistic.data.frame <- function(.data,
estimate = dplyr::starts_with(".pred_"),
smooth = TRUE,
parameters = NULL,
...) {
...,
group = NULL) {
stop_null_parameters(parameters)

check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

cal_logistic_impl(
.data = .data,
truth = {{ truth }},
Expand All @@ -78,7 +86,6 @@ cal_estimate_logistic.tune_results <- function(.data,
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = NULL,
event_level = "first",
parameters = parameters,
...
Expand Down
7 changes: 5 additions & 2 deletions R/cal-estimate-multinom.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,9 +60,13 @@ cal_estimate_multinomial.data.frame <-
estimate = dplyr::starts_with(".pred_"),
smooth = TRUE,
parameters = NULL,
...) {
...,
group = NULL) {
stop_null_parameters(parameters)

check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

truth <- enquo(truth)
cal_multinom_impl(
.data = .data,
Expand All @@ -87,7 +91,6 @@ cal_estimate_multinomial.tune_results <-
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = NULL,
event_level = "first",
parameters = parameters,
...
Expand Down
27 changes: 14 additions & 13 deletions R/cal-plot-breaks.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,6 @@
cal_plot_breaks <- function(.data,
truth = NULL,
estimate = dplyr::starts_with(".pred"),
group = NULL,
num_breaks = 10,
conf_level = 0.90,
include_ribbon = TRUE,
Expand All @@ -104,16 +103,16 @@ cal_plot_breaks <- function(.data,
cal_plot_breaks.data.frame <- function(.data,
truth = NULL,
estimate = dplyr::starts_with(".pred"),
group = NULL,
num_breaks = 10,
conf_level = 0.90,
include_ribbon = TRUE,
include_rug = TRUE,
include_points = TRUE,
event_level = c("auto", "first", "second"),
...) {

check_cal_groups({{ group }}, .data)
...,
group = NULL) {
check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

cal_plot_breaks_impl(
.data = .data,
Expand All @@ -134,23 +133,26 @@ cal_plot_breaks.data.frame <- function(.data,
cal_plot_breaks.tune_results <- function(.data,
truth = NULL,
estimate = dplyr::starts_with(".pred"),
group = NULL,
num_breaks = 10,
conf_level = 0.90,
include_ribbon = TRUE,
include_rug = TRUE,
include_points = TRUE,
event_level = c("auto", "first", "second"),
...) {
if (rlang::quo_is_null(enquo(group))) {
group <- expr(.config)
}

cal_plot_breaks_impl(
tune_args <- tune_results_args(
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = {{ group }},
event_level = event_level,
...
)

cal_plot_breaks_impl(
.data = tune_args$predictions,
truth = !!tune_args$truth,
estimate = !!tune_args$estimate,
group = !!tune_args$group,
Comment on lines -146 to +155
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

All *tune.results() are changed to use tune_results_args().

num_breaks = num_breaks,
conf_level = conf_level,
include_ribbon = include_ribbon,
Expand Down Expand Up @@ -293,7 +295,6 @@ cal_plot_breaks_impl <- function(.data,
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = {{ group }},
event_level = event_level,
...
)
Expand Down
27 changes: 14 additions & 13 deletions R/cal-plot-logistic.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,6 @@
cal_plot_logistic <- function(.data,
truth = NULL,
estimate = dplyr::starts_with(".pred"),
group = NULL,
conf_level = 0.90,
smooth = TRUE,
include_rug = TRUE,
Expand All @@ -54,15 +53,15 @@ cal_plot_logistic <- function(.data,
cal_plot_logistic.data.frame <- function(.data,
truth = NULL,
estimate = dplyr::starts_with(".pred"),
group = NULL,
conf_level = 0.90,
smooth = TRUE,
include_rug = TRUE,
include_ribbon = TRUE,
event_level = c("auto", "first", "second"),
...) {

check_cal_groups({{ group }}, .data)
...,
group = NULL) {
check_group_argument({{ group }}, .data)
.data <- dplyr::group_by(.data, dplyr::across({{ group }}))

cal_plot_logistic_impl(
.data = .data,
Expand All @@ -82,22 +81,25 @@ cal_plot_logistic.data.frame <- function(.data,
cal_plot_logistic.tune_results <- function(.data,
truth = NULL,
estimate = dplyr::starts_with(".pred"),
group = NULL,
conf_level = 0.90,
smooth = TRUE,
include_rug = TRUE,
include_ribbon = TRUE,
event_level = c("auto", "first", "second"),
...) {
if (rlang::quo_is_null(enquo(group))) {
group <- expr(.config)
}

cal_plot_logistic_impl(
tune_args <- tune_results_args(
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = {{ group }},
event_level = event_level,
...
)

cal_plot_logistic_impl(
.data = tune_args$predictions,
truth = !!tune_args$truth,
estimate = !!tune_args$estimate,
group = !!tune_args$group,
conf_level = conf_level,
include_ribbon = include_ribbon,
include_rug = include_rug,
Expand Down Expand Up @@ -201,7 +203,6 @@ cal_plot_logistic_impl <- function(.data,
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = {{ group }},
event_level = event_level,
...
)
Expand Down
14 changes: 7 additions & 7 deletions R/cal-plot-regression.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@
cal_plot_regression <- function(.data,
truth = NULL,
estimate = NULL,
group = NULL,
smooth = TRUE,
...) {
UseMethod("cal_plot_regression")
Expand All @@ -37,11 +36,10 @@ cal_plot_regression <- function(.data,
cal_plot_regression_impl <- function(.data,
truth = NULL,
estimate = NULL,
group = NULL,
smooth = TRUE,
...) {

check_cal_groups({{ group }}, .data)
...,
group = NULL) {
check_group_argument({{ group }}, .data)

truth <- enquo(truth)
estimate <- enquo(estimate)
Expand All @@ -68,14 +66,12 @@ cal_plot_regression.data.frame <- cal_plot_regression_impl
cal_plot_regression.tune_results <- function(.data,
truth = NULL,
estimate = NULL,
group = NULL,
smooth = TRUE,
...) {
tune_args <- tune_results_args(
.data = .data,
truth = {{ truth }},
estimate = {{ estimate }},
group = {{ group }},
...
)

Expand All @@ -95,6 +91,10 @@ regression_plot_impl <- function(.data, truth, estimate, group,
estimate <- enquo(estimate)
group <- enquo(group)

if (quo_is_null(group)) {
.data[[".config"]] <- NULL
}
Comment on lines +94 to +96
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If there isn't a group variable, e.i. .config is constant, it is removed from the plotting data.

This makes it easier to test that faceting isn't done with constant .config


gp_vars <- dplyr::group_vars(.data)

if (length(gp_vars)) {
Expand Down
8 changes: 4 additions & 4 deletions R/cal-plot-utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -217,7 +217,6 @@ process_level <- function(x) {
tune_results_args <- function(.data,
truth,
estimate,
group,
event_level,
parameters = NULL,
...) {
Expand All @@ -239,7 +238,6 @@ tune_results_args <- function(.data,

truth <- enquo(truth)
estimate <- enquo(estimate)
group <- enquo(group)

if (quo_is_null(truth)) {
truth_str <- attributes(.data)$outcome
Expand All @@ -250,15 +248,17 @@ tune_results_args <- function(.data,
estimate <- expr(dplyr::starts_with(".pred"))
}

if (quo_is_null(group)) {
if (dplyr::n_distinct(.data[[".predictions"]][[1]][[".config"]]) > 1) {
group <- quo(.config)
} else {
group <- quo(NULL)
}
Comment on lines +251 to 255
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this is the part that detects if there are more than 1 unique .config


list(
truth = quo(!!truth),
estimate = quo(!!estimate),
estimate = estimate,
group = quo(!!group),
group = group,
predictions = predictions
)
}
Expand Down
Loading