diff --git a/R/setup_rank_data.R b/R/setup_rank_data.R index 110e5794..a55b8976 100644 --- a/R/setup_rank_data.R +++ b/R/setup_rank_data.R @@ -8,7 +8,9 @@ #' optional initial value of the rankings. If `rankings` has column names, #' these are assumed to be the names of the items. `NA` values in rankings are #' treated as missing data and automatically augmented; to change this -#' behavior, see the `na_action` argument to [set_model_options()]. +#' behavior, see the `na_action` argument to [set_model_options()]. A vector +#' length `n_items` is silently converted to a matrix of length `1 x n_items`, +#' and names (if any), are used as column names. #' #' @param preferences A data frame with one row per pairwise comparison, and #' columns `assessor`, `top_item`, and `bottom_item`. Each column contains the @@ -138,10 +140,19 @@ setup_rank_data <- function( if (na_action == "fail" && any(is.na(rankings))) { stop("rankings matrix contains NA values") } + if (!is.matrix(rankings)) { + rankings <- matrix(rankings, + nrow = 1, + dimnames = list(NULL, names(rankings)) + ) + } if (na_action == "omit" && any(is.na(rankings))) { keeps <- apply(rankings, 1, function(x) !any(is.na(x))) - print(paste("Omitting", sum(!keeps), "row(s) from rankings due to NA values")) + print(paste( + "Omitting", sum(!keeps), + "row(s) from rankings due to NA values" + )) rankings <- rankings[keeps, , drop = FALSE] } } else { @@ -153,7 +164,10 @@ setup_rank_data <- function( if (!is.null(observation_frequency)) { validate_positive_vector(observation_frequency) if (nrow(rankings) != length(observation_frequency)) { - stop("observation_frequency must be of same length as the number of rows in rankings") + stop( + "observation_frequency must be of same ", + "length as the number of rows in rankings" + ) } } else { observation_frequency <- rep(1, nrow(rankings)) diff --git a/man/setup_rank_data.Rd b/man/setup_rank_data.Rd index a1a14dd2..74b09f9b 100644 --- a/man/setup_rank_data.Rd +++ b/man/setup_rank_data.Rd @@ -24,7 +24,9 @@ converted to rankings. If \code{preferences} is provided, \code{rankings} is an optional initial value of the rankings. If \code{rankings} has column names, these are assumed to be the names of the items. \code{NA} values in rankings are treated as missing data and automatically augmented; to change this -behavior, see the \code{na_action} argument to \code{\link[=set_model_options]{set_model_options()}}.} +behavior, see the \code{na_action} argument to \code{\link[=set_model_options]{set_model_options()}}. A vector +length \code{n_items} is silently converted to a matrix of length \verb{1 x n_items}, +and names (if any), are used as column names.} \item{preferences}{A data frame with one row per pairwise comparison, and columns \code{assessor}, \code{top_item}, and \code{bottom_item}. Each column contains the diff --git a/tests/testthat/test-setup_rank_data.R b/tests/testthat/test-setup_rank_data.R index cd8ec36e..a7c777f9 100644 --- a/tests/testthat/test-setup_rank_data.R +++ b/tests/testthat/test-setup_rank_data.R @@ -45,6 +45,14 @@ test_that("setup_rank_data works with rankings", { dat <- setup_rank_data(rr, validate_rankings = FALSE) expect_equal(dat$rankings, rr) + + input1 <- potato_weighing[2, , drop = FALSE] + rownames(input1) <- NULL + input2 <- potato_weighing[2, ] + expect_equal( + setup_rank_data(input1), + setup_rank_data(input2) + ) }) test_that("setup_rank_data works for preferences", { diff --git a/tests/testthat/test-smc_update_correctness.R b/tests/testthat/test-smc_update_correctness.R index eb97c1e4..14287b49 100644 --- a/tests/testthat/test-smc_update_correctness.R +++ b/tests/testthat/test-smc_update_correctness.R @@ -247,7 +247,7 @@ test_that("update_mallows works for data one at a time", { for (i in seq_len(200)) { mod <- update_mallows( model = mod, - new_data = setup_rank_data(sushi_rankings[i, , drop = FALSE]) + new_data = setup_rank_data(sushi_rankings[i, ]) ) } expect_equal(