I'm working on a plotting function based on rasterVis::levelplot to which the user can pass either just a raster object, or a raster object and an sf polygon object.
The function is rather complex, but a minimum subset showing the problem reads as:
library(sf)
library(raster)
library(rasterVis)
myplot <- function(in_rast, in_poly = NULL) {
rastplot <- rasterVis::levelplot(in_rast, margin = FALSE)
polyplot <- layer(sp::sp.polygons(in_poly))
print(rastplot + polyplot)
}
The problem is that I see some strange (for me) results while testing it. Let's define some dummy data - a 1000x1000 raster and a sf POYGON oject with four polygons which split the raster -:
in_rast <- raster(matrix(nrow = 1000, ncol = 1000))
in_rast <- setValues(in_rast, seq(1:1000000))
my_poly <- structure(list(cell_id = 1:4, geometry = structure(list(structure(list(
structure(c(0, 0.5, 0.5, 0, 0, 0, 0, 0.5, 0.5, 0), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(0.5, 1, 1, 0.5, 0.5, 0, 0, 0.5, 0.5, 0), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(0, 0.5, 0.5, 0, 0, 0.5, 0.5, 1, 1, 0.5), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(0.5, 1, 1, 0.5, 0.5, 0.5, 0.5, 1, 1, 0.5), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg"))), n_empty = 0L, class = c("sfc_POLYGON",
"sfc"), precision = 0, crs = structure(list(epsg = NA_integer_,
proj4string = NA_character_), .Names = c("epsg", "proj4string"
), class = "crs"), bbox = structure(c(0, 0, 1, 1), .Names = c("xmin",
"ymin", "xmax", "ymax")))), .Names = c("cell_id", "geometry"), row.names = c(NA,
4L), class = c("sf", "data.frame"), sf_column = "geometry",
agr = structure(NA_integer_, class = "factor", .Label = c("constant",
"aggregate", "identity"), .Names = "cell_id"))
and test the function. In theory, I think this should work:
my_poly <- as(my_poly, "Spatial") # convert to spatial
myplot(in_rast, in_poly = my_poly)
but I get:
doing this:
in_poly <- my_poly
in_poly <- as(in_poly, "Spatial")
myplot(in_rast, in_poly = in_poly)
still fails, but with a different outcome:
The only way I found to have it working is to give to the polygon object the same name that I use inside the function (i.e., in_poly) from the beginning :
in_poly <- structure(list(cell_id = 1:4, geometry = structure(list(structure(list(
structure(c(0, 0.5, 0.5, 0, 0, 0, 0, 0.5, 0.5, 0), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(0.5, 1, 1, 0.5, 0.5, 0, 0, 0.5, 0.5, 0), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(0, 0.5, 0.5, 0, 0, 0.5, 0.5, 1, 1, 0.5), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(0.5, 1, 1, 0.5, 0.5, 0.5, 0.5, 1, 1, 0.5), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg"))), n_empty = 0L, class = c("sfc_POLYGON",
"sfc"), precision = 0, crs = structure(list(epsg = NA_integer_,
proj4string = NA_character_), .Names = c("epsg", "proj4string"
), class = "crs"), bbox = structure(c(0, 0, 1, 1), .Names = c("xmin",
"ymin", "xmax", "ymax")))), .Names = c("cell_id", "geometry"), row.names = c(NA,
4L), class = c("sf", "data.frame"), sf_column = "geometry",
agr = structure(NA_integer_, class = "factor", .Label = c("constant",
"aggregate", "identity"), .Names = "cell_id"))
in_poly <- as(in_poly, "Spatial")
myplot(in_rast, in_poly = in_poly)
Can anyone explain what's happening here ? It's clearly (?) a scoping problem, but I really do not understand why the function behaves like this !
Thanks in advance !
The help page of latticeExtra::layer explains that:
the evaluation used in layer is non-standard, and can be confusing at first: you typically refer to variables as if inside the panel function (x, y, etc); you can usually refer to objects which exist in the global environment (workspace), but it is safer to pass them in by name in the data argument to layer.
When using layer inside a function, you can embed your object in a list and pass it in the data argument:
myplot <- function(in_rast, in_poly = NULL) {
rastplot <- levelplot(in_rast, margin = FALSE)
polyplot <- layer(sp.polygons(x),
data = list(x = in_poly))
print(rastplot + polyplot)
}
Now the function produces the desired result:
myplot(in_rast, in_poly = my_poly)
Related
I have a list of 72 datasets loaded in the Global Environment. Each dataset contains a column called uniqueID filled with unique identifiers.
I want to merge each dataset with another dataset based on these unique identifiers (i.e. uniqueID).
I can do the following on a dataset by dataset basis:
dataset1<-merge(dataset1,tomerge,by="uniqueID",all.x=TRUE)
However as I have many datasets I would like to do this using a loop.
Here is what I have tried:
dflist<-Filter(is.data.frame, as.list(.GlobalEnv))
dflist<-function(df,x){df<-merge(df,tomerge,all.x=TRUE)}
Here is an example of dataset1 and tomerge that I am trying to merge:
dput(dataset1[1:2, ])
structure(list(id = c(1, 2), geometry = structure(list(structure(c(12.7709873378252,
-2.34780379794057), class = c("XY", "POINT", "sfg")), structure(c(13.7404727250738,
-3.08397066598979), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT",
"sfc"), precision = 0, bbox = structure(c(xmin = 12.7709873378252,
ymin = -2.08397066598979, xmax = 13.7404727250738, ymax = -1.34780379794057
), class = "bbox"), crs = structure(list(epsg = NA_integer_,
proj4string = NA_character_), class = "crs"), n_empty = 0L),
uniqueID = c("id_1_v12_3", "id_2_v13_3")), sf_column = "geometry", agr = structure(c(id = NA_integer_,
shapefile = NA_integer_), .Label = c("constant", "aggregate",
"identity"), class = "factor"), row.names = 1:2, class = c("sf",
"data.frame"))
dput(tomerge[1:2, 2:3 ])
structure(list(uniqueID = c("id_1_v12_3", "id_2_v13_2"), todigit = c("y",
"y")), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame"
)) ```
We can use lapply to loop over the list of data.frame and merge with the 'tomerge' data
dfmergelist <- lapply(dflist, function(x)
merge(x, tomerge, by = "uniqueID", all.x = TRUE))
where
dflist <- Filter(is.data.frame, mget(ls()))
I want to use data.table to join two dataframes that each have a sf geometry column, and I want to do a cross join in data.table. Reproducible data below and my code is as follows:
library(data.table)
#convert data from data frames to data table
#add the dummy key 'k' and remove it at the end
setkey(as.data.table(data1)[,c(k=1,.SD)],k)[as.data.table(data2).
[,c(k=1,.SD)],allow.cartesian=TRUE][,k:=NULL]
This gives the following result
Using data.table changes the sf geometry column. How can I use data.table while preserving the original format of the geometry column?
For instance, the orginial dataframe geometry column for data1 looks like this:
Reproducible data:
data1:
structure(list(shape = c("polygon 1", "polygon 2"), geometry = structure(list(
structure(list(structure(c(-4e-04, -4e-04, -3e-05, -3e-05,
-4e-04, 51.199, 51.1975, 51.1975, 51.199, 51.199), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg"), precision = 0, bbox = structure(c(xmin = -4e-04,
ymin = 51.1975, xmax = -3e-05, ymax = 51.199), class = "bbox"), crs = structure(list(
input = NA_character_, wkt = NA_character_), class = "crs"), n_empty = 0L),
structure(list(structure(c(5e-05, 5e-05, 0.003, 0.003, 5e-05,
51.1972, 51.1967, 51.1967, 51.1972, 51.1972), .Dim = c(5L,
2L))), class = c("XY", "POLYGON", "sfg"), precision = 0, bbox = structure(c(xmin = 5e-05,
ymin = 51.1967, xmax = 0.003, ymax = 51.1972), class = "bbox"), crs = structure(list(
input = NA_character_, wkt = NA_character_), class = "crs"), n_empty = 0L)), class =
c("sfc_POLYGON",
"sfc"), precision = 0, bbox = structure(c(xmin = -4e-04, ymin = 51.1967,
xmax = 0.003, ymax = 51.199), class = "bbox"), crs = structure(list(
input = NA_character_, wkt = NA_character_), class = "crs"), n_empty = 0L)), row.names = c(NA,
-2L), sf_column = "geometry", agr = structure(c(shape = NA_integer_), .Label = c("constant",
"aggregate", "identity"), class = "factor"), class = c("sf",
"tbl_df", "tbl", "data.frame"))
data2:
structure(list(shape = c("polygon 1", "polygon 2"), geometry = structure(list(
structure(list(structure(c(0.0095, 0.0085, 0.0075, 0.0075,
0.01055, 0.01055, 0.012, 0.0115, 0.0095, 51.21, 51.199, 51.199,
51.197, 51.196, 51.198, 51.198, 51.21, 51.21), .Dim = c(9L,
2L))), class = c("XY", "POLYGON", "sfg"), precision = 0, bbox = structure(c(xmin = 0.0075,
ymin = 51.196, xmax = 0.012, ymax = 51.21), class = "bbox"), crs = structure(list(
input = NA_character_, wkt = NA_character_), class = "crs"), n_empty = 0L),
structure(list(structure(c(0.0205, 0.019, 0.019, 0.02, 0.021,
0.0205, 51.196, 51.1955, 51.194, 51.193, 51.194, 51.196), .Dim = c(6L,
2L))), class = c("XY", "POLYGON", "sfg"), precision = 0, bbox = structure(c(xmin = 0.019,
ymin = 51.193, xmax = 0.021, ymax = 51.196), class = "bbox"), crs = structure(list(
input = NA_character_, wkt = NA_character_), class = "crs"), n_empty = 0L)), class =
c("sfc_POLYGON",
"sfc"), precision = 0, bbox = structure(c(xmin = 0.0075, ymin = 51.193,
xmax = 0.021, ymax = 51.21), class = "bbox"), crs = structure(list(
input = NA_character_, wkt = NA_character_), class = "crs"), n_empty = 0L)), row.names = c(NA,
-2L), sf_column = "geometry", agr = structure(c(shape = NA_integer_), .Label = c("constant",
"aggregate", "identity"), class = "factor"), class = c("sf",
"tbl_df", "tbl", "data.frame"))
I have a fairly simple problem where I want to create a gif which loops through departure_hour and colors the lines based on link volumes. One caveat is the number of rows between states (i.e. departure_hour) may be different.
Here is the code I am trying:
vol <- ggplot() +
geom_sf(data = test, aes(color=link_volume)) +
scale_color_distiller(palette = "OrRd", direction = 1) +
ggtitle("{frame_time}") +
transition_time(departure_hour) +
ease_aes("linear") +
enter_fade() +
exit_fade()
animate(vol, fps = 10, width = 750, height = 450)
However, when I do this I am getting the error:
Error in tween_state(as.data.frame(full_set$from), as.data.frame(full_set$to),:
identical(classes, col_classes(to)) is not TRUE
First, I do not understand if the error is referring to column classes or color classes? If it is color classes am I correct in assuming that the color scales between each plot may be different and that is the reason for this error?
Second, how do I fix this error? There seems to be just one more question on this issue and it has no solution.
Sample data:
> dput(head(test,5))
structure(list(linkid = c(12698L, 26221L, 36429L, 36430L, 47315L
), departure_hour = c(14, 19, 11, 0, 18), link_volume = c(500L,
1550L, 350L, 100L, 550L), geometry = structure(list(structure(c(1065088.71736072,
1065084.18813218, 1253892.13487564, 1253935.59094818), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1060907.62521458,
1060984.50834787, 1237578.71728528, 1237818.59111698), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1063031.34624456,
1062955.36965935, 1241210.04281066, 1241498.76584417), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1063031.34624456,
1063034.73081084, 1241210.04281066, 1241198.98905491), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1058112.52771678,
1058131.02887377, 1236388.96345761, 1236342.13157851), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg"))), class = c("sfc_LINESTRING",
"sfc"), precision = 0, bbox = structure(c(xmin = 1058112.52771678,
ymin = 1236342.13157851, xmax = 1065088.71736072, ymax = 1253935.59094818
), class = "bbox"), crs = structure(list(epsg = 5070L, proj4string = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr = structure(c(linkid = NA_integer_,
departure_hour = NA_integer_, link_volume = NA_integer_), .Label = c("constant",
"aggregate", "identity"), class = "factor"), row.names = c(NA,
5L), class = c("sf", "data.table", "data.frame"))
I'm attempting to pro-grammatically add multiple vertical polylines of specific length to contiguous polygons in R. The number and length of the polylines should be specified by the user and can range from 1 to 8 polylines and 5000 to 10000 feet long per contiguous polygons. How can I achieve this in R?
I'm able to do this manually by the use of the mapedit package for a couple of polygons but I would like to automate the process for several thousand contiguous polygons.
# Load required libraries
library(mapedit)
library(mapview)
library(dplyr)
library(sp)
# Sample polygons and polylines
geometry = structure(list(structure(list(structure(c(8.769563, 8.769563,
8.770507, 8.770507, 8.769563, 50.815273, 50.815714, 50.815714,
50.815273, 50.815273), .Dim = c(5L, 2L))), class = c("XY", "POLYGON",
"sfg")), structure(list(structure(c(8.769568, 8.769568, 8.770507,
8.770507, 8.769568, 50.814852, 50.81527, 50.81527, 50.814852,
50.814852), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.769568, 8.769568, 8.770502,
8.770502, 8.769568, 50.814412, 50.814849, 50.814849, 50.814412,
50.814412), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.769568, 8.769568, 8.770502,
8.770502, 8.769568, 50.814005, 50.814408, 50.814408, 50.814005,
50.814005), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770502, 8.770502, 8.771301,
8.771301, 8.770502, 50.815273, 50.815717, 50.815717, 50.815273,
50.815273), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770518, 8.770518, 8.771301,
8.771301, 8.770518, 50.814852, 50.81527, 50.81527, 50.814852,
50.814852), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770507, 8.770507, 8.771301,
8.771301, 8.770507, 50.814408, 50.814849, 50.814849, 50.814408,
50.814408), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(list(structure(c(8.770507, 8.770507, 8.771296,
8.771296, 8.770507, 50.814005, 50.814405, 50.814405, 50.814005,
50.814005), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg"
)), structure(c(8.769794, 8.769783, 50.814785, 50.814076), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(8.770051,
8.770035, 50.814785, 50.814069), .Dim = c(2L, 2L), class = c("XY",
"LINESTRING", "sfg")), structure(c(8.770271, 8.77026, 50.814781,
50.814076), .Dim = c(2L, 2L), class = c("XY", "LINESTRING", "sfg"
))), class = c("sfc_GEOMETRY", "sfc"), precision = 0, bbox = structure(c(xmin = 8.769563,
ymin = 50.814005, xmax = 8.771301, ymax = 50.815717), class = "bbox"), crs = structure(list(
epsg = 4326L, proj4string = "+proj=longlat +datum=WGS84 +no_defs"), class = "crs"), classes = c("POLYGON",
"POLYGON", "POLYGON", "POLYGON", "POLYGON", "POLYGON", "POLYGON",
"POLYGON", "LINESTRING", "LINESTRING", "LINESTRING"), n_empty = 0L)
# Visualize geometry
mapview(geometry)
I attempted to create regularly sampled points via the spsample function inside the polygons and connecting them by lines but was unsuccessful. appreciate any help I can get.
Here's one way to create lines given a polygon. It's probably not exactly what you want, since your request is quite specific, but hopefully the code is generic enough that you cn adapt it.
library(sf)
library(purrr)
polygon <- st_polygon(list(matrix(c(1,1,2,2,1,1,0,0,1,1), ncol = 2)))
# use polygon bounding box to o compute line parameters
bb <- st_bbox(polygon)
number_of_lines <- 5
line_length <- (bb[["ymax"]] - bb[["ymin"]]) / 1.2
y_offset <- bb[["ymin"]] + (bb[["ymax"]] - bb[["ymin"]] - line_length) / 2
# compute coordinates
xs <- seq(bb[["xmin"]], bb[["xmax"]], length.out = number_of_lines)
ys <- bb[["ymin"]] + line_length
# create a linestring
lines <- purrr::map2(xs, ys, ~st_linestring(matrix(c(.x, .x, .y,y_offset), ncol = 2))) %>% st_sfc(crs = st_crs(polygon))
# view
plot(polygon)
plot(lines, col = 2, add = TRUE)
I have a region with sub regions. For each sub region I have a simple ggplot, that I want to put into the center of each region.
I am using a leaflet package, so my code looks like this:
employees_spdf <- structure(list(ID = structure(c(7L, 8L, 4L, 3L, 10L, 1L, 9L,
6L, 2L, 5L), .Label = c("75006", "78280", "91370", "92110", "92420",
"93270", "93440", "95000", "95330", "95400"), class = "factor"),
n = c(10L, 79L, 99L, 16L, 55L, 94L, 25L, 40L, 51L, 44L),
geometry = structure(list(structure(c(2.423864, 48.95034085
), class = c("XY", "POINT", "sfg")), structure(c(2.05650642,
49.0277569), class = c("XY", "POINT", "sfg")), structure(c(2.30575224,
48.90353573), class = c("XY", "POINT", "sfg")), structure(c(2.25171264,
48.75044317), class = c("XY", "POINT", "sfg")), structure(c(2.4076232,
49.00203584), class = c("XY", "POINT", "sfg")), structure(c(2.33267081,
48.84896818), class = c("XY", "POINT", "sfg")), structure(c(2.32290084,
49.02966528), class = c("XY", "POINT", "sfg")), structure(c(2.53124065,
48.938607), class = c("XY", "POINT", "sfg")), structure(c(2.07605224,
48.77307843), class = c("XY", "POINT", "sfg")), structure(c(2.16026445,
48.84105162), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT",
"sfc"), precision = 0, bbox = structure(c(xmin = 2.05650642,
ymin = 48.75044317, xmax = 2.53124065, ymax = 49.02966528
), class = "bbox"), crs = structure(list(epsg = 4326L, proj4string = "+proj=longlat
+datum=WGS84 +no_defs"), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr
= structure(c(ID = NA_integer_,
n = NA_integer_), .Label = c("constant", "aggregate", "identity"
), class = "factor"), row.names = c(380L, 433L, 312L, 257L, 464L,
6L, 457L, 364L, 156L, 341L), class = c("sf", "data.frame"))
getImage <- function(n, ncol=10, proba = 1) {
require(ggthemes)
require(ggplot2)
require(dplyr)
num <- 1:n
x <- num%%ncol
y <- num%/%ncol
df <- data.frame(x=x,y=y)
df[nrow(df),] <- c(0,0)
df <- df %>% arrange(y,x)
df$dispo <- as.factor(c(rep(1,round(n*proba)),rep(0,(n-round(n*proba)))))
ymax <- ifelse(n>ncol*10,n/ncol+1,ncol+1)
#if we have a few points, let's center them
if (n< ncol*10) df$y <- df$y + (ncol-(max(df$y)))/2
g<- ggplot(df,aes(x=x,y=y, color=dispo))+
# geom_point(shape="\UC6C3", colour="red",size=5)+
geom_point(size=10,show.legend = F)+
xlim(-1,ncol+1) + ylim(-1,ymax)+
theme_void()+
scale_fill_manual(values = c("green", "red"))
g
}
plots <- lapply(employees_spdf$n,function(x) getImage(x,proba = .66))
for (i in 1:nrow(employees_spdf)) {
filename <- paste("./tmp/",employees_spdf[i,]$ID,".png",sep="")
ggsave(filename = filename,
plot = plots[[i]],
device = "png",
width = 5, height = 5,
units = "in", bg="transparent")}
filenames <- unlist(lapply(employees_spdf$ID, function(x) paste(paste("./tmp/",x,".png",sep=""))))
empIcons <- icons(
iconUrl = filenames,
iconWidth = 128,
iconHeight = 128
)
leaflet() %>%
addTiles() %>%
addMarkers(data=employees_spdf,
icons=empIcons)
The bottleneck here is eventually a need to save each ggplot as a file, read it and then use it as an icon. For 500+ subregions it takes quite a while to load...
The core of the issue as far as I undesrtand is that a leaflet MakeIcon function can work only whith files and I cannot pass a list of ggplot objects to it. That way it would have worked much faster I believe...
The solution here could be saving a ggplot for each region before the application loads and read them on the fly, however I thought there might be a more elegant option. Do you know one?