Skip to content

Commit 7af9fb5

Browse files
hfrickhfrick
authored
Merge pull request #77 from tidymodels:use-air
Format with air
2 parents c3e4f71 + f3dd070 commit 7af9fb5

25 files changed

Lines changed: 318 additions & 262 deletions

‎.Rbuildignore‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,3 +10,5 @@
1010
^docs$
1111
^pkgdown$
1212
^CRAN-SUBMISSION$
13+
^[\.]?air\.toml$
14+
^\.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: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
{
2+
"[r]": {
3+
"editor.formatOnSave": true,
4+
"editor.defaultFormatter": "Posit.air-vscode"
5+
}
6+
}

‎R/gee.R‎

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -13,14 +13,13 @@
1313
# gee_formula() parses this formula, pulls out the id variable and fixes
1414
# the formula (= no id term). gee_fit() uses this to fit the model.
1515

16-
1716
#' @description Function to add single clustering variable for GEE
1817
#' @noRd
1918
gee_formula <- function(f) {
2019
cl <- match.call()
2120
trms <- terms(f, specials = "id_var")
2221
form_terms <- attr(trms, "variables")
23-
id_ind <- attr(trms,"specials")$id_var + 1
22+
id_ind <- attr(trms, "specials")$id_var + 1
2423
# check length
2524
if (length(id_ind) != 1) {
2625
cli::cli_abort(
@@ -35,7 +34,6 @@ gee_formula <- function(f) {
3534
id_expr <- form_terms[[id_ind]]
3635
id_var <- all.vars(id_expr)
3736

38-
3937
# repair formula: get predictors and remake
4038
rhs <- form_terms[-c(1:2, id_ind)]
4139
if (length(rhs) == 0) {
@@ -78,9 +76,15 @@ gee_fit <- function(formula, data, family = gaussian, ...) {
7876
f <- gee_formula(formula)
7977
id_sym <- f$id
8078
id_sym <- rlang::expr(data[[!!id_sym]])
81-
cl <- rlang::call2("gee", .ns = "gee", as.formula(f$formula), data = rlang::expr(data),
82-
id = data[[f$id]], family = rlang::expr(family),
83-
...)
79+
cl <- rlang::call2(
80+
"gee",
81+
.ns = "gee",
82+
as.formula(f$formula),
83+
data = rlang::expr(data),
84+
id = data[[f$id]],
85+
family = rlang::expr(family),
86+
...
87+
)
8488

8589
# While undocumented in `gee()`, binomial data should be binary
8690
# (unlike `glm()`).

‎R/linear_reg-data.R‎

Lines changed: 37 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -6,16 +6,19 @@
66
# nocov start
77

88
make_stan_linear_reg <- function() {
9-
109
parsnip::set_model_engine("linear_reg", "regression", "stan_glmer")
11-
parsnip::set_dependency("linear_reg",
12-
eng = "stan_glmer",
13-
pkg = "rstanarm",
14-
mode = "regression")
15-
parsnip::set_dependency("linear_reg",
16-
eng = "stan_glmer",
17-
pkg = "multilevelmod",
18-
mode = "regression")
10+
parsnip::set_dependency(
11+
"linear_reg",
12+
eng = "stan_glmer",
13+
pkg = "rstanarm",
14+
mode = "regression"
15+
)
16+
parsnip::set_dependency(
17+
"linear_reg",
18+
eng = "stan_glmer",
19+
pkg = "multilevelmod",
20+
mode = "regression"
21+
)
1922

2023
parsnip::set_encoding(
2124
model = "linear_reg",
@@ -48,14 +51,14 @@ make_stan_linear_reg <- function() {
4851
type = "numeric",
4952
value = list(
5053
pre = NULL,
51-
post = function(results, object) {
54+
post = function(results, object) {
5255
tibble::tibble(.pred = apply(results, 2, mean, na.rm = TRUE))
5356
},
5457
func = c(pkg = "rstanarm", fun = "posterior_predict"),
5558
args = list(
5659
object = rlang::expr(object$fit),
5760
newdata = rlang::expr(new_data),
58-
seed = rlang::expr(sample.int(10 ^ 5, 1))
61+
seed = rlang::expr(sample.int(10^5, 1))
5962
)
6063
)
6164
)
@@ -70,29 +73,26 @@ make_stan_linear_reg <- function() {
7073
post = function(results, object) {
7174
res <-
7275
tibble::tibble(
73-
.pred_lower =
74-
parsnip::convert_stan_interval(
75-
results,
76-
level = object$spec$method$pred$pred_int$extras$level
77-
),
78-
.pred_upper =
79-
parsnip::convert_stan_interval(
80-
results,
81-
level = object$spec$method$pred$pred_int$extras$level,
82-
lower = FALSE
83-
),
76+
.pred_lower = parsnip::convert_stan_interval(
77+
results,
78+
level = object$spec$method$pred$pred_int$extras$level
79+
),
80+
.pred_upper = parsnip::convert_stan_interval(
81+
results,
82+
level = object$spec$method$pred$pred_int$extras$level,
83+
lower = FALSE
84+
),
8485
)
8586
if (object$spec$method$pred$pred_int$extras$std_error)
8687
res$.std_error <- apply(results, 2, sd, na.rm = TRUE)
8788
res
8889
},
8990
func = c(pkg = "rstanarm", fun = "posterior_predict"),
90-
args =
91-
list(
92-
object = rlang::expr(object$fit),
93-
newdata = rlang::expr(new_data),
94-
seed = rlang::expr(sample.int(10^5, 1))
95-
)
91+
args = list(
92+
object = rlang::expr(object$fit),
93+
newdata = rlang::expr(new_data),
94+
seed = rlang::expr(sample.int(10^5, 1))
95+
)
9696
)
9797
)
9898

@@ -105,16 +105,17 @@ make_stan_linear_reg <- function() {
105105
pre = NULL,
106106
post = NULL,
107107
func = c(fun = "posterior_predict"),
108-
args = list(object = rlang::expr(object$fit), newdata = rlang::expr(new_data))
108+
args = list(
109+
object = rlang::expr(object$fit),
110+
newdata = rlang::expr(new_data)
111+
)
109112
)
110113
)
111-
112114
}
113115

114116
# ------------------------------------------------------------------------------
115117

116118
make_lme4_linear_reg <- function() {
117-
118119
parsnip::set_model_engine("linear_reg", "regression", "lmer")
119120
parsnip::set_dependency("linear_reg", "lmer", "lme4", "regression")
120121
parsnip::set_dependency("linear_reg", "lmer", "multilevelmod", "regression")
@@ -150,7 +151,7 @@ make_lme4_linear_reg <- function() {
150151
type = "numeric",
151152
value = list(
152153
pre = reformat_lme_pred_data,
153-
post = NULL,
154+
post = NULL,
154155
func = c(fun = "predict"),
155156
args = list(
156157
object = rlang::expr(object$fit),
@@ -178,13 +179,11 @@ make_lme4_linear_reg <- function() {
178179
)
179180
)
180181
)
181-
182182
}
183183

184184
# ------------------------------------------------------------------------------
185185

186186
make_glmer_linear_reg <- function() {
187-
188187
parsnip::set_model_engine("linear_reg", "regression", "glmer")
189188
parsnip::set_dependency("linear_reg", "glmer", "lme4", "regression")
190189
parsnip::set_dependency("linear_reg", "glmer", "multilevelmod", "regression")
@@ -220,7 +219,7 @@ make_glmer_linear_reg <- function() {
220219
type = "numeric",
221220
value = list(
222221
pre = reformat_lme_pred_data,
223-
post = NULL,
222+
post = NULL,
224223
func = c(fun = "predict"),
225224
args = list(
226225
object = rlang::expr(object$fit),
@@ -248,13 +247,11 @@ make_glmer_linear_reg <- function() {
248247
)
249248
)
250249
)
251-
252250
}
253251

254252
# ------------------------------------------------------------------------------
255253

256254
make_gee_linear_reg <- function() {
257-
258255
parsnip::set_model_engine("linear_reg", "regression", "gee")
259256
parsnip::set_dependency("linear_reg", "gee", "gee", "regression")
260257
parsnip::set_dependency("linear_reg", "gee", "multilevelmod", "regression")
@@ -290,7 +287,7 @@ make_gee_linear_reg <- function() {
290287
type = "numeric",
291288
value = list(
292289
pre = NULL,
293-
post = NULL,
290+
post = NULL,
294291
func = c(fun = "predict"),
295292
args = list(
296293
object = rlang::expr(object$fit),
@@ -315,13 +312,11 @@ make_gee_linear_reg <- function() {
315312
)
316313
)
317314
)
318-
319315
}
320316

321317
# ------------------------------------------------------------------------------
322318

323319
make_lme_linear_reg <- function() {
324-
325320
parsnip::set_model_engine("linear_reg", "regression", "lme")
326321
parsnip::set_dependency("linear_reg", "lme", "nlme", "regression")
327322
parsnip::set_dependency("linear_reg", "lme", "multilevelmod", "regression")
@@ -358,7 +353,7 @@ make_lme_linear_reg <- function() {
358353
type = "numeric",
359354
value = list(
360355
pre = NULL,
361-
post = function(result, object) as.numeric(result),
356+
post = function(result, object) as.numeric(result),
362357
func = c(fun = "predict"),
363358
args = list(
364359
object = rlang::expr(object$fit),
@@ -383,13 +378,11 @@ make_lme_linear_reg <- function() {
383378
)
384379
)
385380
)
386-
387381
}
388382

389383
# ------------------------------------------------------------------------------
390384

391385
make_gls_linear_reg <- function() {
392-
393386
parsnip::set_model_engine("linear_reg", "regression", "gls")
394387
parsnip::set_dependency("linear_reg", "gls", "nlme", "regression")
395388
parsnip::set_dependency("linear_reg", "gls", "multilevelmod", "regression")
@@ -426,7 +419,7 @@ make_gls_linear_reg <- function() {
426419
type = "numeric",
427420
value = list(
428421
pre = NULL,
429-
post = function(result, object) as.numeric(result),
422+
post = function(result, object) as.numeric(result),
430423
func = c(fun = "predict"),
431424
args = list(
432425
object = rlang::expr(object$fit),
@@ -450,8 +443,6 @@ make_gls_linear_reg <- function() {
450443
)
451444
)
452445
)
453-
454446
}
455447

456-
457448
# nocov end

0 commit comments

Comments
 (0)