Skip to content

Commit 571f838

Browse files
EmilHvitfeldtEmilHvitfeldt
authored
Air (#193)
1 parent 278b062 commit 571f838

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

55 files changed

+1802
-1021
lines changed

‎.Rbuildignore‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,3 +12,5 @@
1212
^pkgdown$
1313
^CRAN-SUBMISSION$
1414
^man-roxygen$
15+
^[.]?air[.]toml$
16+
^\.vscode$

‎.vscode/extensions.json‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
{
2+
"recommendations": [
3+
"Posit.air-vscode"
4+
]
5+
}

‎.vscode/settings.json‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
{
2+
"[r]": {
3+
"editor.formatOnSave": true,
4+
"editor.defaultFormatter": "Posit.air-vscode"
5+
},
6+
"[quarto]": {
7+
"editor.formatOnSave": true,
8+
"editor.defaultFormatter": "quarto.quarto"
9+
}
10+
}

‎R/bound_prediction.R‎

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -15,13 +15,19 @@
1515
#'
1616
#' bound_prediction(solubility_test, lower_limit = -1)
1717
#' @export
18-
bound_prediction <- function(x, lower_limit = -Inf, upper_limit = Inf,
19-
call = rlang::current_env()) {
18+
bound_prediction <- function(
19+
x,
20+
lower_limit = -Inf,
21+
upper_limit = Inf,
22+
call = rlang::current_env()
23+
) {
2024
check_data_frame(x, call = call)
2125

2226
if (!any(names(x) == ".pred")) {
23-
cli::cli_abort("The argument {.arg x} should have a column named {.code .pred}.",
24-
call = call)
27+
cli::cli_abort(
28+
"The argument {.arg x} should have a column named {.code .pred}.",
29+
call = call
30+
)
2531
}
2632
if (!is.numeric(x$.pred)) {
2733
cli::cli_abort("Column {.code .pred} should be numeric.", call = call)
@@ -39,4 +45,3 @@ bound_prediction <- function(x, lower_limit = -Inf, upper_limit = Inf,
3945
}
4046
x
4147
}
42-

‎R/cal-apply-binary.R‎

Lines changed: 12 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -5,21 +5,25 @@ cal_apply_binary <- function(object, .data, pred_class) {
55
}
66

77
#' @export
8-
cal_apply_binary.cal_estimate_logistic <- function(object,
9-
.data,
10-
pred_class = NULL,
11-
...) {
8+
cal_apply_binary.cal_estimate_logistic <- function(
9+
object,
10+
.data,
11+
pred_class = NULL,
12+
...
13+
) {
1214
apply_model_predict(
1315
object = object,
1416
.data = .data
1517
)
1618
}
1719

1820
#' @export
19-
cal_apply_binary.cal_estimate_logistic_spline <- function(object,
20-
.data,
21-
pred_class = NULL,
22-
...) {
21+
cal_apply_binary.cal_estimate_logistic_spline <- function(
22+
object,
23+
.data,
24+
pred_class = NULL,
25+
...
26+
) {
2327
apply_model_predict(
2428
object = object,
2529
.data = .data

‎R/cal-apply-impl.R‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -107,7 +107,10 @@ apply_beta_column <- function(.data, est_filter, estimates) {
107107
}
108108

109109
ret <-
110-
purrr::imap(estimates, ~ apply_beta_single(model = .x, df = df, est_name = .y))
110+
purrr::imap(
111+
estimates,
112+
~ apply_beta_single(model = .x, df = df, est_name = .y)
113+
)
111114

112115
names_ret <- names(ret)
113116
for (i in seq_along(names_ret)) {

‎R/cal-apply.R‎

Lines changed: 41 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -31,22 +31,26 @@
3131
#'
3232
#' cal_apply(segment_logistic, w_calibration)
3333
#' @export
34-
cal_apply <- function(.data,
35-
object,
36-
pred_class = NULL,
37-
parameters = NULL,
38-
...) {
34+
cal_apply <- function(
35+
.data,
36+
object,
37+
pred_class = NULL,
38+
parameters = NULL,
39+
...
40+
) {
3941
rlang::check_dots_empty()
4042
UseMethod("cal_apply")
4143
}
4244

4345
#' @export
4446
#' @rdname cal_apply
45-
cal_apply.data.frame <- function(.data,
46-
object,
47-
pred_class = NULL,
48-
parameters = NULL,
49-
...) {
47+
cal_apply.data.frame <- function(
48+
.data,
49+
object,
50+
pred_class = NULL,
51+
parameters = NULL,
52+
...
53+
) {
5054
cal_pkg_check(required_pkgs(object))
5155

5256
stop_null_parameters(parameters)
@@ -60,11 +64,13 @@ cal_apply.data.frame <- function(.data,
6064

6165
#' @export
6266
#' @rdname cal_apply
63-
cal_apply.tune_results <- function(.data,
64-
object,
65-
pred_class = NULL,
66-
parameters = NULL,
67-
...) {
67+
cal_apply.tune_results <- function(
68+
.data,
69+
object,
70+
pred_class = NULL,
71+
parameters = NULL,
72+
...
73+
) {
6874
cal_pkg_check(required_pkgs(object))
6975

7076
if (!(".predictions" %in% colnames(.data))) {
@@ -99,11 +105,13 @@ cal_apply.tune_results <- function(.data,
99105

100106
#' @export
101107
#' @rdname cal_apply
102-
cal_apply.cal_object <- function(.data,
103-
object,
104-
pred_class = NULL,
105-
parameters = NULL,
106-
...) {
108+
cal_apply.cal_object <- function(
109+
.data,
110+
object,
111+
pred_class = NULL,
112+
parameters = NULL,
113+
...
114+
) {
107115
if ("data.frame" %in% class(object)) {
108116
cli::cli_abort(
109117
c(
@@ -140,10 +148,12 @@ cal_adjust.cal_estimate_isotonic_boot <- function(object, .data, pred_class) {
140148
}
141149

142150
#' @export
143-
cal_adjust.cal_estimate_beta <- function(object,
144-
.data,
145-
pred_class = NULL,
146-
...) {
151+
cal_adjust.cal_estimate_beta <- function(
152+
object,
153+
.data,
154+
pred_class = NULL,
155+
...
156+
) {
147157
apply_beta_impl(
148158
object = object,
149159
.data = .data
@@ -182,11 +192,13 @@ cal_adjust.cal_estimate_none <- function(object, .data, pred_class) {
182192
.data
183193
}
184194

185-
cal_adjust_update <- function(.data,
186-
object,
187-
pred_class = NULL,
188-
parameters = NULL,
189-
...) {
195+
cal_adjust_update <- function(
196+
.data,
197+
object,
198+
pred_class = NULL,
199+
parameters = NULL,
200+
...
201+
) {
190202
if (object$type != "regression") {
191203
pred_class <- enquo(pred_class)
192204
} else {

‎R/cal-estimate-beta.R‎

Lines changed: 44 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -22,28 +22,28 @@
2222
#' }
2323
#' @export
2424
cal_estimate_beta <- function(
25-
.data,
26-
truth = NULL,
27-
shape_params = 2,
28-
location_params = 1,
29-
estimate = dplyr::starts_with(".pred_"),
30-
parameters = NULL,
31-
...
25+
.data,
26+
truth = NULL,
27+
shape_params = 2,
28+
location_params = 1,
29+
estimate = dplyr::starts_with(".pred_"),
30+
parameters = NULL,
31+
...
3232
) {
3333
UseMethod("cal_estimate_beta")
3434
}
3535

3636
#' @export
3737
#' @rdname cal_estimate_beta
3838
cal_estimate_beta.data.frame <- function(
39-
.data,
40-
truth = NULL,
41-
shape_params = 2,
42-
location_params = 1,
43-
estimate = dplyr::starts_with(".pred_"),
44-
parameters = NULL,
45-
...,
46-
.by = NULL
39+
.data,
40+
truth = NULL,
41+
shape_params = 2,
42+
location_params = 1,
43+
estimate = dplyr::starts_with(".pred_"),
44+
parameters = NULL,
45+
...,
46+
.by = NULL
4747
) {
4848
stop_null_parameters(parameters)
4949

@@ -70,13 +70,13 @@ cal_estimate_beta.data.frame <- function(
7070
#' @export
7171
#' @rdname cal_estimate_beta
7272
cal_estimate_beta.tune_results <- function(
73-
.data,
74-
truth = NULL,
75-
shape_params = 2,
76-
location_params = 1,
77-
estimate = dplyr::starts_with(".pred_"),
78-
parameters = NULL,
79-
...
73+
.data,
74+
truth = NULL,
75+
shape_params = 2,
76+
location_params = 1,
77+
estimate = dplyr::starts_with(".pred_"),
78+
parameters = NULL,
79+
...
8080
) {
8181
info <- get_tune_data(.data, parameters)
8282

@@ -96,13 +96,13 @@ cal_estimate_beta.tune_results <- function(
9696
#' @export
9797
#' @rdname cal_estimate_beta
9898
cal_estimate_beta.grouped_df <- function(
99-
.data,
100-
truth = NULL,
101-
shape_params = 2,
102-
location_params = 1,
103-
estimate = NULL,
104-
parameters = NULL,
105-
...
99+
.data,
100+
truth = NULL,
101+
shape_params = 2,
102+
location_params = 1,
103+
estimate = NULL,
104+
parameters = NULL,
105+
...
106106
) {
107107
abort_if_grouped_df()
108108
}
@@ -137,12 +137,12 @@ beta_fit_over_groups <- function(info, shape_params, location_params, ...) {
137137

138138

139139
fit_all_beta_models <- function(
140-
.data,
141-
truth = NULL,
142-
shape = 2,
143-
location = 1,
144-
estimate = NULL,
145-
...
140+
.data,
141+
truth = NULL,
142+
shape = 2,
143+
location = 1,
144+
estimate = NULL,
145+
...
146146
) {
147147
lvls <- levels(.data[[truth]])
148148
num_lvls <- length(lvls)
@@ -176,12 +176,12 @@ fit_all_beta_models <- function(
176176

177177

178178
fit_beta_model <- function(
179-
.data,
180-
truth = NULL,
181-
shape = 2,
182-
location = 1,
183-
estimate = NULL,
184-
...
179+
.data,
180+
truth = NULL,
181+
shape = 2,
182+
location = 1,
183+
estimate = NULL,
184+
...
185185
) {
186186
outcome_data <- .data[[truth]]
187187
lvls <- levels(outcome_data)
@@ -255,6 +255,8 @@ check_cal_groups <- function(group, .data, call = rlang::env_parent()) {
255255

256256
#' @export
257257
print.betacal <- function(x, ...) {
258-
cli::cli_inform("Beta calibration ({x$parameters}) using {x$model$df.null} samples")
258+
cli::cli_inform(
259+
"Beta calibration ({x$parameters}) using {x$model$df.null} samples"
260+
)
259261
invisible(x)
260262
}

0 commit comments

Comments
 (0)