From 11e2f83aa0ab68bb8ef324dd0abb39c3eeda7656 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 12 Aug 2023 12:10:57 +0200 Subject: [PATCH] fix, tests --- R/means_by_group.R | 4 ++-- tests/testthat/test-labelled_data.R | 36 +++++++++++++++------------- tests/testthat/test-means_by_group.R | 8 +++++++ 3 files changed, 29 insertions(+), 19 deletions(-) create mode 100644 tests/testthat/test-means_by_group.R diff --git a/R/means_by_group.R b/R/means_by_group.R index 4a5330992..79294ae15 100644 --- a/R/means_by_group.R +++ b/R/means_by_group.R @@ -187,7 +187,7 @@ means_by_group.data.frame <- function(x, # p-values of contrast-means if (insight::check_if_installed("emmeans", quietly = TRUE)) { # create summary table of contrasts, for p-values and confidence intervals - predicted <- emmeans::emmeans(fit, specs = "group") + predicted <- emmeans::emmeans(fit, specs = "group", level = ci) contrasts <- emmeans::contrast(predicted, method = "eff") # add p-values and confidence intervals to "out" if (!is.null(ci) && !is.na(ci)) { @@ -247,7 +247,7 @@ format.dw_groupmeans <- function(x, digits = NULL, ...) { digits <- 2 } x$N <- insight::format_value(x$N, digits = 0) - insight::format_table(x, digits = digits, ...) + insight::format_table(remove_empty_columns(x), digits = digits, ...) } #' @export diff --git a/tests/testthat/test-labelled_data.R b/tests/testthat/test-labelled_data.R index b0f92c730..0b7e37a4d 100644 --- a/tests/testthat/test-labelled_data.R +++ b/tests/testthat/test-labelled_data.R @@ -4,13 +4,13 @@ data(efc, package = "datawizard") test_that("reverse, labels preserved", { # factor, label - expect_equal( + expect_identical( attr(reverse(efc$e42dep), "label", exact = TRUE), "elder's dependency" ) # factor, labels - expect_equal( - names(attr(reverse(efc$e42dep), "labels", exact = TRUE)), + expect_named( + attr(reverse(efc$e42dep), "labels", exact = TRUE), names(attr(efc$e42dep, "labels", exact = TRUE)) ) expect_equal( @@ -19,13 +19,13 @@ test_that("reverse, labels preserved", { ignore_attr = TRUE ) # numeric - expect_equal( - names(attr(reverse(efc$c12hour), "labels", exact = TRUE)), + expect_named( + attr(reverse(efc$c12hour), "labels", exact = TRUE), names(attr(efc$c12hour, "labels", exact = TRUE)) ) # data frame - labels <- sapply(reverse(efc), function(i) attr(i, "label", exact = TRUE)) - expect_equal( + labels <- sapply(reverse(efc), attr, which = "label", exact = TRUE) + expect_identical( labels, c( c12hour = "average number of hours of care per week", @@ -42,8 +42,8 @@ test_that("reverse, labels preserved", { # data_merge ----------------------------------- test_that("data_merge, labels preserved", { - labels <- sapply(data_merge(efc[c(1:2)], efc[c(3:4)], verbose = FALSE), function(i) attr(i, "label", exact = TRUE)) - expect_equal( + labels <- sapply(data_merge(efc[1:2], efc[3:4], verbose = FALSE), attr, which = "label", exact = TRUE) + expect_identical( labels, c( c12hour = "average number of hours of care per week", @@ -72,8 +72,8 @@ test_that("data_extract, labels preserved", { ignore_attr = TRUE ) # data frame - labels <- sapply(data_extract(efc, select = c("e42dep", "c172code")), function(i) attr(i, "label", exact = TRUE)) - expect_equal( + labels <- sapply(data_extract(efc, select = c("e42dep", "c172code")), attr, which = "label", exact = TRUE) + expect_identical( labels, c(e42dep = "elder's dependency", c172code = "carer's level of education") ) @@ -142,8 +142,8 @@ test_that("data_rename, labels preserved", { ignore_attr = TRUE ) # data frame - labels <- sapply(data_remove(efc, starts_with("c1")), function(i) attr(i, "label", exact = TRUE)) - expect_equal( + labels <- sapply(data_remove(efc, starts_with("c1")), attr, which = "label", exact = TRUE) + expect_identical( labels, c(e16sex = "elder's gender", e42dep = "elder's dependency", neg_c_7 = "Negative impact with 7 items") ) @@ -255,12 +255,12 @@ test_that("data_match, labels preserved", { test_that("data_filter, labels preserved", { x <- data_filter(efc, c172code == 1 & c12hour > 40) # factor - expect_equal( + expect_identical( attr(x$e42dep, "label", exact = TRUE), attr(efc$e42dep, "label", exact = TRUE) ) # numeric - expect_equal( + expect_identical( attr(x$c12hour, "label", exact = TRUE), attr(efc$c12hour, "label", exact = TRUE) ) @@ -271,7 +271,9 @@ test_that("data_filter, labels preserved", { # convert_to_na ----------------------------------- test_that("convert_to_na, labels preserved", { - expect_message(x <- convert_to_na(efc, na = c(2, "2"), select = starts_with("e"))) + expect_message({ + x <- convert_to_na(efc, na = c(2, "2"), select = starts_with("e")) + }) # factor expect_equal( attr(x$e42dep, "label", exact = TRUE), @@ -301,7 +303,7 @@ test_that("convert_to_na, labels preserved", { ) # drop unused value labels x <- convert_to_na(efc$c172code, na = 2) - expect_equal( + expect_identical( attr(x, "labels", exact = TRUE), c(`low level of education` = 1, `high level of education` = 3) ) diff --git a/tests/testthat/test-means_by_group.R b/tests/testthat/test-means_by_group.R new file mode 100644 index 000000000..2dc484a36 --- /dev/null +++ b/tests/testthat/test-means_by_group.R @@ -0,0 +1,8 @@ +test_that("meany_by_group", { + data(efc) + expect_snapshot(means_by_group(efc, "c12hour", "e42dep")) + expect_snapshot(means_by_group(efc, "c12hour", "e42dep", ci = 0.99)) + expect_snapshot(means_by_group(efc, "c12hour", "e42dep", ci = NA)) + expect_snapshot(means_by_group(efc$c12hour, efc$e42dep)) + expect_snapshot(means_by_group(efc$c12hour, efc$e42dep, ci = NA)) +})