R 从光栅文件中提取数据以与shp文件匹配
更新:R 从光栅文件中提取数据以与shp文件匹配,r,grid,gis,geo,R,Grid,Gis,Geo,更新: 更新:问题是我生成网格单元的方法导致了我的shapefile的错误投影,这导致了上述错误。我能够制作出另一种形式的网格单元,它与我的投影完美配合 在我成功为世界地图()创建光栅栅格之后 我现在尝试使用海德数据()将其与每个细胞的人口信息合并 我下载了bayseline hyde数据,并试图通过如下提取函数将我生成的网格应用于人口数据: ## use extract function for nightlights shape <- rgdal::readOGR("dat
更新:问题是我生成网格单元的方法导致了我的shapefile的错误投影,这导致了上述错误。我能够制作出另一种形式的网格单元,它与我的投影完美配合 在我成功为世界地图()创建光栅栅格之后 我现在尝试使用海德数据()将其与每个细胞的人口信息合并 我下载了bayseline hyde数据,并试图通过如下提取函数将我生成的网格应用于人口数据:
## use extract function for nightlights
shape <- rgdal::readOGR("data/grid/grid.shp")
source("scripts/extractfunction_hyde.R")
extract_hyde(directory = "data/hyde/hyde_harmonized", shape)
extract_hyde <- function(directory = ".", shp,
years = NULL) {
require(raster)
require(velox)
#sname <- shpname
#shpname <- paste0("data/FDI/", shpname)
#shp <- readRDS(shpname)
if (!class(shp) %in% c("SpatialPolygons", "SpatialPolygonsDataFrame",
"SpatialPointsDataFrame")) {
stop(paste("'shp' must be either a SpatialPolygons",
"SpatialPolygonsDataFrame or SpatialPointsDataFrame"))
}
crs <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
shp <- sp::spTransform(shp, sp::CRS(crs))
orig.dir <- getwd()
setwd(directory)
files <- list.files(pattern = "*.asc$")
# Years in which this population data are available:
all.years <- as.numeric(substr(files, 6, 9)) # The year is characters 4 to 9
# Need to average the years where there are two satellite readings:
double.years <- all.years[duplicated(all.years)]
# If years aren't provided, take all of them:
if (is.null(years)) {
years <- sort(unique(all.years))
}
# Start the output data.frame:
if (class(shp) == "SpatialPolygons") {
df <- data.frame(id = 1:length(shp@polygons))
} else if (class(shp) == "SpatialPolygonsDataFrame") {
df <- data.frame(shp@data)
} else if (class(shp) == "SpatialPointsDataFrame") {
df <- data.frame(shp@data)
}
for (i in seq_along(years)) {
cat("Extracting data for year ", years[i], "...", sep = "")
# If there are two satellite readings in a year, average them first:
if (years[i] %in% double.years) {
both.files <- grep(years[i], files, value = TRUE)
r <- crop(raster(both.files[1]), shp, snap = "out")
r2 <- crop(raster(both.files[2]), shp, snap = "out")
values(r) <- (values(r) + values(r2)) / 2
rm(r2)
r <- velox(r)
# With only one reading in a year, just read in the file normally:
} else {
r <- crop(raster(grep(years[i], files, value = TRUE)), shp, snap = "out")
r <- velox(r)
}
extract <- r$extract(sp=shp, fun = function(x) mean(x, na.rm = TRUE))
df[[paste0("pop_mean", years[i])]] <- c(extract)
extract <- r$extract(sp=shp, fun = function(x) sum(x, na.rm = TRUE))
df[[paste0("pop_sum", years[i])]] <- c(extract)
cat("Done\n")
}
saveRDS(df, "data/hyde/hyde_grid.Rds")
}
该函数适用于我使用过的所有其他形状文件。例如,我在另一篇stackoverflow文章中使用了第二个选项,这非常有效
我研究过,有时当有不同的投影时,这个问题会引起注意。但是我的函数会调整海德文件和形状文件的投影
我假设我收到此错误是因为shp文件没有正确生成?请提供一个最小的(且自包含且可复制的)示例。很难想到一个可复制的示例,因为您需要此形状文件和任何类型的tif/asc光栅文件(在我的案例中为海德)。我尝试添加更多信息,以便更容易复制!是的,这可能会很困难,但tou至少可以简化您的示例,几乎所有的示例都与手头的问题无关。更新:问题是我生成网格单元的方法导致了形状文件的错误投影,从而导致了上述错误。我能够制作出另一种形式的网格单元,它与我的投影完美配合。
## use extract function for nightlights
shape <- rgdal::readOGR("data/grid/grid.shp")
source("scripts/extractfunction_hyde.R")
extract_hyde(directory = "data/hyde/hyde_harmonized", shape)
extract_hyde <- function(directory = ".", shp,
years = NULL) {
require(raster)
require(velox)
#sname <- shpname
#shpname <- paste0("data/FDI/", shpname)
#shp <- readRDS(shpname)
if (!class(shp) %in% c("SpatialPolygons", "SpatialPolygonsDataFrame",
"SpatialPointsDataFrame")) {
stop(paste("'shp' must be either a SpatialPolygons",
"SpatialPolygonsDataFrame or SpatialPointsDataFrame"))
}
crs <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
shp <- sp::spTransform(shp, sp::CRS(crs))
orig.dir <- getwd()
setwd(directory)
files <- list.files(pattern = "*.asc$")
# Years in which this population data are available:
all.years <- as.numeric(substr(files, 6, 9)) # The year is characters 4 to 9
# Need to average the years where there are two satellite readings:
double.years <- all.years[duplicated(all.years)]
# If years aren't provided, take all of them:
if (is.null(years)) {
years <- sort(unique(all.years))
}
# Start the output data.frame:
if (class(shp) == "SpatialPolygons") {
df <- data.frame(id = 1:length(shp@polygons))
} else if (class(shp) == "SpatialPolygonsDataFrame") {
df <- data.frame(shp@data)
} else if (class(shp) == "SpatialPointsDataFrame") {
df <- data.frame(shp@data)
}
for (i in seq_along(years)) {
cat("Extracting data for year ", years[i], "...", sep = "")
# If there are two satellite readings in a year, average them first:
if (years[i] %in% double.years) {
both.files <- grep(years[i], files, value = TRUE)
r <- crop(raster(both.files[1]), shp, snap = "out")
r2 <- crop(raster(both.files[2]), shp, snap = "out")
values(r) <- (values(r) + values(r2)) / 2
rm(r2)
r <- velox(r)
# With only one reading in a year, just read in the file normally:
} else {
r <- crop(raster(grep(years[i], files, value = TRUE)), shp, snap = "out")
r <- velox(r)
}
extract <- r$extract(sp=shp, fun = function(x) mean(x, na.rm = TRUE))
df[[paste0("pop_mean", years[i])]] <- c(extract)
extract <- r$extract(sp=shp, fun = function(x) sum(x, na.rm = TRUE))
df[[paste0("pop_sum", years[i])]] <- c(extract)
cat("Done\n")
}
saveRDS(df, "data/hyde/hyde_grid.Rds")
}
[,1] [,2] [,3] [,4]
[1,] -9070131 -8626996 Inf Inf
[2,] -9080131 -8626996 Inf Inf
Error in .spTransform_Polygon(input[[i]], to_args = to_args, from_args = from_args, :failure in Polygons 1584553 Polygon 1 points 3:4