forked from IMERSS/r-scrollytelling-template
-
Notifications
You must be signed in to change notification settings - Fork 3
/
utils.R
executable file
·53 lines (46 loc) · 1.46 KB
/
utils.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
library(sf)
lat_lon <- function (data) {
return (st_transform(data, "+proj=longlat +datum=WGS84"))
}
roundmulti <- function (multi, digits) {
multi <- lapply(multi, function (matrix) {
matrix <- lapply(matrix, function (coords) {
round(coords, digits)
})
})
return (st_multipolygon(multi))
}
roundpoly <- function (poly, digits) {
poly <- lapply(poly, function (matrix) {
round(matrix, digits)
})
return (st_polygon(poly))
}
round_sf <- function (fc, digits) {
# https://gis.stackexchange.com/questions/329110/removing-empty-polygon-from-sf-object-in-r
simple <- fc %>% st_simplify(preserveTopology = TRUE, dTolerance = 5) %>% dplyr::filter(!st_is_empty(.))
geom <- simple$geometry
geom <- lapply(geom, function (one) {
if (inherits(one, "MULTIPOLYGON")) {
one <- roundmulti(one, digits)
} else if (inherits(one, "POLYGON")) {
one <- roundpoly(one, digits)
} else if (inherits(one, "XY")) {
one <- round(one)
} else if (!st_is_empty(one)) {
stop(paste("I don't know what it is ", class(one)))
}
})
simple$geometry <- st_sfc(geom)
simple
}
mx_read <- function (filename, digits = 4) {
st_data <- st_read(filename, quiet=TRUE);
dropped <- st_zm(st_data, drop = T, what = "ZM")
trans <- lat_lon(dropped);
rounded <- round_sf(trans, digits);
}
# Attach the region's label as an "mx_regionId" option in the output data
labelToOption <- function (label) {
return (list(mx_regionId = label))
}