tests/testthat/test-03-extract.R

In andrie/surveydata: Tools to Work with Survey Data

# Unit tests for "surveydata" class
#
# Author: Andrie
#------------------------------------------------------------------------------

{
  sdat <- data.frame(
    id = 1:4,
    Q1 = c("Yes", "No", "Yes", "Yes"),
    Q4_1 = c(1, 2, 1, 2),
    Q4_2 = c(3, 4, 4, 3),
    Q4_3 = c(5, 5, 6, 6),
    Q4_other = LETTERS[1:4],
    Q10 = factor(c("Male", "Female", "Female", "Male")),
    crossbreak = c("A", "A", "B", "B"),
    crossbreak2 = c("D", "E", "D", "E"),
    weight = c(0.9, 1.1, 0.8, 1.2)
  )

  sdat_labels <- c(
    "RespID",
    "Question 1",
    "Question 4: red", "Question 4: green", "Question 4: blue", "Question 4: other",
    "Question 10",
    "crossbreak",
    "crossbreak2",
    "weight"
  )
  names(sdat_labels) <- names(sdat)
  varlabels(sdat) <- sdat_labels
}

rm.ca <- function(x) {
  class(x) <- class(x)[!grepl("surveydata", class(x))]
  rm.attrs(x)
}


#------------------------------------------------------------------------------



test_that("`$` extracts correct columns", {
  s <- as.surveydata(sdat, renameVarlabels = TRUE)

  expect_equal(s$id, 1:4)
  expect_equal(s$Q4_1, c(1, 2, 1, 2))
  expect_s3_class(s, "surveydata")
})




#------------------------------------------------------------------------------

# context("Surveydata `[` simple extract")

test_that("`[` simple extract returns surveydata object", {
  s <- as.surveydata(sdat, renameVarlabels = TRUE)
  #      load_all(pkg)
  #      which.q(s, "Q4")
  #      x <- NULL
  #      x <- s[2]
  #      x
  #      varlabels(x)
  #      str(x)

  expect_s3_class(s[], "surveydata")
  expect_s3_class(s[, 2], "surveydata")
  expect_s3_class(s[1, ], "surveydata")
  expect_s3_class(s[2, 2], "surveydata")
  expect_s3_class(s[, "Q1"], "surveydata")
  expect_s3_class(s[, "Q4"], "surveydata")
})

test_that("`[` simple extract returns correct data", {
  s <- as.surveydata(sdat, renameVarlabels = TRUE)

  expect_equal(s[], s)
  expect_equal(rm.ca(s[2, ]), rm.ca(sdat[2, ]))
  expect_equal(rm.ca(s[, 2]), rm.ca(sdat[, 2, drop = FALSE]))
  expect_equal(rm.ca(s[, "Q1"]), rm.ca(sdat[, 2, drop = FALSE]))
  expect_equal(rm.ca(s[, "Q4"]), rm.ca(sdat[, 3:5, drop = FALSE]))
  expect_equal(rm.ca(s[2, "Q4"]), rm.ca(sdat[2, 3:5, drop = FALSE]))
  expect_equal(rm.ca(s[1:2, "Q10"]), rm.ca(sdat[1:2, 7, drop = FALSE]))
  expect_equal(rm.ca(s[, "weight"]), rm.ca(sdat[, "weight", drop = FALSE]))
})

test_that("`[` simple extract returns correct varlabels", {
  s <- as.surveydata(sdat, renameVarlabels = TRUE)

  expect_equal(varlabels(s[]), sdat_labels)
  expect_equal(varlabels(s[2]), sdat_labels[2])
  expect_equal(varlabels(s[, 2]), sdat_labels[2])
  expect_equal(varlabels(s[2:4, 5]), sdat_labels[5])
  expect_equal(varlabels(s[, "Q1"]), sdat_labels[2])
  expect_equal(varlabels(s[, "Q4"]), sdat_labels[3:5])
  expect_equal(varlabels(s[2, "Q4"]), sdat_labels[3:5])
  expect_equal(varlabels(s[2, "Q1"]), sdat_labels[2])
})

test_that("`[` simple extract with drop=TRUE returns vectors", {
  s <- as.surveydata(sdat, renameVarlabels = TRUE)

  expect_equal(rm.ca(s[, 2, drop = TRUE]), rm.ca(sdat[, 2, drop = TRUE]))
  expect_equal(rm.ca(s[, "Q1", drop = TRUE]), rm.ca(sdat[, 2, drop = TRUE]))
  expect_equal(rm.ca(s[, "Q4", drop = TRUE]), rm.ca(sdat[, 3:5, drop = TRUE]))
  expect_equal(rm.ca(s[2, "Q4", drop = TRUE]), rm.ca(sdat[2, 3:5, drop = TRUE]))
  expect_equal(rm.ca(s[1:2, "Q10", drop = TRUE]), rm.ca(sdat[1:2, 7, drop = TRUE]))
  expect_equal(rm.ca(s[, "weight", drop = TRUE]), rm.ca(sdat[, "weight", drop = TRUE]))
})


#------------------------------------------------------------------------------

# context("Surveydata `[` complex extract")
test_that("`[` complex extract works as expected", {
  s <- as.surveydata(sdat, renameVarlabels = TRUE)

  expect_equal(rm.ca(s[, c(1, 3)]), rm.ca(sdat[, c(1, 3)]))
  expect_equal(rm.ca(s[, -1]), rm.ca(sdat[, -1]))
  expect_equal(rm.ca(s[, c(1, "Q4")]), rm.ca(sdat[, c(1, 3:5)]))
  expect_equal(rm.ca(s[, c("Q1", "Q4")]), rm.ca(sdat[, c(2, 3:5)]))

  expect_equal(varlabels(s[, c(1, 3)]), sdat_labels[c(1, 3)])
  expect_equal(varlabels(s[, -1]), sdat_labels[-1])
  expect_equal(varlabels(s[, c(1, "Q4")]), sdat_labels[c(1, 3:5)])
  expect_equal(varlabels(s[, c("Q1", "Q4")]), sdat_labels[c(2, 3:5)])
})


#------------------------------------------------------------------------------

test_that("`[` extract with logicals", {
  s <- as.surveydata(sdat, renameVarlabels = TRUE)

  i <- sdat$id == 1
  j <- grepl("Q4", names(s))
  expect_equal(rm.ca(s[i, ]), rm.ca(sdat[i, ]))
  expect_equal(rm.ca(s[!i, ]), rm.ca(sdat[!i, ]))
  expect_equal(rm.ca(s[i, j]), rm.ca(sdat[i, j]))
  expect_equal(rm.ca(s[i, !j]), rm.ca(sdat[i, !j]))
  expect_equal(rm.ca(s[!i, j]), rm.ca(sdat[!i, j]))
  expect_equal(rm.ca(s[!i, j]), rm.ca(sdat[!i, j]))
  expect_equal(rm.ca(s[!i, !j]), rm.ca(sdat[!i, !j]))
})