tests/testthat/test_paired.R

## Tests for tableby

context("Testing the paired output")

dat <- data.frame(
  tp = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
  id = c(1, 1, 2, 2, 3, 3, 4, 4, 5, 6),
  Cat = c("A", "A", "A", "B", "B", "B", "B", "A", NA, "B"),
  Fac = factor(c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A")),
  Num = c(1, 2, 3, 4, 4, 3, 3, 4, 0, NA),
  Num2 = c(1, 2, 1, 2, 2, 1, 2, 0, 2, NA),
  Ord = ordered(c("I", "II", "II", "III", "III", "III", "I", "III", "II", "I")),
  Lgl = c(TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE),
  Dat = as.Date("2018-05-01") + c(1, 1, 2, 2, 3, 4, 5, 6, 3, 4),
  stringsAsFactors = FALSE
)
dat$s <- selectall(a = c(1, 1, 0, 0, 0, 1, 0, 1, 0, 0), b = c(0, 0, 1, 1, 1, 0, 1, 0, 1, 1))
dat2 <- dat

###########################################################################################################
#### Basic paired calls
###########################################################################################################

for(i in 1:3)
{
  if(i == 2) dat$id <- as.character(dat$id) else if(i == 3) dat$id <- as.factor(dat$id)
  test_that(paste0("Basic paired call; class(id) = ", class(dat$id), "; na.paired('asis')"), {
    expect_identical(
      capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat + s, data = dat, id = id,
                                   signed.rank.exact = FALSE, na.action = na.paired("asis")), text = TRUE)),
      c("|             |         1 (N=5)         |         2 (N=5)         | Difference (N=4) | p value|",
        "|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
        "|Cat          |                         |                         |                  |   1.000|",
        "|-  N-Miss    |            1            |            0            |        0         |        |",
        "|-  A         |        2 (50.0%)        |        2 (40.0%)        |    1 (50.0%)     |        |",
        "|-  B         |        2 (50.0%)        |        3 (60.0%)        |    1 (50.0%)     |        |",
        "|Fac          |                         |                         |                  |   0.261|",
        "|-  A         |        2 (40.0%)        |        2 (40.0%)        |    2 (100.0%)    |        |",
        "|-  B         |        1 (20.0%)        |        2 (40.0%)        |    1 (100.0%)    |        |",
        "|-  C         |        2 (40.0%)        |        1 (20.0%)        |    1 (100.0%)    |        |",
        "|Num          |                         |                         |                  |   0.391|",
        "|-  N-Miss    |            0            |            1            |        0         |        |",
        "|-  Mean (SD) |      2.200 (1.643)      |      3.250 (0.957)      |  0.500 (1.000)   |        |",
        "|-  Range     |      0.000 - 4.000      |      2.000 - 4.000      |  -1.000 - 1.000  |        |",
        "|Ord          |                         |                         |                  |   0.174|",
        "|-  I         |        2 (40.0%)        |        1 (20.0%)        |    2 (100.0%)    |        |",
        "|-  II        |        2 (40.0%)        |        1 (20.0%)        |    1 (100.0%)    |        |",
        "|-  III       |        1 (20.0%)        |        3 (60.0%)        |     0 (0.0%)     |        |",
        "|Lgl          |                         |                         |                  |   1.000|",
        "|-  FALSE     |        3 (60.0%)        |        2 (40.0%)        |    2 (100.0%)    |        |",
        "|-  TRUE      |        2 (40.0%)        |        3 (60.0%)        |    1 (50.0%)     |        |",
        "|Dat          |                         |                         |                  |   0.182|",
        "|-  Median    |       2018-05-04        |       2018-05-05        |      0.500       |        |",
        "|-  Range     | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 |  0.000 - 1.000   |        |",
        "|s            |                         |                         |                  |        |",
        "|-  a         |        1 (20.0%)        |        3 (60.0%)        |    2 (50.0%)     |        |",
        "|-  b         |        4 (80.0%)        |        2 (40.0%)        |    2 (50.0%)     |        |"
      )
    )
  })

  test_that(paste0("Basic paired call; class(id) = ", class(dat$id), "; na.paired('fill')"), {
    expect_identical(
      capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat, data = dat, id = id,
                                   signed.rank.exact = FALSE, na.action = na.paired("fill")), text = TRUE)),
      c("|             |         1 (N=6)         |         2 (N=6)         | Difference (N=6) | p value|",
        "|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
        "|Cat          |                         |                         |                  |   1.000|",
        "|-  N-Miss    |            2            |            1            |        2         |        |",
        "|-  A         |        2 (50.0%)        |        2 (40.0%)        |    1 (50.0%)     |        |",
        "|-  B         |        2 (50.0%)        |        3 (60.0%)        |    1 (50.0%)     |        |",
        "|Fac          |                         |                         |                  |   0.261|",
        "|-  N-Miss    |            1            |            1            |        2         |        |",
        "|-  A         |        2 (40.0%)        |        2 (40.0%)        |    2 (100.0%)    |        |",
        "|-  B         |        1 (20.0%)        |        2 (40.0%)        |    1 (100.0%)    |        |",
        "|-  C         |        2 (40.0%)        |        1 (20.0%)        |    1 (100.0%)    |        |",
        "|Num          |                         |                         |                  |   0.391|",
        "|-  N-Miss    |            1            |            2            |        2         |        |",
        "|-  Mean (SD) |      2.200 (1.643)      |      3.250 (0.957)      |  0.500 (1.000)   |        |",
        "|-  Range     |      0.000 - 4.000      |      2.000 - 4.000      |  -1.000 - 1.000  |        |",
        "|Ord          |                         |                         |                  |   0.174|",
        "|-  N-Miss    |            1            |            1            |        2         |        |",
        "|-  I         |        2 (40.0%)        |        1 (20.0%)        |    2 (100.0%)    |        |",
        "|-  II        |        2 (40.0%)        |        1 (20.0%)        |    1 (100.0%)    |        |",
        "|-  III       |        1 (20.0%)        |        3 (60.0%)        |     0 (0.0%)     |        |",
        "|Lgl          |                         |                         |                  |   1.000|",
        "|-  N-Miss    |            1            |            1            |        2         |        |",
        "|-  FALSE     |        3 (60.0%)        |        2 (40.0%)        |    2 (100.0%)    |        |",
        "|-  TRUE      |        2 (40.0%)        |        3 (60.0%)        |    1 (50.0%)     |        |",
        "|Dat          |                         |                         |                  |   0.182|",
        "|-  N-Miss    |            1            |            1            |        2         |        |",
        "|-  Median    |       2018-05-04        |       2018-05-05        |      0.500       |        |",
        "|-  Range     | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 |  0.000 - 1.000   |        |"
      )
    )
  })

  test_that(paste0("Basic paired call; class(id) = ", class(dat$id), "; na.paired('in.both')"), {
    expect_identical(
      capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat, data = dat, id = id,
                                   signed.rank.exact = FALSE, na.action = na.paired("in.both")), text = TRUE)),
      c("|             |         1 (N=4)         |         2 (N=4)         | Difference (N=4) | p value|",
        "|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
        "|Cat          |                         |                         |                  |   1.000|",
        "|-  A         |        2 (50.0%)        |        2 (50.0%)        |    1 (50.0%)     |        |",
        "|-  B         |        2 (50.0%)        |        2 (50.0%)        |    1 (50.0%)     |        |",
        "|Fac          |                         |                         |                  |   0.261|",
        "|-  A         |        2 (50.0%)        |        1 (25.0%)        |    2 (100.0%)    |        |",
        "|-  B         |        1 (25.0%)        |        2 (50.0%)        |    1 (100.0%)    |        |",
        "|-  C         |        1 (25.0%)        |        1 (25.0%)        |    1 (100.0%)    |        |",
        "|Num          |                         |                         |                  |   0.391|",
        "|-  Mean (SD) |      2.750 (1.258)      |      3.250 (0.957)      |  0.500 (1.000)   |        |",
        "|-  Range     |      1.000 - 4.000      |      2.000 - 4.000      |  -1.000 - 1.000  |        |",
        "|Ord          |                         |                         |                  |   0.174|",
        "|-  I         |        2 (50.0%)        |        0 (0.0%)         |    2 (100.0%)    |        |",
        "|-  II        |        1 (25.0%)        |        1 (25.0%)        |    1 (100.0%)    |        |",
        "|-  III       |        1 (25.0%)        |        3 (75.0%)        |     0 (0.0%)     |        |",
        "|Lgl          |                         |                         |                  |   1.000|",
        "|-  FALSE     |        2 (50.0%)        |        1 (25.0%)        |    2 (100.0%)    |        |",
        "|-  TRUE      |        2 (50.0%)        |        3 (75.0%)        |    1 (50.0%)     |        |",
        "|Dat          |                         |                         |                  |   0.182|",
        "|-  Median    |       2018-05-03        |       2018-05-04        |      0.500       |        |",
        "|-  Range     | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 |  0.000 - 1.000   |        |"
      )
    )
  })
}

test_that(paste0("Basic paired call; na.paired('in.both')"), {
  expect_identical(
    capture.kable(summary(paired(tp ~ Cat + Fac + Lgl, data = dat, id = id,
                                 test = FALSE, na.action = na.paired("in.both"),
                                 cat.stats = c("Nmiss", "countrowpct", "countcellpct", "rowbinomCI")), text = TRUE)),
    c("|         |       1 (N=4)        |       2 (N=4)        |   Difference (N=4)   |",
      "|:--------|:--------------------:|:--------------------:|:--------------------:|",
      "|Cat      |                      |                      |                      |",
      "|-  A     |      2 (50.0%)       |      2 (50.0%)       |      1 (50.0%)       |",
      "|-  B     |      2 (50.0%)       |      2 (50.0%)       |      1 (50.0%)       |",
      "|-  A     |      2 (25.0%)       |      2 (25.0%)       |      1 (50.0%)       |",
      "|-  B     |      2 (25.0%)       |      2 (25.0%)       |      1 (50.0%)       |",
      "|-  A     | 0.500 (0.068, 0.932) | 0.500 (0.068, 0.932) | 0.500 (0.013, 0.987) |",
      "|-  B     | 0.500 (0.068, 0.932) | 0.500 (0.068, 0.932) | 0.500 (0.013, 0.987) |",
      "|Fac      |                      |                      |                      |",
      "|-  A     |      2 (66.7%)       |      1 (33.3%)       |      2 (100.0%)      |",
      "|-  B     |      1 (33.3%)       |      2 (66.7%)       |      1 (100.0%)      |",
      "|-  C     |      1 (50.0%)       |      1 (50.0%)       |      1 (100.0%)      |",
      "|-  A     |      2 (25.0%)       |      1 (12.5%)       |      2 (100.0%)      |",
      "|-  B     |      1 (12.5%)       |      2 (25.0%)       |      1 (100.0%)      |",
      "|-  C     |      1 (12.5%)       |      1 (12.5%)       |      1 (100.0%)      |",
      "|-  A     | 0.667 (0.094, 0.992) | 0.333 (0.008, 0.906) | 1.000 (0.158, 1.000) |",
      "|-  B     | 0.333 (0.008, 0.906) | 0.667 (0.094, 0.992) | 1.000 (0.025, 1.000) |",
      "|-  C     | 0.500 (0.013, 0.987) | 0.500 (0.013, 0.987) | 1.000 (0.025, 1.000) |",
      "|Lgl      |                      |                      |                      |",
      "|-  FALSE |      2 (66.7%)       |      1 (33.3%)       |      2 (100.0%)      |",
      "|-  TRUE  |      2 (40.0%)       |      3 (60.0%)       |      1 (50.0%)       |",
      "|-  FALSE |      2 (25.0%)       |      1 (12.5%)       |      2 (100.0%)      |",
      "|-  TRUE  |      2 (25.0%)       |      3 (37.5%)       |      1 (50.0%)       |",
      "|-  FALSE | 0.667 (0.094, 0.992) | 0.333 (0.008, 0.906) | 1.000 (0.158, 1.000) |",
      "|-  TRUE  | 0.400 (0.053, 0.853) | 0.600 (0.147, 0.947) | 0.500 (0.013, 0.987) |"
    )
  )
})

dat$id[10] <- NA
dat$tp[9] <- NA
test_that("Paired with missings", {
  expect_identical(
    capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat, data = dat, id = id, signed.rank.exact = FALSE), text = TRUE)),
    c("|             |         1 (N=4)         |         2 (N=4)         | Difference (N=4) | p value|",
      "|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
      "|Cat          |                         |                         |                  |   1.000|",
      "|-  A         |        2 (50.0%)        |        2 (50.0%)        |    1 (50.0%)     |        |",
      "|-  B         |        2 (50.0%)        |        2 (50.0%)        |    1 (50.0%)     |        |",
      "|Fac          |                         |                         |                  |   0.261|",
      "|-  A         |        2 (50.0%)        |        1 (25.0%)        |    2 (100.0%)    |        |",
      "|-  B         |        1 (25.0%)        |        2 (50.0%)        |    1 (100.0%)    |        |",
      "|-  C         |        1 (25.0%)        |        1 (25.0%)        |    1 (100.0%)    |        |",
      "|Num          |                         |                         |                  |   0.391|",
      "|-  Mean (SD) |      2.750 (1.258)      |      3.250 (0.957)      |  0.500 (1.000)   |        |",
      "|-  Range     |      1.000 - 4.000      |      2.000 - 4.000      |  -1.000 - 1.000  |        |",
      "|Ord          |                         |                         |                  |   0.174|",
      "|-  I         |        2 (50.0%)        |        0 (0.0%)         |    2 (100.0%)    |        |",
      "|-  II        |        1 (25.0%)        |        1 (25.0%)        |    1 (100.0%)    |        |",
      "|-  III       |        1 (25.0%)        |        3 (75.0%)        |     0 (0.0%)     |        |",
      "|Lgl          |                         |                         |                  |   1.000|",
      "|-  FALSE     |        2 (50.0%)        |        1 (25.0%)        |    2 (100.0%)    |        |",
      "|-  TRUE      |        2 (50.0%)        |        3 (75.0%)        |    1 (50.0%)     |        |",
      "|Dat          |                         |                         |                  |   0.182|",
      "|-  Median    |       2018-05-03        |       2018-05-04        |      0.500       |        |",
      "|-  Range     | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 |  0.000 - 1.000   |        |"
    )
  )
})

test_that("09/07/2018: specifying different digits (#107) and cat.simplify (#134)", {
  expect_identical(
    capture.kable(summary(paired(tp ~ mcnemar(Cat, digits.count = 1, digits.pct = 0, cat.simplify = TRUE) + paired.t(Num, digits = 1) +
                                   sign.test(Num2, "meansd") + paired.t(Dat, "median", date.simplify = TRUE),
                                 data = dat, id = id, numeric.simplify = TRUE), text = TRUE, labelTranslations = list(Dat = "Date"))),
    c("|             |    1 (N=4)    |    2 (N=4)    | Difference (N=4) | p value|",
      "|:------------|:-------------:|:-------------:|:----------------:|-------:|",
      "|Cat          |   2.0 (50%)   |   2.0 (50%)   |    1.0 (50%)     |   1.000|",
      "|Num          |               |               |                  |   0.391|",
      "|-  Mean (SD) |   2.8 (1.3)   |   3.2 (1.0)   |    0.5 (1.0)     |        |",
      "|-  Range     |   1.0 - 4.0   |   2.0 - 4.0   |    -1.0 - 1.0    |        |",
      "|Num2         | 1.500 (0.577) | 1.250 (0.957) |  -0.250 (1.500)  |   1.000|",
      "|Date         |  2018-05-03   |  2018-05-04   |      0.500       |   0.182|"
    )
  )
})

dat$tp <- replace(as.character(dat$tp), dat$tp == "2", "")
test_that("08/23/2018: empty string in by-variable (#121)",
          expect_warning(summary(paired(tp ~ Cat, id = id, data = dat, signed.rank.exact = FALSE)), "Empty"))


test_that("07/17/2019: fix bug with confidence limits and count (#234, #235)", {
  tmp <- dat2
  tmp$Cat[2] <- "B"
  expect_identical(
    capture.kable(summary(paired(tp ~ Cat, data = tmp, cat.stats = c("binomCI", "count", "countpct"), id = id,
                                  control = tableby.control(conf.level = 0.9)), text = TRUE)),
    c("|     |       1 (N=4)        |       2 (N=4)        |   Difference (N=4)   | p value|",
      "|:----|:--------------------:|:--------------------:|:--------------------:|-------:|",
      "|Cat  |                      |                      |                      |   0.248|",
      "|-  A | 0.500 (0.098, 0.902) | 0.250 (0.013, 0.751) | 1.000 (0.224, 1.000) |        |",
      "|-  B | 0.500 (0.098, 0.902) | 0.750 (0.249, 0.987) | 0.500 (0.025, 0.975) |        |",
      "|-  A |          2           |          1           |          2           |        |",
      "|-  B |          2           |          3           |          1           |        |",
      "|-  A |      2 (50.0%)       |      1 (25.0%)       |      2 (100.0%)      |        |",
      "|-  B |      2 (50.0%)       |      3 (75.0%)       |      1 (50.0%)       |        |"
    )
  )
})

test_that("12/27/2019: Nrowpct works (#263)", {
  d <- data.frame(
    tp = rep(c("Time 1", "Time 2"), times = 4),
    id = c(1, 1, 2, 2, 3, 3, 4, 4),
    a = c(1, 1, 2, 2, 3, 3, 4, 4),
    b = c(1, 0, 2, 0, 3, 0, 4, 0)
  )
  expect_identical(
    capture.kable(summary(paired(tp ~ notest(a) + b, id = id, data = d, numeric.stats = c("meansd", "Nrowpct")), text = TRUE)),
    c("|             | Time 1 (N=4)  | Time 2 (N=4)  | Difference (N=4) | p value|",
      "|:------------|:-------------:|:-------------:|:----------------:|-------:|",
      "|a            |               |               |                  |        |",
      "|-  Mean (SD) | 2.500 (1.291) | 2.500 (1.291) |  0.000 (0.000)   |        |",
      "|-  N (%)     |   4 (50.0%)   |   4 (50.0%)   |     0 (0.0%)     |        |",
      "|b            |               |               |                  |   0.030|",
      "|-  Mean (SD) | 2.500 (1.291) | 0.000 (0.000) |  -2.500 (1.291)  |        |",
      "|-  N (%)     |   4 (50.0%)   |   4 (50.0%)   |    4 (100.0%)    |        |"
    )
  )
})

test_that("12/27/2019: changing the difference label (#271)", {
  expect_identical(
    capture.kable(summary(paired(tp ~ Cat + Fac + Num, data = dat2, id = id, signed.rank.exact = FALSE, cat.stats = c("countpct", "countrowpct"),
                                 stats.labels = list(meansd = "Mean (sd)", range = "Ran", difference = "Diff")), text = TRUE)),
    c("|             |    1 (N=4)    |    2 (N=4)    |   Diff (N=4)   | p value|",
      "|:------------|:-------------:|:-------------:|:--------------:|-------:|",
      "|Cat          |               |               |                |   1.000|",
      "|-  A         |   2 (50.0%)   |   2 (50.0%)   |   1 (50.0%)    |        |",
      "|-  B         |   2 (50.0%)   |   2 (50.0%)   |   1 (50.0%)    |        |",
      "|-  A         |   2 (50.0%)   |   2 (50.0%)   |   1 (50.0%)    |        |",
      "|-  B         |   2 (50.0%)   |   2 (50.0%)   |   1 (50.0%)    |        |",
      "|Fac          |               |               |                |   0.261|",
      "|-  A         |   2 (50.0%)   |   1 (25.0%)   |   2 (100.0%)   |        |",
      "|-  B         |   1 (25.0%)   |   2 (50.0%)   |   1 (100.0%)   |        |",
      "|-  C         |   1 (25.0%)   |   1 (25.0%)   |   1 (100.0%)   |        |",
      "|-  A         |   2 (66.7%)   |   1 (33.3%)   |   2 (100.0%)   |        |",
      "|-  B         |   1 (33.3%)   |   2 (66.7%)   |   1 (100.0%)   |        |",
      "|-  C         |   1 (50.0%)   |   1 (50.0%)   |   1 (100.0%)   |        |",
      "|Num          |               |               |                |   0.391|",
      "|-  Mean (sd) | 2.750 (1.258) | 3.250 (0.957) | 0.500 (1.000)  |        |",
      "|-  Ran       | 1.000 - 4.000 | 2.000 - 4.000 | -1.000 - 1.000 |        |"
    )
  )
})

test_that("12/27/2019: informative error when no stats are computed (#273)", {
  expect_error(summary(paired(tp ~ Cat, data = dat2, id = id, cat.stats = "Nmiss")), "Nothing to show for variable")
})

test_that("NAs in sign.test, plus Nsigntest (#326)", {
  d <- data.frame(
    tp = rep(c("Time 1", "Time 2"), times = 4),
    id = c(1, 1, 2, 2, 3, 3, 4, 4),
    a = c(1, 2, 2, 3, 3, 4, 5, NA)
  )
  expect_identical(
    capture.kable(summary(paired(tp ~ sign.test(a), id = id, data = d, numeric.stats = c("Nmiss", "meansd", "range", "Nsigntest")), text = TRUE)),
    c("|                 | Time 1 (N=4)  | Time 2 (N=4)  | Difference (N=4) | p value|",
      "|:----------------|:-------------:|:-------------:|:----------------:|-------:|",
      "|a                |               |               |                  |   0.250|",
      "|-  N-Miss        |       0       |       1       |        1         |        |",
      "|-  Mean (SD)     | 2.750 (1.708) | 3.000 (1.000) |  1.000 (0.000)   |        |",
      "|-  Range         | 1.000 - 5.000 | 2.000 - 4.000 |  1.000 - 1.000   |        |",
      "|-  N (sign test) |      NA       |      NA       |        3         |        |"
    )
  )
})
eheinzen/arsenal documentation built on Sept. 11, 2022, 10:59 a.m.