Hi
Can anyone please help me to resolve this error please
Thanks
Code
# Extract Globcover Variables
rm(list = ls())
data_dir <- "E:/Big Data Poverty Estimation/Data"
globcover_dir <- file.path(data_dir, "Globcover")
# Options:
# -- DHS
# -- DHS_nga_policy_experiment
# -- LSMS
SURVEY_NAME <- "DHS"
REPLACE_IF_EXTRACTED <-T
# Parameters -------------------------------------------------------------------
BUFFER_OSM <- 5000
BUFFER_SATELLITE <- 2500
# Load data --------------------------------------------------------------------
df <- readRDS(file.path(data_dir, SURVEY_NAME, "FinalData", "Individual Datasets", "survey_socioeconomic.Rds"))
# Delete existing files --------------------------------------------------------
if(F){
to_rm <- file.path(data_dir, SURVEY_NAME, "FinalData", "Individual Datasets",
"globcover") %>%
list.files(full.names = T)
for(to_rm_i in to_rm) file.remove(to_rm_i)
}
require(rgeos)
library(sp)
require(dplyr)
require(parallel)
# gBuffer ----------------------------------------------------------------------
geo.buffer_chunks <- function(sdf,width,chunk_size,mc.cores=1){
starts <- seq(from=1,to=nrow(sdf),by=chunk_size)
gBuffer_i <- function(start, sdf, width, chunk_size){
end <- min(start + chunk_size - 1, nrow(sdf))
sdf_buff_i <- gBuffer(sdf[start:end,],width=width, byid=T)
print(start)
return(sdf_buff_i)
}
if(mc.cores > 1){
library(parallel)
sdf_buff <- mclapply(starts, gBuffer_i, sdf, width, chunk_size, mc.cores=mc.cores) %>% do.call(what="rbind")
} else{
sdf_buff <- lapply(starts, gBuffer_i, sdf, width, chunk_size) %>% do.call(what="rbind")
}
return(sdf_buff)
}
# gDistance ----------------------------------------------------------------------
gDistance_chunks <- function(sdf1,sdf2,chunk_size,mc.cores=1){
starts <- seq(from=1,to=nrow(sdf1),by=chunk_size)
gDistance_i <- function(start, sdf1, sdf2, chunk_size){
end <- min(start + chunk_size - 1, nrow(sdf1))
distances_i <- gDistance(sdf1[start:end,],sdf2, byid=T)
print(start)
return(distances_i)
}
if(mc.cores > 1){
library(parallel)
distances <- mclapply(starts, gDistance_i, sdf1, sdf2, chunk_size, mc.cores=mc.cores) %>% unlist %>% as.numeric
} else{
distances <- lapply(starts, gDistance_i, sdf1, sdf2, chunk_size) %>% unlist %>% as.numeric
}
return(distances)
}
# over ----------------------------------------------------------------------
over_sum_chunks <- function(sdf1,sdf2,chunk_size,mc.cores=1){
starts <- seq(from=1,to=nrow(sdf1),by=chunk_size)
over_i <- function(start, sdf1, sdf2, chunk_size){
end <- min(start + chunk_size - 1, nrow(sdf1))
df_i <- sp::over(sdf1[start:end,], police_df, fn=sum)
print(start)
return(df_i)
}
if(mc.cores > 1){
library(parallel)
df <- pbmclapply(starts, over_i, sdf1, sdf2, chunk_size, mc.cores=mc.cores) %>% bind_rows
} else{
df <- lapply(starts, over_i, sdf1, sdf2, chunk_size) %>% bind_rows
}
return(df)
}
# Function to Extract Globcover ------------------------------------------------
#country_code_i <- "IA"
#buffer_m <- 5000
extract_globcover <- function(df_country,
year_i,
buffer_m){
## Project, buffer, then back to WGS
# Go back to WGS so don't have to project larger raster
coordinates(df_country) <- ~longitude+latitude
crs(df_country) <- CRS("+init=epsg:4326")
df_country <- geo.buffer_chunks(df_country, width = buffer_m, chunk_size = 100)
## Load globcover
if(year_i < 1992) year_i <- 1992
if(year_i > 2018) year_i <- 2018
if(year_i <= 2015){
gc <- raster(file.path(globcover_dir, "RawData", "1992_2015_data", paste0("ESACCI-LC-L4-LCCS-Map-300m-P1Y-",year_i , "-v2.0.7cds.tif")))
} else{
gc <- raster(file.path(globcover_dir, "RawData", "2016_2018_data", paste0("C3S-LC-L4-LCCS-Map-300m-P1Y-",year_i,"-v2.1.1.tif")))
}
## Crop globcover
gc_crop <- crop(gc, bbox(df_country))
for(gc_id_i in c(10, 11, 12,
20,
30,
40,
50,
60, 61, 62,
70, 71, 72,
80, 81, 82,
90,
100,
110,
120, 121, 122,
130,
140,
150, 151, 152, 153,
160,
170,
180,
190,
200,
201,
202,
210,
220)){
print(gc_id_i)
gc_crop_i <- gc_crop
gc_crop_i[] <- as.numeric(gc_crop_i[] == gc_id_i)
df_country[[paste0("gc_", gc_id_i)]] <- exact_extract(gc_crop_i,
df_country,
"mean")
}
df_out <- df_country@data %>%
dplyr::select(uid, year, contains("gc_"))
return(df_out)
}
# Implement Function and Export ------------------------------------------------
for(buffer_i in BUFFER_SATELLITE){
for(country_i in unique(df$country_code)){
df_country <- df[df$country_code %in% country_i,]
for(year_i in unique(df_country$year)){
print(paste0(country_i, " - ", buffer_i, " - ", year_i))
OUT_PATH <- file.path(data_dir, SURVEY_NAME, "FinalData", "Individual Datasets",
"globcover",
paste0("gc_", country_i, "_", buffer_i, "m_",year_i,".Rds"))
if(REPLACE_IF_EXTRACTED | !file.exists(OUT_PATH)){
df_glob_i <- extract_globcover(df_country[df_country$year %in% year_i,],
year_i,
buffer_i)
saveRDS(df_glob_i, OUT_PATH)
}
}
}
}
Getting the following Error please
Error: std::bad_alloc
In addition: Warning messages:
1: In gBuffer(sdf[start:end, ], width = width, byid = T) :
Spatial object is not projected; GEOS expects planar coordinates
2: Setting row names on a tibble is deprecated.
3: In gBuffer(sdf[start:end, ], width = width, byid = T) :
Spatial object is not projected; GEOS expects planar coordinates
4: Setting row names on a tibble is deprecated.