Skip to content

Commit d270b12

Browse files
topepotopepo
committed
remaning rlng errors to cli errors
1 parent 297320e commit d270b12

File tree

8 files changed

+54
-83
lines changed

8 files changed

+54
-83
lines changed

‎R/descriptors.R‎

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -245,9 +245,9 @@ get_descr_spark <- function(formula, data) {
245245
.obs <- function() obs
246246
.lvls <- function() y_vals
247247
.facts <- function() factor_pred
248-
.x <- function() abort("Descriptor .x() not defined for Spark.")
249-
.y <- function() abort("Descriptor .y() not defined for Spark.")
250-
.dat <- function() abort("Descriptor .dat() not defined for Spark.")
248+
.x <- function() cli::cli_abort("Descriptor {.fn .x} not defined for Spark.")
249+
.y <- function() cli::cli_abort("Descriptor {.fn .y} not defined for Spark.")
250+
.dat <- function() cli::cli_abort("Descriptor {.fn .dat} not defined for Spark.")
251251

252252
# still need .x(), .y(), .dat() ?
253253

@@ -409,13 +409,13 @@ scoped_descrs <- function(descrs, frame = caller_env()) {
409409
# with their actual implementations
410410
descr_env <- rlang::new_environment(
411411
data = list(
412-
.cols = function() abort("Descriptor context not set"),
413-
.preds = function() abort("Descriptor context not set"),
414-
.obs = function() abort("Descriptor context not set"),
415-
.lvls = function() abort("Descriptor context not set"),
416-
.facts = function() abort("Descriptor context not set"),
417-
.x = function() abort("Descriptor context not set"),
418-
.y = function() abort("Descriptor context not set"),
419-
.dat = function() abort("Descriptor context not set")
412+
.cols = function() cli::cli_abort("Descriptor context not set"),
413+
.preds = function() cli::cli_abort("Descriptor context not set"),
414+
.obs = function() cli::cli_abort("Descriptor context not set"),
415+
.lvls = function() cli::cli_abort("Descriptor context not set"),
416+
.facts = function() cli::cli_abort("Descriptor context not set"),
417+
.x = function() cli::cli_abort("Descriptor context not set"),
418+
.y = function() cli::cli_abort("Descriptor context not set"),
419+
.dat = function() cli::cli_abort("Descriptor context not set")
420420
)
421421
)

‎R/misc.R‎

Lines changed: 12 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -369,22 +369,20 @@ check_outcome <- function(y, spec) {
369369
if (spec$mode == "regression") {
370370
outcome_is_numeric <- if (is.atomic(y)) {is.numeric(y)} else {all(map_lgl(y, is.numeric))}
371371
if (!outcome_is_numeric) {
372-
cls <- class(y)[[1]]
373-
abort(paste0(
374-
"For a regression model, the outcome should be `numeric`, ",
375-
"not a `", cls, "`."
376-
))
372+
cli::cli_abort(
373+
"For a regression model, the outcome should be {.cls numeric}, not
374+
{.cls {class(y)[[1]]}}."
375+
)
377376
}
378377
}
379378

380379
if (spec$mode == "classification") {
381380
outcome_is_factor <- if (is.atomic(y)) {is.factor(y)} else {all(map_lgl(y, is.factor))}
382381
if (!outcome_is_factor) {
383-
cls <- class(y)[[1]]
384-
abort(paste0(
385-
"For a classification model, the outcome should be a `factor`, ",
386-
"not a `", cls, "`."
387-
))
382+
cli::cli_abort(
383+
"For a classification model, the outcome should be {.cls factor}, not
384+
{.cls {class(y)[[1]]}}."
385+
)
388386
}
389387

390388
if (inherits(spec, "logistic_reg") && is.atomic(y) && length(levels(y)) > 2) {
@@ -402,11 +400,10 @@ check_outcome <- function(y, spec) {
402400
if (spec$mode == "censored regression") {
403401
outcome_is_surv <- inherits(y, "Surv")
404402
if (!outcome_is_surv) {
405-
cls <- class(y)[[1]]
406-
abort(paste0(
407-
"For a censored regression model, the outcome should be a `Surv` object, ",
408-
"not a `", cls, "`."
409-
))
403+
cli::cli_abort(
404+
"For a censored regression model, the outcome should be {.cls Surv}, not
405+
{.cls {class(y)[[1]]}}."
406+
)
410407
}
411408
}
412409

‎tests/testthat/_snaps/linear_reg.md‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@
4646
res <- fit_xy(hpc_basic, x = hpc[, num_pred], y = hpc$class, control = ctrl)
4747
Condition
4848
Error in `check_outcome()`:
49-
! For a regression model, the outcome should be `numeric`, not a `factor`.
49+
! For a regression model, the outcome should be <numeric>, not <factor>.
5050

5151
---
5252

@@ -55,47 +55,47 @@
5555
control = ctrl)
5656
Condition
5757
Error in `check_outcome()`:
58-
! For a regression model, the outcome should be `numeric`, not a `character`.
58+
! For a regression model, the outcome should be <numeric>, not <character>.
5959

6060
---
6161

6262
Code
6363
res <- fit(hpc_basic, hpc_bad_form, data = hpc, control = ctrl)
6464
Condition
6565
Error in `check_outcome()`:
66-
! For a regression model, the outcome should be `numeric`, not a `factor`.
66+
! For a regression model, the outcome should be <numeric>, not <factor>.
6767

6868
---
6969

7070
Code
7171
lm_form_catch <- fit(hpc_basic, hpc_bad_form, data = hpc, control = caught_ctrl)
7272
Condition
7373
Error in `check_outcome()`:
74-
! For a regression model, the outcome should be `numeric`, not a `factor`.
74+
! For a regression model, the outcome should be <numeric>, not <factor>.
7575

7676
# glm execution
7777

7878
Code
7979
res <- fit_xy(hpc_glm, x = hpc[, num_pred], y = hpc$class, control = ctrl)
8080
Condition
8181
Error in `check_outcome()`:
82-
! For a regression model, the outcome should be `numeric`, not a `factor`.
82+
! For a regression model, the outcome should be <numeric>, not <factor>.
8383

8484
---
8585

8686
Code
8787
res <- fit(hpc_glm, hpc_bad_form, data = hpc, control = ctrl)
8888
Condition
8989
Error in `check_outcome()`:
90-
! For a regression model, the outcome should be `numeric`, not a `factor`.
90+
! For a regression model, the outcome should be <numeric>, not <factor>.
9191

9292
---
9393

9494
Code
9595
lm_form_catch <- fit(hpc_glm, hpc_bad_form, data = hpc, control = caught_ctrl)
9696
Condition
9797
Error in `check_outcome()`:
98-
! For a regression model, the outcome should be `numeric`, not a `factor`.
98+
! For a regression model, the outcome should be <numeric>, not <factor>.
9999

100100
# newdata error trapping
101101

‎tests/testthat/_snaps/logistic_reg.md‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@
5151
res <- fit(lc_basic, funded_amnt ~ term, data = lending_club, control = ctrl)
5252
Condition
5353
Error in `check_outcome()`:
54-
! For a classification model, the outcome should be a `factor`, not a `integer`.
54+
! For a classification model, the outcome should be <factor>, not <integer>.
5555

5656
---
5757

@@ -60,7 +60,7 @@
6060
control = caught_ctrl)
6161
Condition
6262
Error in `check_outcome()`:
63-
! For a classification model, the outcome should be a `factor`, not a `integer`.
63+
! For a classification model, the outcome should be <factor>, not <integer>.
6464

6565
---
6666

@@ -69,15 +69,15 @@
6969
num_pred], y = lending_club$total_bal_il)
7070
Condition
7171
Error in `check_outcome()`:
72-
! For a classification model, the outcome should be a `factor`, not a `integer`.
72+
! For a classification model, the outcome should be <factor>, not <integer>.
7373

7474
# liblinear execution
7575

7676
Code
7777
res <- fit(ll_basic, funded_amnt ~ term, data = lending_club, control = ctrl)
7878
Condition
7979
Error in `check_outcome()`:
80-
! For a classification model, the outcome should be a `factor`, not a `integer`.
80+
! For a classification model, the outcome should be <factor>, not <integer>.
8181

8282
---
8383

@@ -86,7 +86,7 @@
8686
control = caught_ctrl)
8787
Condition
8888
Error in `check_outcome()`:
89-
! For a classification model, the outcome should be a `factor`, not a `integer`.
89+
! For a classification model, the outcome should be <factor>, not <integer>.
9090

9191
---
9292

@@ -95,7 +95,7 @@
9595
num_pred], y = lending_club$total_bal_il)
9696
Condition
9797
Error in `check_outcome()`:
98-
! For a classification model, the outcome should be a `factor`, not a `integer`.
98+
! For a classification model, the outcome should be <factor>, not <integer>.
9999

100100
# check_args() works
101101

‎tests/testthat/_snaps/misc.md‎

Lines changed: 1 addition & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -150,14 +150,6 @@
150150

151151
# check_outcome works as expected
152152

153-
Code
154-
check_outcome(factor(1:2), reg_spec)
155-
Condition
156-
Error in `check_outcome()`:
157-
! For a regression model, the outcome should be `numeric`, not a `factor`.
158-
159-
---
160-
161153
Code
162154
check_outcome(NULL, reg_spec)
163155
Condition
@@ -192,14 +184,6 @@
192184
! `linear_reg()` was unable to find an outcome.
193185
i Ensure that you have specified an outcome column and that it hasn't been removed in pre-processing.
194186

195-
---
196-
197-
Code
198-
check_outcome(1:2, class_spec)
199-
Condition
200-
Error in `check_outcome()`:
201-
! For a classification model, the outcome should be a `factor`, not a `integer`.
202-
203187
---
204188

205189
Code
@@ -233,5 +217,5 @@
233217
check_outcome(1:2, cens_spec)
234218
Condition
235219
Error in `check_outcome()`:
236-
! For a censored regression model, the outcome should be a `Surv` object, not a `integer`.
220+
! For a censored regression model, the outcome should be <Surv>, not <integer>.
237221

‎tests/testthat/_snaps/sparsevctrs.md‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -30,14 +30,6 @@
3030
Warning:
3131
`data` is a sparse tibble, but `linear_reg()` with engine "lm" doesn't accept that. Converting to non-sparse.
3232

33-
---
34-
35-
Code
36-
fit(spec, avg_price_per_room ~ ., data = hotel_data)
37-
Condition
38-
Error in `fit()`:
39-
! `x` must have column names.
40-
4133
# sparse tibble can be passed to `fit_xy() - unsupported
4234

4335
Code
@@ -135,3 +127,11 @@
135127
Error in `maybe_sparse_matrix()`:
136128
! no sparse vectors detected
137129

130+
# fit() errors if sparse matrix has no colnames
131+
132+
Code
133+
fit(spec, avg_price_per_room ~ ., data = hotel_data)
134+
Condition
135+
Error in `fit()`:
136+
! `x` must have column names.
137+

‎tests/testthat/test-misc.R‎

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -190,11 +190,6 @@ test_that('check_outcome works as expected', {
190190
check_outcome(mtcars, reg_spec)
191191
)
192192

193-
expect_snapshot(
194-
error = TRUE,
195-
check_outcome(factor(1:2), reg_spec)
196-
)
197-
198193
expect_snapshot(
199194
error = TRUE,
200195
check_outcome(NULL, reg_spec)
@@ -225,11 +220,6 @@ test_that('check_outcome works as expected', {
225220
check_outcome(lapply(mtcars, as.factor), class_spec)
226221
)
227222

228-
expect_snapshot(
229-
error = TRUE,
230-
check_outcome(1:2, class_spec)
231-
)
232-
233223
expect_snapshot(
234224
error = TRUE,
235225
check_outcome(NULL, class_spec)

‎tests/testthat/test-sparsevctrs.R‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ test_that("sparse tibble can be passed to `fit() - supported", {
99
spec <- boost_tree() %>%
1010
set_mode("regression") %>%
1111
set_engine("xgboost")
12-
12+
1313
expect_snapshot(
1414
error = TRUE,
1515
xgb_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data)
@@ -33,9 +33,9 @@ test_that("sparse matrix can be passed to `fit() - supported", {
3333
# Make materialization of sparse vectors throw an error
3434
# https://r-lib.github.io/sparsevctrs/dev/reference/sparsevctrs_options.html
3535
withr::local_options("sparsevctrs.verbose_materialize" = 3)
36-
36+
3737
hotel_data <- sparse_hotel_rates()
38-
38+
3939
spec <- boost_tree() %>%
4040
set_mode("regression") %>%
4141
set_engine("xgboost")
@@ -64,7 +64,7 @@ test_that("sparse tibble can be passed to `fit_xy() - supported", {
6464
# Make materialization of sparse vectors throw an error
6565
# https://r-lib.github.io/sparsevctrs/dev/reference/sparsevctrs_options.html
6666
withr::local_options("sparsevctrs.verbose_materialize" = 3)
67-
67+
6868
hotel_data <- sparse_hotel_rates(tibble = TRUE)
6969

7070
spec <- boost_tree() %>%
@@ -206,7 +206,7 @@ test_that("sparse data work with xgboost engine", {
206206
expect_no_error(
207207
xgb_fit <- fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1])
208208
)
209-
209+
210210
expect_no_error(
211211
predict(xgb_fit, hotel_data)
212212
)
@@ -221,7 +221,7 @@ test_that("sparse data work with xgboost engine", {
221221
expect_no_error(
222222
predict(xgb_fit, hotel_data)
223223
)
224-
224+
225225
expect_no_error(
226226
xgb_fit <- fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1])
227227
)
@@ -236,7 +236,7 @@ test_that("to_sparse_data_frame() is used correctly", {
236236
# Make materialization of sparse vectors throw an error
237237
# https://r-lib.github.io/sparsevctrs/dev/reference/sparsevctrs_options.html
238238
withr::local_options("sparsevctrs.verbose_materialize" = 3)
239-
239+
240240
local_mocked_bindings(
241241
to_sparse_data_frame = function(x, object) {
242242
if (methods::is(x, "sparseMatrix")) {
@@ -263,7 +263,7 @@ test_that("to_sparse_data_frame() is used correctly", {
263263
error = TRUE,
264264
fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1])
265265
)
266-
266+
267267
spec <- boost_tree() %>%
268268
set_mode("regression") %>%
269269
set_engine("xgboost")
@@ -279,7 +279,7 @@ test_that("maybe_sparse_matrix() is used correctly", {
279279
# Make materialization of sparse vectors throw an error
280280
# https://r-lib.github.io/sparsevctrs/dev/reference/sparsevctrs_options.html
281281
withr::local_options("sparsevctrs.verbose_materialize" = 3)
282-
282+
283283
local_mocked_bindings(
284284
maybe_sparse_matrix = function(x) {
285285
if (sparsevctrs::has_sparse_elements(x)) {

0 commit comments

Comments
 (0)