context("Update a dataset") with_mock_crunch({ ds <- cachedLoadDataset("test ds") test_that("Updating values makes a POST request to the table endpoint", { ## TODO: assert the payload shape. This is mainly about exercising code ## in the unit tests. We test the behavior in integration tests expect_POST( ds$gender <- "Male", "https://app.crunch.io/api/datasets/1/table/" ) expect_POST( ds$birthyr <- 1970, "https://app.crunch.io/api/datasets/1/table/" ) expect_POST( ds$mymrset <- rep(c(1, 2), 10), "https://app.crunch.io/api/datasets/1/table/" ) expect_POST( ds$gender[ds$birthyr > 2020] <- "Male", "https://app.crunch.io/api/datasets/1/table/" ) expect_POST( ds$birthyr[ds$birthyr > 2020] <- 1970, "https://app.crunch.io/api/datasets/1/table/" ) expect_POST( ds$mymrset[ds$birthyr > 2020] <- 1, "https://app.crunch.io/api/datasets/1/table/" ) }) test_that("Validation on categorical update", { cats <- c("Male", "Other", "Prefer not to say", "Female") expect_error( ds$gender[is.na(ds$birthyr)] <- as.factor(cats), paste0( "Input values Other and Prefer not to say are not present in ", "the category names of variable" ) ) expect_error( ds$gender[is.na(ds$birthyr)] <- 3, "Input value 3 is not present in the category ids of variable" ) expect_error( ds$gender[1:2] <- c(NA, -1), "Cannot have both NA and -1 when specifying category ids" ) expect_error( ds$gender[1:2] <- FALSE, "Cannot update CategoricalVariable with type logical" ) expect_error( ds$gender <- FALSE, "Cannot update CategoricalVariable with type logical" ) }) test_that("Validation on filtered updating", { expect_error( ds$gender[ds$gender == "Male"] <- ds$gender[ds$birthyr == 1999], "Cannot update a variable with an expression that has a different filter" ) expect_error( ds$birthyr[ds$gender == "Male"] <- ds$birthyr[ds$gender == "Female"], "Cannot update a variable with an expression that has a different filter" ) expect_error( ds$birthyr[ds$gender == "Male"] <- ds$birthyr[ds$gender == "Female"] + 2, "Cannot update a variable with an expression that has a different filter" ) skip("TODO: distinguish this kind of attempted value updating from metadata updates") expect_error( ds$gender <- ds$gender[ds$birthyr == 1999], "Cannot update a variable with an expression that has a different filter" ) ## Now add filter to dataset ds2 <- ds[ds$gender == "Male", ] expect_error( ds2$gender <- ds$gender[ds$birthyr == 1999], "Cannot update a variable with an expression that has a different filter" ) expect_error( ds2$birthyr <- ds$birthyr[ds$gender == "Female"], "Cannot update a variable with an expression that has a different filter" ) expect_error( ds2$birthyr <- ds$birthyr[ds$gender == "Female"] + 2, "Cannot update a variable with an expression that has a different filter" ) ## TODO: further filter on filtered dataset/variable }) test_that("Can't update variable with logical expression", { expect_error( ds$gender[ds$gender == "Male"] <- is.na(ds$gender[ds$gender == "Male"]), "Cannot update CategoricalVariable with type CrunchLogicalExpr" ) skip("TODO: distinguish this kind of attempted value updating from metadata updates") expect_error( ds$gender <- is.na(ds$gender), "Cannot update CategoricalVariable with type CrunchLogicalExpr" ) }) test_that("Trying to update with the wrong data type fails", { expect_error( ds$birthyr[is.na(ds$gender)] <- letters[3:7], "Cannot update NumericVariable with type character" ) }) }) with_test_authentication({ ds <- newDataset(df) test_that("Can update numeric variable with values", { ds$v3 <- 9:28 test <- as.vector(ds$v3) - df$v3 expect_true(all(test == 1)) }) ds$v3 <- 1 test_that("Value recycling on insert is consistent with R", { expect_true(all(as.vector(ds$v3) == 1)) }) ds$v3[1:10] <- 2 test_that("Update numeric with R numeric filter and values", { expect_equivalent(mean(ds$v3), 1.5) }) ds$v3[ds$v3 == 1] <- 3 test_that("Update numeric with LogicalExpression filter", { expect_equivalent(mean(ds$v3), 2.5) }) ds[ds$v3 == 2, "v3"] <- 4 test_that("Update with LogicalExpression within dataset", { expect_equivalent(mean(ds$v3), 3.5) }) ds$v3 <- c(rep(5, 10), rep(7, 10)) test_that("Just update the values", { expect_equivalent(mean(ds$v3), 6) }) test_that("Can update numeric variable with expresssion", { ds$v3 <- ds$v3 + 2 expect_equivalent(as.vector(ds$v3), c(rep(7, 10), rep(9, 10))) }) test_that("Can filter on is.na", { ds$v3[is.na(ds$v2)] <- 0 expect_equivalent( as.vector(ds$v3), c(rep(7, 10), rep(9, 5), rep(0, 5)) ) }) test_that("Can update text", { ds$v2[is.na(ds$v1)] <- "z" expect_identical( as.vector(ds$v2)[1:8], c(rep("z", 5), "f", "g", "h") ) ds[ds$v2 %in% "z", "v2"] <- "y" expect_identical( as.vector(ds$v2)[1:8], c(rep("y", 5), "f", "g", "h") ) }) test_that("Can update datetime", { newvals <- as.Date(0:12, origin = "1985-10-26") ds$v5[ds$v5 >= as.Date("1955-11-12")] <- newvals expect_identical(max(ds$v5), as.Date("1985-11-07")) }) date.before <- rep(c("2014-04-15", "2014-08-15"), 2) date.after <- c( "2014-04-15", "2014-09-15", "2014-04-15", "2014-09-15" ) date.df <- data.frame(wave = as.Date(date.before)) with(test.dataset(date.df, "date.ds"), { test_that("Another datetime update", { expect_identical( as.vector(date.ds$wave), as.Date(date.before) ) date.ds$wave[date.ds$wave == as.Date("2014-08-15")] <- as.Date("2014-09-15") expect_identical( as.vector(date.ds$wave), as.Date(date.after) ) }) }) ## Categorical ds$v4[is.na(ds$v2)] <- "B" test_that("Can update categorical variables with character", { expect_equivalent(table(ds$v4)["B"], c(B = 13L)) }) ds$v4[is.na(ds$v2)] <- factor("C") test_that("Can update categorical with factor", { expect_equivalent(table(ds$v4)["C"], c(C = 12L)) }) ds$v4[is.na(ds$v2)] <- c(2, 1, 2, 1, 2) test_that("Can update categorical with numeric (ids)", { expect_equivalent(table(ds$v4), table(df$v4)) }) ## Logical -> Categorical test_that("Category names for logical-as-categorical", { expect_identical( names(categories(ds$v6)), c("True", "False", "No Data") ) }) test_that("Can edit values of a logical-as-categorical with logical", { ds$v6[c(2, 5)] <- FALSE expect_equal(as.vector(ds$v6[1:5], "id"), c(1, 0, 1, 1, 0)) ds$v6[c(6, 9)] <- c(FALSE, NA) expect_equal( as.vector(ds$v6[1:10], "id"), c(1, 0, 1, 1, 0, 0, 1, 1, -1, 1) ) }) })