Error: std::bad_alloc and projection

[GIS243]

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.