test_that("Back and fort", { nc <- terra::vect(system.file("shape/nc.shp", package = "sf")) nc <- nc[1:10, ] nc_pivoted <- pivot_longer(nc, dplyr::starts_with("BIR"), names_to = "year", values_to = "births" ) nc_unpivot <- pivot_wider(nc_pivoted, values_from = "births", names_from = "year" ) expect_s4_class(nc_unpivot, "SpatVector") # Reorder names nc_unpivot <- nc_unpivot[names(nc)] expect_identical( as_tbl_internal(nc), as_tbl_internal(nc_unpivot) ) }) test_that("Remove geometry from values", { nc <- terra::vect(system.file("shape/nc.shp", package = "sf")) nc <- nc[1:10, ] nc_pivoted <- pivot_longer(nc, dplyr::starts_with("BIR"), names_to = "year", values_to = "births" ) expect_snapshot( nc_unpivot <- pivot_wider(nc_pivoted, values_from = c(births, geometry), names_from = "year" ) ) expect_s4_class(nc_unpivot, "SpatVector") # Reorder names nc_unpivot <- nc_unpivot[names(nc)] expect_identical( as_tbl_internal(nc), as_tbl_internal(nc_unpivot) ) }) test_that("Remove geometry from names", { nc <- terra::vect(system.file("shape/nc.shp", package = "sf")) nc <- nc[1:10, ] nc_pivoted <- pivot_longer(nc, dplyr::starts_with("BIR"), names_to = "year", values_to = "births" ) expect_snapshot( nc_unpivot <- pivot_wider(nc_pivoted, values_from = births, names_from = c(geometry, year) ) ) expect_s4_class(nc_unpivot, "SpatVector") # Reorder names nc_unpivot <- nc_unpivot[names(nc)] expect_identical( as_tbl_internal(nc), as_tbl_internal(nc_unpivot) ) }) test_that("can pivot all cols to wide", { df <- tibble::tibble(key = c("x", "y", "z"), val = 1:3) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") expect_s4_class(df, "SpatVector") pv <- pivot_wider(df, names_from = key, values_from = val) expect_named(pv, c("x", "y", "z")) expect_equal(nrow(pv), 1) expect_s4_class(pv, "SpatVector") expect_identical(pull_crs(df), pull_crs(pv)) }) test_that("non-pivoted cols are preserved", { df <- tibble::tibble(a = 1, key = c("x", "y"), val = 1:2) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") expect_s4_class(df, "SpatVector") pv <- pivot_wider(df, names_from = key, values_from = val) expect_named(pv, c("a", "x", "y")) expect_equal(nrow(pv), 1) expect_s4_class(pv, "SpatVector") expect_identical(pull_crs(df), pull_crs(pv)) }) test_that("implicit missings turn into explicit missings", { df <- tibble::tibble(a = 1:2, key = c("x", "y"), val = 1:2) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") expect_s4_class(df, "SpatVector") pv <- pivot_wider(df, names_from = key, values_from = val) expect_equal(pv$a, c(1, 2)) expect_equal(pv$x, c(1, NA)) expect_equal(pv$y, c(NA, 2)) expect_s4_class(pv, "SpatVector") expect_identical(pull_crs(df), pull_crs(pv)) }) test_that("error when overwriting existing column", { df <- tibble::tibble( a = c(1, 1), key = c("a", "b"), val = c(1, 2) ) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") expect_error(pivot_wider(df, names_from = key, values_from = val)) expect_snapshot( out <- pivot_wider(df, names_from = key, values_from = val, names_repair = "unique" ) ) expect_named(out, c("a...2", "a...3", "b")) expect_s4_class(out, "SpatVector") expect_identical(pull_crs(df), pull_crs(out)) }) test_that("`names_repair` happens after spec column reorganization (#1107)", { df <- tibble::tibble( test = c("a", "b"), name = c("test", "test2"), value = c(1, 2) ) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") out <- pivot_wider(df, names_repair = ~ make.unique(.x)) expect_identical(out$test, c("a", "b")) expect_identical(out$test.1, c(1, NA)) expect_identical(out$test2, c(NA, 2)) expect_s4_class(out, "SpatVector") expect_identical(pull_crs(df), pull_crs(out)) }) test_that("grouping is preserved", { df <- tibble::tibble(g = 1, k = "x", v = 2) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") out <- df %>% group_by(g) %>% pivot_wider(names_from = k, values_from = v) expect_equal(dplyr::group_vars(out), "g") }) test_that("`names_from` must be supplied if `name` isn't in `data` (#1240)", { df <- tibble::tibble(key = "x", val = 1) expect_snapshot((expect_error(pivot_wider(df, values_from = val)))) }) test_that("can use `names_expand` to get sorted and expanded column names", { name1 <- factor(c(NA, "x"), levels = c("x", "y")) df <- tibble::tibble(name1 = name1, name2 = c("c", "d"), value = c(1, 2)) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") pivoted <- pivot_wider(df, names_from = c(name1, name2), names_expand = TRUE) tib <- as_tibble(pivoted) attr(tib, "crs") <- NULL na <- NA_real_ expect_identical( tib, tibble::tibble(x_c = na, x_d = 2, y_c = na, y_d = na, NA_c = 1, NA_d = na) ) }) test_that("can fill only implicit missings from `names_expand`", { name1 <- factor(c(NA, "x"), levels = c("x", "y")) df <- tibble::tibble(name1 = name1, name2 = c("c", "d"), value = c(1, NA)) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") res <- pivot_wider( data = df, names_from = c(name1, name2), names_expand = TRUE, values_fill = list(value = 0) ) expect_s4_class(res, "SpatVector") res_df <- as_tibble(res) attr(res_df, "crs") <- NULL # But not the explicit missing! expect_identical( res_df, tibble::tibble( x_c = 0, x_d = NA_real_, y_c = 0, y_d = 0, NA_c = 1, NA_d = 0 ) ) }) test_that("can override default keys, geometry sticky", { df <- tibble::tribble( ~row, ~name, ~var, ~value, 1, "Sam", "age", 10, 2, "Sam", "height", 1.5, 3, "Bob", "age", 20, ) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") pv <- pivot_wider(df, id_cols = name, names_from = var, values_from = value) expect_equal(nrow(pv), 2) expect_s4_class(pv, "SpatVector") }) test_that("`id_cols = everything()` excludes `names_from` and `values_from`", { df <- tibble::tibble(key = "x", name = "a", value = 1L) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") res <- pivot_wider(df, id_cols = dplyr::everything()) expect_s4_class(res, "SpatVector") res_tbl <- as_tibble(res) attr(res_tbl, "crs") <- NULL expect_identical( res_tbl, tibble::tibble(key = "x", a = 1L) ) }) test_that("`id_expand` generates sorted rows even if no expansion is done", { df <- tibble::tibble(id = c(2, 1), name = c("a", "b"), value = c(1, 2)) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") res <- pivot_wider(df, id_expand = TRUE) expect_identical(res$id, c(1, 2)) }) test_that("`id_expand` does a cartesian expansion of `id_cols`", { df <- tibble::tibble( id1 = c(1, 2), id2 = c(3, 4), name = c("a", "b"), value = c(1, 2) ) df$lat <- 1 df$lon <- 1 df <- terra::vect(df, crs = "EPSG:3857") res <- pivot_wider(df, id_expand = TRUE) expect_s4_class(res, "SpatVector") res_tbl <- as_tibble(res) attr(res_tbl, "crs") <- NULL expect_identical( res_tbl, tibble::tibble( id1 = c(1, 1, 2, 2), id2 = c(3, 4, 3, 4), a = c(1, NA, NA, NA), b = c(NA, NA, NA, 2), ) ) })