Nothing
library(testthat)
context("dplyr-Spatial")
## TODO: Rename context
## TODO: Add more tests
library(maptools)
library(spdplyr)
data(wrld_simpl)
wrld_simpl@proj4string@projargs <- "+proj=longlat +datum=WGS84"
poly1 <- wrld_simpl
line1 <- as(wrld_simpl, "SpatialLinesDataFrame")
point1 <- as(line1, "SpatialPointsDataFrame")
#mpoint1 <- SpatialMultiPointsDataFrame(lapply(split(line1, seq(nrow(line1))), function(y) coordinates(as(y, "SpatialPoints"))),
# as.data.frame(line1))
data(mpoint1)
test_that("filter works for all geometric types", {
expect_that(nrow(filter(poly1, NAME == "Australia")), equals(1L) )
expect_that(nrow(poly1 %>% filter(NAME == "Australia")), equals(1L) )
expect_that(nrow(filter(line1, NAME == "Australia")), equals(1L) )
expect_that(nrow(line1 %>% filter(NAME == "Australia")), equals(1L) )
expect_that(nrow(filter(point1, NAME == "Australia")), equals(611L) )
expect_that(nrow(point1 %>% filter(NAME == "Australia")), equals(611L) )
expect_that(nrow(filter(mpoint1, NAME == "Australia")), equals(1L) )
expect_that(nrow(mpoint1 %>% filter(NAME == "Australia")), equals(1L) )
## multipoint needs work, slicing here duplicates row.names so catch this warning as expected for now
## update 2017-04-30 MDS no warning needed anymore
#expect_that(nrow(slice(mpoint1, 1:2)), testthat::gives_warning("some row.names duplicated"))
expect_silent(nrow(slice(mpoint1, 1:2)))
})
# filter() (and slice())
# arrange()
# select() (and rename())
# distinct()
# summarise()
# sample_n() and sample_frac()
test_that("mutate works for all geometric types", {
expect_that( ncol(mutate(poly1, NAME = NAME)), equals(11) )
expect_that( ncol(mutate(line1, NAME = NAME)), equals(11) )
expect_that( ncol(mutate(point1, NAME = NAME)), equals(14) )
expect_that( ncol(mutate(mpoint1, NAME = NAME)), equals(11) )
expect_that( ncol(mutate(poly1, NAMECOPY = NAME)), equals(12) )
expect_that( ncol(mutate(line1, NAMECOPY = NAME)), equals(12) )
expect_that( ncol(mutate(point1, NAMECOPY = NAME)), equals(15) )
expect_that( ncol(mutate(mpoint1, NAMECOPY = NAME)), equals(12) )
expect_that( ncol(transmute(poly1, NAMECOPY = NAME)), equals(1) )
expect_that( ncol(transmute(line1, NAMECOPY = NAME)), equals(1) )
expect_that( ncol(transmute(point1, NAMECOPY = NAME)), equals(1) )
expect_that( ncol(transmute(mpoint1, NAMECOPY = NAME)), equals(1) )
})
test_that("arrange works", {
expect_that(nrow(arrange(poly1)), equals(246L) )
expect_that(nrow(arrange(point1)), equals(26264L) )
expect_that(arrange(line1)$UN, equals(c(28L, 12L, 31L, 8L, 51L, 24L, 16L, 32L, 36L, 48L, 52L, 60L,
44L, 50L, 84L, 70L, 68L, 104L, 204L, 90L, 76L, 100L, 96L, 124L,
116L, 144L, 178L, 180L, 108L, 156L, 4L, 64L, 152L, 136L, 120L,
148L, 174L, 170L, 188L, 140L, 192L, 132L, 184L, 196L, 208L, 262L,
212L, 214L, 218L, 818L, 372L, 226L, 233L, 232L, 222L, 231L, 40L,
203L, 254L, 246L, 242L, 238L, 583L, 258L, 250L, 270L, 266L, 268L,
288L, 308L, 304L, 276L, 316L, 300L, 320L, 324L, 328L, 332L, 340L,
191L, 348L, 352L, 356L, 364L, 376L, 380L, 384L, 368L, 392L, 388L,
400L, 404L, 417L, 408L, 296L, 410L, 414L, 398L, 418L, 422L, 428L,
112L, 440L, 430L, 703L, 438L, 434L, 450L, 474L, 496L, 500L, 807L,
466L, 504L, 480L, 478L, 470L, 512L, 462L, 484L, 458L, 508L, 454L,
540L, 570L, 562L, 533L, 660L, 56L, 344L, 580L, 234L, 20L, 292L,
833L, 442L, 446L, 492L, 275L, 499L, 175L, 248L, 574L, 166L, 10L,
74L, 260L, 334L, 86L, 162L, 581L, 548L, 566L, 528L, 578L, 524L,
520L, 740L, 558L, 554L, 600L, 604L, 586L, 616L, 591L, 620L, 598L,
624L, 634L, 638L, 642L, 498L, 608L, 630L, 643L, 646L, 682L, 659L,
690L, 710L, 426L, 72L, 686L, 705L, 694L, 702L, 706L, 724L, 662L,
736L, 752L, 760L, 756L, 780L, 764L, 762L, 772L, 776L, 768L, 678L,
788L, 792L, 798L, 795L, 834L, 800L, 826L, 804L, 840L, 854L, 858L,
860L, 670L, 862L, 92L, 704L, 850L, 516L, 876L, 882L, 748L, 887L,
894L, 716L, 360L, 312L, 530L, 784L, 626L, 612L, 585L, 584L, 666L,
654L, 674L, 796L, 732L, 688L, 336L, 744L, 663L, 652L, 831L, 832L,
239L, 158L)))
expect_that(arrange(poly1, NAME, UN)$SUBREGION[100], equals(30L))
})
test_that("select works", {
expect_that(names(select(poly1, "ISO2", "NAME")), equals(c("ISO2", "NAME")))
expect_that(names(select(line1, "ISO2", "NAME")), equals(c("ISO2", "NAME")))
})
# filter() (and slice())
# arrange()
# select() (and rename())
# distinct()
# mutate() (and transmute())
# summarise()
# sample_n() and sample_frac()
test_that("distinct works", {
expect_that(nrow(distinct(poly1, REGION, .keep_all = TRUE)), equals(6L))
expect_that(distinct(poly1, REGION, .keep_all = TRUE), is_a("SpatialPolygonsDataFrame"))
})
test_that("mutate works", {
expect_silent(mutate(poly1, NAME = "all same", AREA = row_number()))
expect_silent(transmute(line1, Country= NAME, LON = 100))
expect_that(transmute(line1, Country= NAME, LON = 100), is_a("SpatialLinesDataFrame"))
})
test_that("various examples", {
testthat::skip_on_cran()
expect_silent(wrld_simpl %>% mutate(NAME = "allthesame", REGION = row_number()))
expect_silent(wrld_simpl %>% transmute(alpha = paste0(FIPS, NAME)) )
expect_silent(wrld_simpl %>% filter(NAME %in% c("New Zealand", "Australia", "Fiji")))
expect_silent(wrld_simpl %>% arrange(LON) )
expect_silent(wrld_simpl %>% slice(c(9, 100)))
expect_silent(wrld_simpl %>% dplyr::select(UN, FIPS))
expect_silent(wrld_simpl %>% rename(`TM_WORLD_BORDERS_SIMPL0.2NAME` = NAME))
expect_silent(wrld_simpl %>% distinct(REGION, .keep_all = TRUE) %>% arrange(REGION) ) ## first alphabetically in REGION
expect_silent(wrld_simpl %>% arrange(REGION, desc(NAME)) %>% distinct(REGION, .keep_all = TRUE)) ## last
## we don't need to use piping
expect_silent( slice(filter(mutate(wrld_simpl, likepiping = FALSE), abs(LON - 5) < 35 & LAT > 50), 4))
## summarise/ze is different, we have to return only one geometry
expect_that(wrld_simpl %>% summarize(max(AREA)), is_a(class(wrld_simpl)))
expect_silent(as(wrld_simpl, "SpatialLinesDataFrame") %>% mutate(perim = rnorm(246)))
}
)
ws <- filter(wrld_simpl, NAME %in% c("Portugal", "France", "Spain"))
ws$chNAME <- levels(ws$NAME)[ws$NAME]
d <- data.frame(ent = c("Australia", "Portugal", "New Zealand", "France", "Spain"), AREA = seq(1.2, 2, length = 5),
stringsAsFactors = FALSE)
test_that("joins work", {
expect_true(all(is.na(left_join(ws@data, d)$ent)))
expect_true(all(is.na(left_join(ws, d)$ent)))
## MDS changed 2017-05-06 and 2020-05-12
#expect_that(left_join(ws@data, d, c("NAME" = "ent")), gives_warning("joining character"))
#expect_that(left_join(ws@data, d, c("NAME" = "ent")), gives_warning("coercing into character vector"))
expect_that(left_join(ws, d, c("chNAME" = "ent")), is_a(class(ws)))
expect_that(nrow(inner_join(ws@data, d)), equals(0L))
## we can get 0-row S*DF
expect_that(nrow(inner_join(ws, d)), equals(0L))
#expect_that(inner_join(ws@data, d, c("NAME" = "ent")), gives_warning("joining factor and character"))
expect_that(inner_join(ws, d, c("chNAME" = "ent")), is_a(class(ws)))
expect_that(nrow(inner_join(ws, d, c("chNAME" = "ent"))), equals(3L))
expect_that(nrow(inner_join(ws, d[1:4, ], c("chNAME" = "ent"))), equals(2L))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.