Nothing
expect_maps_equal <- function(m1, m2) {
attr(m1$x, "leafletData") <- NULL
attr(m2$x, "leafletData") <- NULL
expect_equal(m1, m2, ignore_function_env = TRUE, ignore_formula_env = TRUE)
}
normalize_multipolygon <- function(df) {
# A multipolygon is a nested list of lng/lat data frames. Each data frame
# represents a single polygon (may be an island or a hole), that is, a series
# of points where the last point is the same as the first point.
#
# This function walks the nested list, and for each lng/lat data frame, it
# reorders the points so that equivalent polygons always have the same points
# in the same order. The data frame rows are rotated so that the first row
# contains the smallest lng; ties are broken with lat.
if (is.list(df) && !is.data.frame(df)) {
return(lapply(df, normalize_multipolygon))
}
stopifnot(identical(names(df), c("lng", "lat")))
if (nrow(df) <= 1) {
return(df)
}
if (!all(df[1,] == df[nrow(df),])) {
stop("Malformed polygon; first and last rows were not identical")
}
# Remove duplicate point, for now
df <- df[-nrow(df),]
tip <- order(df[,1], df[,2])[[1]]
idx <- seq_len(nrow(df)) >= tip
df <- rbind(df[idx,], df[!idx,], df[tip,])
row.names(df) <- NULL
df
}
test_that("normalize", {
skip_if_not_installed("sf")
library(sf)
library(sp)
### polygons --------------------------------------------------------------
pgontest <- function(x) {
leaflet(x) %>% addTiles() %>% addPolygons()
}
poldata <- st_as_sf(gadmCHE)
(r1 <- pgontest(poldata))
(r2 <- pgontest(st_geometry(poldata)))
(r3 <- pgontest(st_geometry(poldata)[[1]]))
(r4 <- pgontest(st_geometry(poldata)[[1]][[1]] %>% st_polygon()))
(r5 <- pgontest(gadmCHE))
(r6 <- pgontest(polygons(gadmCHE)))
(r7 <- pgontest(polygons(gadmCHE)@polygons[[1]]))
(r8 <- pgontest(polygons(gadmCHE)@polygons[[1]]@Polygons[[1]]))
expect_maps_equal(r1, r2)
expect_maps_equal(r3, r4)
expect_maps_equal(r1, r5)
### lines -----------------------------------------------------------------
lindata <- st_as_sf(atlStorms2005)
plinetest <- function(x) {
leaflet(x) %>% addTiles() %>% addPolylines()
}
(l1 <- plinetest(lindata)) # sf, data.frame
(l2 <- plinetest(st_geometry(lindata))) # sfc_LINESTRING, sfc
(l3 <- plinetest(st_geometry(lindata)[[1]])) # XY, LINESTRING, sfg
(l4 <- plinetest(st_multilinestring(st_geometry(lindata)))) # XY, MULTILINESTRING, sfg
(l5 <- plinetest(atlStorms2005))
(l6 <- plinetest(SpatialLines(atlStorms2005@lines)))
(l7 <- plinetest(atlStorms2005@lines[[1]]))
(l8 <- plinetest(atlStorms2005@lines[[1]]@Lines[[1]]))
expect_maps_equal(l1, l2)
expect_maps_equal(l1, l5)
expect_maps_equal(l1, l6)
expect_maps_equal(l3, l7)
expect_maps_equal(l3, l8)
### points ----------------------------------------------------------------
ptsdata <- st_as_sf(breweries91)
class(ptsdata) # sf, data.frame
class(st_geometry(ptsdata)) # sfc_POINT, sfc
class(st_geometry(ptsdata)[[1]]) # XY, POINT, sfg
class(do.call(rbind, unclass(st_geometry(ptsdata))) %>% st_multipoint()) # XY, POINT, sfg
(p1 <- leaflet() %>% addTiles() %>% addCircleMarkers(data = ptsdata))
(p2 <- leaflet() %>% addTiles() %>% addCircleMarkers(data = st_geometry(ptsdata)))
(p3 <- leaflet() %>% addTiles() %>% addCircleMarkers(data = st_geometry(ptsdata)[[1]]))
# leaflet() %>% addTiles() %>% addCircleMarkers(data = do.call(rbind, unclass(st_geometry(ptsdata))) %>% st_multipoint())
expect_maps_equal(p1, p2)
(p4 <- leaflet() %>% addTiles() %>% addCircleMarkers(data = ptsdata[FALSE, ]))
(p5 <- leaflet() %>% addTiles() %>% addCircleMarkers(data = st_geometry(ptsdata)[FALSE]))
(p6 <- leaflet() %>% addTiles() %>% addCircleMarkers(lng = numeric(0), lat = numeric(0)))
expect_maps_equal(p4, p5)
expect_maps_equal(p4, p6)
### lines -----------------------------------------------------------------
polys <-
Polygons(list(
create_square(),
create_square(, 5, 5),
create_square(1, hole = TRUE),
create_square(0.4, 4.25, 4.25, hole = TRUE),
create_square(1, 5, 5, hole = TRUE)
), "A")
comment(polys) <- "0 0 1 2 2"
spolys <- SpatialPolygons(list(
polys
))
stspolys <- st_as_sf(spolys)
testthat::expect_snapshot_output(derivePolygons(spolys))
if (packageVersion("sf") >= "1.0-10") {
# Test https://github.com/rstudio/leaflet/issues/833
# Ensure that if a Polygons object is missing hole assignment info, we can
# infer it using sf v1.0-10 or above.
mp1 <- to_multipolygon(polys)
mp2 <- to_multipolygon(`comment<-`(polys, NULL))
expect_identical(
normalize_multipolygon(mp1),
normalize_multipolygon(mp2)
)
}
(l101 <- leaflet(spolys) %>% addPolygons())
(l102 <- leaflet(stspolys) %>% addPolygons())
expect_maps_equal(l101, l102)
(l103 <- leaflet(spolys) %>% addPolylines())
(l104 <- leaflet(stspolys) %>% addPolylines())
expect_maps_equal(l103, l104)
slines <- SpatialLines(list(
Lines(list(
create_square(type = Line),
create_square(, 5, 5, type = Line),
create_square(1, hole = TRUE, type = Line),
create_square(1, 5, 5, hole = TRUE, type = Line),
create_square(0.4, 4.25, 4.25, hole = TRUE, type = Line)
), "A")
))
stslines <- st_as_sf(slines)
(l105 <- leaflet(slines) %>% addPolylines())
(l106 <- leaflet(stslines) %>% addPolylines())
expect_maps_equal(l105, l106)
})
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.