R/data_ghsl.R

In prio-data/priogrid: PRIO-GRID Replication Code

#' Reads the GHSL GHS Population Grid data
#'
#'
#' @return an object of class sf
#' @export
#' @references
#' \insertRef{schiavinaGHSPOPR2023AGHS2023}{priogrid}
read_ghsl_population_grid <- function(){
  zip_files <- get_pgfile(source_name = "GHSL GHS Population Grid",
                  source_version = "R2023",
                  id = "ae6a7612-4bef-452f-acd6-d2212cf9a7c5")

  # unzip(zip_files[1], list = T)

  tif_files <- basename(zip_files) |> tools::file_path_sans_ext() |> paste0(".tif")

  for(i in 1:length(zip_files)){
    if(!file.exists(file.path(dirname(zip_files[i]), tif_files[i]))){
      unzip(zip_files[i], files = tif_files[i], exdir = dirname(zip_files[i]))
    }
  }

  r <- terra::rast(file.path(dirname(zip_files[i]), tif_files[1]))
  for(i in 2:length(tif_files)){
    terra::add(r) <- terra::rast(file.path(dirname(zip_files[i]), tif_files[i]))
  }

  pgmonth <- pg_dates()[1] |> lubridate::month()
  pgday <- pg_dates()[1] |> lubridate::day()
  tif_dates <- stringr::str_extract(tif_files, seq(1975, 2030, by = 5) |> paste(collapse = "|"))
  tif_dates <- lubridate::ymd(paste(tif_dates, pgmonth, pgday, sep = "-")) |> as.character()

  names(r) <- tif_dates
  return(r)
}

#' Generate GHSL GHS Population Grid
#'
#' This aggregates the high-resolution population grid to PRIO-GRID level across all 5-year intervals (1975 - 2030).
#'
#' This does take some time.
#'
#' A slight nearest neighbor resampling was applied to get the exact PRIO-GRID extent.
#'
#' @return SpatRast
#' @export
#'
#' @examples
#' # r <- gen_ghsl_population_grid()
#' @references
#' \insertRef{schiavinaGHSPOPR2023AGHS2023}{priogrid}
gen_ghsl_population_grid <- function(){
  r <- read_ghsl_population_grid()
  res <- robust_transformation(r, agg_fun = "sum")

  #pg <- prio_blank_grid()
  #ragg <- terra::aggregate(r, terra::res(pg)/terra::res(r), fun = "sum")
  #res <- terra::resample(ragg, pg, method = "near")

  return(res)
}