use arg_match()

jakub-jedrusiak · Jun 7, 2023 · beadf64 · beadf64
1 parent 9e30a30
commit beadf64
Show file tree

Hide file tree

Showing 7 changed files with 15 additions and 19 deletions.
diff --git a/R/mtscr_model.R b/R/mtscr_model.R
@@ -31,7 +31,7 @@
 #' # extract effects for creativity score by hand
 #' model <- mtscr_model(mtscr_creativity, id, item, SemDis_MEAN, top = 2)
 #' creativity_score <- glmmTMB::ranef(model)$cond$id[, 1]
-mtscr_model <- function(df, id_column, item_column = NULL, score_column, top = 1, prepared = FALSE, ties_method = "random") {
+mtscr_model <- function(df, id_column, item_column = NULL, score_column, top = 1, prepared = FALSE, ties_method = c("random", "average")) {
   id_column <- rlang::ensym(id_column)
   item_column_quo <- rlang::enquo(item_column)
   if (!rlang::quo_is_null(item_column_quo)) {
@@ -41,6 +41,8 @@ mtscr_model <- function(df, id_column, item_column = NULL, score_column, top = 1
   }
   score_column <- rlang::ensym(score_column)
 
+  ties_method <- rlang::arg_match(ties_method)
+
   # check if all .ordering_X columns exist
   ordering_columns <- purrr::map(
     as.list(top),

diff --git a/R/mtscr_prepare.R b/R/mtscr_prepare.R
@@ -32,7 +32,7 @@
 #' data("mtscr_creativity", package = "mtscr")
 #' # Indicators for top 1 and top 2 answers
 #' mtscr_prepare(mtscr_creativity, id, item, SemDis_MEAN, top = 1:2, minimal = TRUE)
-mtscr_prepare <- function(df, id_column, item_column = NULL, score_column, top = 1, minimal = FALSE, ties_method = "random") {
+mtscr_prepare <- function(df, id_column, item_column = NULL, score_column, top = 1, minimal = FALSE, ties_method = c("random", "average")) {
   id_column <- rlang::ensym(id_column)
   item_column_quo <- rlang::enquo(item_column)
   if (!rlang::quo_is_null(item_column_quo)) {
@@ -42,6 +42,8 @@ mtscr_prepare <- function(df, id_column, item_column = NULL, score_column, top =
   }
   score_column <- rlang::ensym(score_column)
 
+  ties_method <- rlang::arg_match(ties_method)
+
   # check if df is a data frame
   if (!is.data.frame(df)) {
     cli::cli_abort(

diff --git a/R/mtscr_score.R b/R/mtscr_score.R
@@ -22,7 +22,7 @@
 #'
 #' # add scores to the original data frame
 #' mtscr_score(mtscr_creativity, id, item, SemDis_MEAN, format = "full")
-mtscr_score <- function(df, id_column, item_column = NULL, score_column, top = 1, format = "minimal", ties_method = "random") {
+mtscr_score <- function(df, id_column, item_column = NULL, score_column, top = 1, format = c("minimal", "full"), ties_method = c("random", "average")) {
   id_column <- rlang::ensym(id_column)
   item_column_quo <- enquo(item_column)
   if (!rlang::quo_is_null(item_column_quo)) {
@@ -31,18 +31,10 @@ mtscr_score <- function(df, id_column, item_column = NULL, score_column, top = 1
     item_column <- item_column_quo
   }
   score_column <- rlang::ensym(score_column)
+  format <- rlang::arg_match(format)
+  ties_method <- rlang::arg_match(ties_method)
   df_original <- df
 
-  # check that format is either "minimal" or "full"
-  if (!format %in% c("minimal", "full")) {
-    cli::cli_abort(
-      c(
-        "{.arg format} must be either \"minimal\" or \"full\".",
-        "x" = "{.var {rlang::expr_text(substitute(format))}} is invalid."
-      )
-    )
-  }
-
   # prepare
   df <- mtscr_prepare(df, !!id_column, !!item_column, !!score_column, top = top, minimal = FALSE, ties_method = ties_method)
   model <- mtscr_model(df, !!id_column, !!item_column, !!score_column, top = top, prepared = TRUE, ties_method = ties_method)

diff --git a/man/mtscr_model.Rd b/man/mtscr_model.Rd
diff --git a/man/mtscr_prepare.Rd b/man/mtscr_prepare.Rd
diff --git a/man/mtscr_score.Rd b/man/mtscr_score.Rd
diff --git a/tests/testthat/test-mtscr_score.R b/tests/testthat/test-mtscr_score.R
@@ -65,7 +65,7 @@ test_that("invalid format error is thrown", {
   expect_error(mtscr_score(mtscr_creativity, id, item, SemDis_MEAN, format = "invalid"))
 
   # call function with format = c("minimal", "full")
-  expect_error(mtscr_score(mtscr_creativity, id, item, SemDis_MEAN, format = c("minimal", "full")))
+  expect_error(mtscr_score(mtscr_creativity, id, item, SemDis_MEAN, format = c("minimal", "invalid")))
 })
 
 # Test that top argument must be integer
@@ -148,4 +148,4 @@ test_that("works if item column is omitted", {
 
   # check that results are the same
   expect_equal(result_item, result_no_item)
-})
+})