R/download_geo.R

In DEplotting: Visualization Tools for German Regional Data

#' Download Geodata 
#'
#' Downloads and unzips shapefiles from the official repository of the German Federal Agency for Cartography and Geodesy (BKG) for a specified range of years. The shapefiles are saved into a user-specific directory (\code{tools::R_user_dir("DEplotting", "data")}). Downloading these files may take some time, but it is necessary for other functions in this package to work properly. Already downloaded years are detected and not re-downloaded.
#'
#' @param start_year Integer. The starting year for downloading geodata (default is 1998).
#' @param end_year Integer. The ending year for downloading geodata (default is 2022).
#'
#' @return No return value. Side effect: downloads and unzips shapefiles, prints progress messages, and stores the data locally.
#'
#' @examples
#' \donttest{
#' download_geo(2022, 2022)
#' }
#'
#' @importFrom utils download.file unzip
#' @export
#'
#' @details Each shapefile folder for a single year is approximately 114 MB. The total download size for all 25 years can reach approximately 2.85 GB.  
#' After running \code{download_geo()} once, it is recommended to run it again to verify that all selected years were downloaded successfully. Any years that are already present will be skipped, and the function will attempt to download only the missing or previously failed ones.
#'
#' The shapefiles accessed by this function are provided by the German Federal Agency for Cartography and Geodesy (BKG). These data are licensed under the Data License Germany – attribution – Version 2.0 (dl-de/by-2-0). For more information, see \url{https://www.govdata.de/dl-de/by-2-0}.
#'
#' @seealso \code{\link{list_codes}}, \code{\link{map_plot}}, \code{\link{load_geodata}}
download_geo <- function(start_year = 1998, end_year = 2022) {
  original_timeout <- options(timeout = 1200)
  on.exit(options(original_timeout), add = TRUE)
  
  # Set safe user-specific target directory
  target_dir <- tools::R_user_dir("DEplotting", which = "data")
  if (!dir.exists(target_dir)) {
    dir.create(target_dir, recursive = TRUE, showWarnings = FALSE)
  }
  
  failed_years <- c()
  
  for (year in start_year:end_year) {
    message("Processing year: ", year)
    
    unzip_path <- file.path(target_dir, paste0("vg250_", year))
    if (dir.exists(unzip_path) && length(list.files(unzip_path)) > 0) {
      message("\u2713 Data for year ", year, " already exists. Skipping download.")
      next
    }
    
    url <- if (year %in% c(2013, 2014)) {
      sprintf("https://daten.gdz.bkg.bund.de/produkte/vg/vg250_ebenen_1231/%d/vg250_31-12.gk3.shape.ebenen.zip", year)
    } else {
      sprintf("https://daten.gdz.bkg.bund.de/produkte/vg/vg250_ebenen_1231/%d/vg250_12-31.gk3.shape.ebenen.zip", year)
    }
    
    zip_path <- file.path(target_dir, paste0("vg250_", year, ".zip"))
    attempt <- 1
    success <- FALSE
    
    while (attempt <= 3 && !success) {
      message("Attempt ", attempt, " for year: ", year)
      
      download_error <- NULL
      tryCatch({
        utils::download.file(url, zip_path, mode = "wb")
      }, error = function(e) {
        download_error <<- e$message
      })
      
      if (!is.null(download_error)) {
        message("Download error for year ", year, " on attempt ", attempt, ": ", download_error)
        attempt <- attempt + 1
        Sys.sleep(5)
        next
      }
      
      file_info <- file.info(zip_path)
      if (is.na(file_info$size) || file_info$size <= 0) {
        message("Downloaded file for year ", year, " is empty or invalid. Retrying...")
        attempt <- attempt + 1
        Sys.sleep(5)
        next
      }
      
      unzip_error <- NULL
      tryCatch({
        utils::unzip(zip_path, exdir = unzip_path)
      }, error = function(e) {
        unzip_error <<- e$message
      })
      
      if (!is.null(unzip_error)) {
        message("Unzip error for year ", year, " on attempt ", attempt, ": ", unzip_error)
        attempt <- attempt + 1
        Sys.sleep(5)
        next
      }
      
      unlink(zip_path)
      message("\u2714 Successfully processed: ", year)
      success <- TRUE
    }
    
    if (!success) {
      message("\u274C Failed to process year: ", year, " after 3 attempts.")
      failed_years <- c(failed_years, year)
    }
  }
  
  if (length(failed_years) > 0) {
    message("The following years failed to download: ", paste(failed_years, collapse = ", "))
  } else {
    message("All years processed successfully.")
  }
}