Skip to content

Commit

Permalink
Merge remote-tracking branch 'origin/rel-6.5.2531'
Browse files Browse the repository at this point in the history
  • Loading branch information
Crunch.io Jenkins Account committed Mar 27, 2024
2 parents 799df38 + c26ad44 commit 20f23a8
Show file tree
Hide file tree
Showing 3 changed files with 299 additions and 293 deletions.
46 changes: 24 additions & 22 deletions tests/testthat/test-append-debug.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,28 +42,30 @@ with_test_authentication({
"Contains subvariables found in other arrays after matching: CA2"
)
})
test_that("The append fails", {
expect_error(
appendDataset(part1, part2),
"Subvariable 'mr_1' cannot be bound to both arrays 'CA2' and 'CA1'."
)
})
part1 <- cleanseBatches(part1)

test_that(paste0(
"Can re-alias array variables to make them line up ",
"**and then drop rows** (and old refs don't reappear)"
), {
alias(part2$CA2) <- "CA1"
## This is the critical piece to trigger the error: delete rows after realiasing
part2 <- dropRows(part2, seq_len(nrow(part2)) == 1)
out <- appendDataset(part1, part2)
expect_equal(dim(out), c(2 * nrow(part2) + 1, ncol(part2)))
expect_identical(
aliases(subvariables(out$CA1)),
c("mr_1", "mr_2", "mr_3")
)
})
# Revisit after https://www.pivotaltracker.com/n/projects/2172644/stories/186660623
# (reusable subvar codes) ships
# test_that("The append fails", {
# expect_error(
# appendDataset(part1, part2),
# "Subvariable 'mr_1' cannot be bound to both arrays 'CA2' and 'CA1'."
# )
# })
# part1 <- cleanseBatches(part1)
#
# test_that(paste0(
# "Can re-alias array variables to make them line up ",
# "**and then drop rows** (and old refs don't reappear)"
# ), {
# alias(part2$CA2) <- "CA1"
# ## This is the critical piece to trigger the error: delete rows after realiasing
# part2 <- dropRows(part2, seq_len(nrow(part2)) == 1)
# out <- appendDataset(part1, part2)
# expect_equal(dim(out), c(2 * nrow(part2) + 1, ncol(part2)))
# expect_identical(
# aliases(subvariables(out$CA1)),
# c("mr_1", "mr_2", "mr_3")
# )
# })
})

whereas("Appending arrays with different subvars and derived vars", {
Expand Down
178 changes: 90 additions & 88 deletions tests/testthat/test-append-subvariables.R
View file
Original file line number Diff line number Diff line change
@@ -1,94 +1,96 @@
context("Appending datasets with unbound subvariables")

with_test_authentication({
whereas("When appending a dataset with unbound subvariables", {
part1 <- mrdf.setup(newDataset(mrdf), selections = "1.0")
mr_cats <- categories(part1$MR)
subvar_cats <- categories(part1$MR$mr_1)
dichotomized_cats <- Categories(
list(id = 2L, missing = FALSE, name = "0.0", numeric_value = 0, selected = FALSE),
list(id = 1L, missing = FALSE, name = "1.0", numeric_value = 1, selected = TRUE),
list(id = -1L, missing = TRUE, name = "No Data", numeric_value = NULL, selected = FALSE)
)
## Dichotomize this way so that categories get aligned
## (via supertype)

part2 <- mrdf.setup(newDataset(mrdf))
unbind(part2$CA)
part2 <- refresh(part2)
undichotomized_cats <- Categories(
list(id = 2L, missing = FALSE, name = "0.0", numeric_value = 0),
list(id = 1L, missing = FALSE, name = "1.0", numeric_value = 1),
list(id = -1L, missing = TRUE, name = "No Data", numeric_value = NULL)
)
test_that("set up MR for appending", {
expect_true(is.Multiple(part1$MR))
expect_equivalent(
as.array(crtabs(~MR, data = part1)),
array(c(2, 1, 1),
dim = c(3L),
dimnames = list(MR = c("mr_1", "mr_2", "mr_3"))
)
)
expect_null(part2$MR)
expect_identical(mr_cats, subvar_cats)
expect_identical(mr_cats, dichotomized_cats)
expect_identical(
categories(part2$mr_1),
undichotomized_cats
)
expect_false(identical(
dichotomized_cats,
undichotomized_cats
)) ## Just being clear about that
expect_identical(
as.vector(part1$MR$mr_1),
as.vector(part2$mr_1)
)
expect_identical(
as.vector(part1$MR$mr_2),
as.vector(part2$mr_2)
)
expect_identical(
as.vector(part1$MR$mr_3),
as.vector(part2$mr_3)
)
})
out <- suppressMessages(try(appendDataset(part1, part2)))
test_that("Dataset #2 isn't modified by appending to another", {
part2 <- refresh(part2)
expect_null(part2$MR)
expect_true(is.Categorical(part2$mr_1))
})
test_that("the unbound subvariables get lined up", {
expect_true(is.dataset(out))
expect_length(batches(out), 2)
expect_identical(dim(out), c(nrow(mrdf) * 2L, 2L))
expect_true(is.variable(out$MR))
expect_identical(categories(out$MR), dichotomized_cats)
expect_identical(categories(out$MR$mr_1), dichotomized_cats)
expect_false(identical(
categories(out$MR),
undichotomized_cats
))
expect_identical(
as.vector(out$MR$mr_1),
rep(as.vector(part2$mr_1), 2)
)
expect_true(is.Multiple(out$MR))
expect_identical(
names(subvariables(out$MR)),
c("mr_1", "mr_2", "mr_3")
)
expect_equivalent(
as.array(crtabs(~MR, data = out)),
array(c(4, 2, 2),
dim = c(3L),
dimnames = list(MR = c("mr_1", "mr_2", "mr_3"))
)
)
})
})
# Revisit after https://www.pivotaltracker.com/n/projects/2172644/stories/186660623
# (reusable subvar codes) ships
# whereas("When appending a dataset with unbound subvariables", {
# part1 <- mrdf.setup(newDataset(mrdf), selections = "1.0")
# mr_cats <- categories(part1$MR)
# subvar_cats <- categories(part1$MR$mr_1)
# dichotomized_cats <- Categories(
# list(id = 2L, missing = FALSE, name = "0.0", numeric_value = 0, selected = FALSE),
# list(id = 1L, missing = FALSE, name = "1.0", numeric_value = 1, selected = TRUE),
# list(id = -1L, missing = TRUE, name = "No Data", numeric_value = NULL, selected = FALSE)

Check warning on line 13 in tests/testthat/test-append-subvariables.R

View workflow job for this annotation

GitHub Actions / test-coverage 

file=tests/testthat/test-append-subvariables.R,line=13,col=101,[line_length_linter] Lines should not be more than 100 characters. This line is 102 characters.
# )
# ## Dichotomize this way so that categories get aligned
# ## (via supertype)
#
# part2 <- mrdf.setup(newDataset(mrdf))
# unbind(part2$CA)
# part2 <- refresh(part2)
# undichotomized_cats <- Categories(
# list(id = 2L, missing = FALSE, name = "0.0", numeric_value = 0),
# list(id = 1L, missing = FALSE, name = "1.0", numeric_value = 1),
# list(id = -1L, missing = TRUE, name = "No Data", numeric_value = NULL)
# )
# test_that("set up MR for appending", {
# expect_true(is.Multiple(part1$MR))
# expect_equivalent(
# as.array(crtabs(~MR, data = part1)),
# array(c(2, 1, 1),
# dim = c(3L),
# dimnames = list(MR = c("mr_1", "mr_2", "mr_3"))
# )
# )
# expect_null(part2$MR)
# expect_identical(mr_cats, subvar_cats)
# expect_identical(mr_cats, dichotomized_cats)
# expect_identical(
# categories(part2$mr_1),
# undichotomized_cats
# )
# expect_false(identical(
# dichotomized_cats,
# undichotomized_cats
# )) ## Just being clear about that
# expect_identical(
# as.vector(part1$MR$mr_1),
# as.vector(part2$mr_1)
# )
# expect_identical(
# as.vector(part1$MR$mr_2),
# as.vector(part2$mr_2)
# )
# expect_identical(
# as.vector(part1$MR$mr_3),
# as.vector(part2$mr_3)
# )
# })
# out <- suppressMessages(try(appendDataset(part1, part2)))
# test_that("Dataset #2 isn't modified by appending to another", {
# part2 <- refresh(part2)
# expect_null(part2$MR)
# expect_true(is.Categorical(part2$mr_1))
# })
# test_that("the unbound subvariables get lined up", {
# expect_true(is.dataset(out))
# expect_length(batches(out), 2)
# expect_identical(dim(out), c(nrow(mrdf) * 2L, 2L))
# expect_true(is.variable(out$MR))
# expect_identical(categories(out$MR), dichotomized_cats)
# expect_identical(categories(out$MR$mr_1), dichotomized_cats)
# expect_false(identical(
# categories(out$MR),
# undichotomized_cats
# ))
# expect_identical(
# as.vector(out$MR$mr_1),
# rep(as.vector(part2$mr_1), 2)
# )
# expect_true(is.Multiple(out$MR))
# expect_identical(
# names(subvariables(out$MR)),
# c("mr_1", "mr_2", "mr_3")
# )
# expect_equivalent(
# as.array(crtabs(~MR, data = out)),
# array(c(4, 2, 2),
# dim = c(3L),
# dimnames = list(MR = c("mr_1", "mr_2", "mr_3"))
# )
# )
# })
# })

whereas("When appending arrays with different subsets of subvariables", {
part1 <- mrdf.setup(newDataset(mrdf[-3]), selections = "1.0")
Expand Down
Loading

0 comments on commit 20f23a8

Please sign in to comment.