diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e683f189..7444810d 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -22,9 +22,9 @@ jobs: fail-fast: false matrix: config: - - {os: macOS-latest, r: 'release'} - - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - - {os: windows-latest, r: 'devel'} + - {os: macOS-latest, r: 'release'} + - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: windows-latest, r: 'devel'} - {os: windows-latest, r: 'oldrel'} - {os: windows-latest, r: 'release'} @@ -35,18 +35,23 @@ jobs: steps: - uses: actions/checkout@v2 - - - uses: r-lib/actions/setup-r@master + + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} - - - uses: r-lib/actions/setup-pandoc@master - - - name: Install spatial dependencies - if: runner.os != 'Windows' + + - uses: r-lib/actions/setup-pandoc@v2 + + - name: Install spatial dependencies on macOS + if: runner.os == 'macOS' run: | brew install gdal proj - + + - name: Install spatial dependencies on Linux + if: runner.os == 'Linux' + run: | + sudo apt-get install gdal-bin + - name: Query dependencies run: | install.packages('remotes') @@ -55,7 +60,7 @@ jobs: - name: Cache R packages if: runner.os != 'Windows' - uses: actions/cache@v1 + uses: actions/cache@v3 with: path: ${{ env.R_LIBS_USER }} key: ${{ runner.os }}-r-${{ matrix.config.r }}-3-${{ hashFiles('depends.Rds') }} @@ -81,7 +86,7 @@ jobs: - name: Upload check results if: failure() - uses: actions/upload-artifact@master + uses: actions/upload-artifact@v3 with: name: ${{ runner.os }}-r${{ matrix.config.r }}-results path: check diff --git a/.github/workflows/R-CMD-check2.yaml b/.github/workflows/R-CMD-check2.yaml index a6f6d040..2af21bcd 100644 --- a/.github/workflows/R-CMD-check2.yaml +++ b/.github/workflows/R-CMD-check2.yaml @@ -29,16 +29,16 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v1 + - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: rcmdcheck - - uses: r-lib/actions/check-r-package@v1 + - uses: r-lib/actions/check-r-package@v2 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 62e978e1..9b266f10 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -15,13 +15,13 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/setup-r@master + - uses: r-lib/actions/setup-r@v2 + + - uses: r-lib/actions/setup-pandoc@v2 - - uses: r-lib/actions/setup-pandoc@master - - name: Install spatial dependencies run: | - rm '/usr/local/bin/gfortran' + #rm '/usr/local/bin/gfortran' brew install gdal proj - name: Query dependencies diff --git a/.github/workflows/pr-commands.yaml b/.github/workflows/pr-commands.yaml index 0d3cb716..cfda2fbd 100644 --- a/.github/workflows/pr-commands.yaml +++ b/.github/workflows/pr-commands.yaml @@ -11,10 +11,10 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/pr-fetch@master + - uses: r-lib/actions/pr-fetch@v2 with: repo-token: ${{ secrets.GITHUB_TOKEN }} - - uses: r-lib/actions/setup-r@master + - uses: r-lib/actions/setup-r@v2 - name: Install dependencies run: Rscript -e 'install.packages(c("remotes", "roxygen2"))' -e 'remotes::install_deps(dependencies = TRUE)' - name: Document @@ -23,7 +23,7 @@ jobs: run: | git add man/\* NAMESPACE git commit -m 'Document' - - uses: r-lib/actions/pr-push@master + - uses: r-lib/actions/pr-push@v2 with: repo-token: ${{ secrets.GITHUB_TOKEN }} style: @@ -34,10 +34,10 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/pr-fetch@master + - uses: r-lib/actions/pr-fetch@v2 with: repo-token: ${{ secrets.GITHUB_TOKEN }} - - uses: r-lib/actions/setup-r@master + - uses: r-lib/actions/setup-r@v2 - name: Install dependencies run: Rscript -e 'install.packages("styler")' - name: Style @@ -46,6 +46,6 @@ jobs: run: | git add \*.R git commit -m 'Style' - - uses: r-lib/actions/pr-push@master + - uses: r-lib/actions/pr-push@v2 with: repo-token: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 4efc7ab7..96c75d77 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -18,9 +18,9 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/setup-r@master + - uses: r-lib/actions/setup-r@v2 - - uses: r-lib/actions/setup-pandoc@master + - uses: r-lib/actions/setup-pandoc@v2 - name: Query dependencies run: | @@ -30,7 +30,7 @@ jobs: shell: Rscript {0} - name: Cache R packages - uses: actions/cache@v1 + uses: actions/cache@v3 with: path: ${{ env.R_LIBS_USER }} key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} diff --git a/DESCRIPTION b/DESCRIPTION index cdfec205..7493329e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: kwb.dwd Title: Access Information from Deutscher Wetterdienst (DWD) -Version: 0.2.0 +Version: 0.3.0 Authors@R: c(person(given = "Hauke", family = "Sonnenberg", @@ -32,7 +32,7 @@ License: MIT + file LICENSE URL: https://github.com/KWB-R/kwb.dwd BugReports: https://github.com/KWB-R/kwb.dwd/issues Depends: - R (>= 3.0) + R (>= 3.5.0) Imports: archive, bitops (>= 1.0.6), @@ -55,7 +55,11 @@ VignetteBuilder: knitr Remotes: github::kwb-r/kwb.utils +Additional_repositories: + https://packagemanager.posit.co/cran/2023-09-20/ Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.1 +LazyDataCompression: bzip2 +RoxygenNote: 7.2.3 +Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 9a314762..c836774a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,11 @@ # Generated by roxygen2: do not edit by hand export(calculate_masked_grid_stats) -export(check_or_download_shapes_germany) export(convert_bin_to_raster_file) export(coordinates_to_EPSG_4326) export(crop_radolan_radial) export(download_radolan) +export(download_shapes_germany) export(extract_radolan_zip_files) export(get_berlin_dwd_mask) export(get_dwd_urls_metadata) @@ -14,6 +14,7 @@ export(get_radolan_extension) export(get_radolan_projection_string) export(get_radolan_urls) export(get_shapes_of_germany) +export(list_extracted_radolan_files) export(list_url) export(load_potential_evaporation_berlin) export(load_potential_evaporation_berlin_2) @@ -23,8 +24,10 @@ export(radolan_raw_to_raster) export(read_asc_gz_file) export(read_binary_radolan_file) export(read_daily_data_over_shape) +export(read_data_over_shape) export(read_monthly_data_over_shape) export(read_relevant_years_radolan) +export(temp_dir) export(unzip_asc_gz_file) export(write_raster_to_file) importFrom(RCurl,curlOptions) @@ -39,9 +42,11 @@ importFrom(kwb.utils,callWith) importFrom(kwb.utils,catAndRun) importFrom(kwb.utils,catIf) importFrom(kwb.utils,clearConsole) +importFrom(kwb.utils,commonNames) importFrom(kwb.utils,createDirectory) importFrom(kwb.utils,expandGrid) importFrom(kwb.utils,extractSubstring) +importFrom(kwb.utils,fileExtension) importFrom(kwb.utils,getAttribute) importFrom(kwb.utils,left) importFrom(kwb.utils,listToDepth) @@ -51,6 +56,7 @@ importFrom(kwb.utils,pasteColumns) importFrom(kwb.utils,removeColumns) importFrom(kwb.utils,removeExtension) importFrom(kwb.utils,replaceFileExtension) +importFrom(kwb.utils,resetRowNames) importFrom(kwb.utils,resolve) importFrom(kwb.utils,right) importFrom(kwb.utils,safePath) @@ -65,6 +71,7 @@ importFrom(lubridate,month) importFrom(lubridate,rollback) importFrom(lubridate,ymd) importFrom(magrittr,"%>%") +importFrom(raster,`crs<-`) importFrom(raster,cellStats) importFrom(raster,crop) importFrom(raster,extent) @@ -73,9 +80,12 @@ importFrom(raster,raster) importFrom(raster,stack) importFrom(raster,writeRaster) importFrom(rgdal,readOGR) +importFrom(sf,as_Spatial) importFrom(sf,st_as_sf) importFrom(sf,st_buffer) +importFrom(sf,st_read) importFrom(sf,st_transform) +importFrom(sf,st_zm) importFrom(sp,CRS) importFrom(stats,sd) importFrom(stats,setNames) diff --git a/NEWS.md b/NEWS.md index ea777e40..2ff2bad0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,106 @@ +# kwb.dwd 0.3.0 (2023-05-23) + +* update/improve/fix GitHub actions workflow files +* depend on R >= 3.5.0 (Required by R CMD check) +* use Markdown syntax in roxygen comments +* update dataset `dwd_files` +* add new datasets + - `shapes_germany_0`, + - `shapes_germany_1`, + - `shapes_germany_2` +* add new functions (exported) + - `list_extracted_radolan_files` +* export functions that were private before + - `temp_dir` +* add new functions (not exported) + - `assert_all_ending_with` + - `check_binary_radolan_files` + - `configure_radolan` + - `consider_flags` + - `contains_file` + - `copy_file` + - `download_and_extract_radolan` + - `download_and_extract_radolan_url` + - `download_dir` + - `download_into_folder_structure` + - `ftp_path_radolan` + - `ftp_path_radolan_all` + - `get_full_extension` + - `get_radolan_format_description` + - `get_radolan_header_patterns` + - `get_radolan_metadata` + - `get_radolan_metadata_from_header` + - `get_radolan_timestamps` + - `get_radolan_timestamps_from_filenames` + - `get_radolan_timestamps_from_headers` + - `get_regional_stats_from_radolan_asc_files` + - `get_regional_stats_from_radolan_bin_files` + - `get_regional_stats_from_radolan_files` + - `get_relative_path` + - `list_grids_germany` + - `month_range_pattern` + - `on_windows` + - `open_for_reading_in_binary_mode` + - `read_asc_file` + - `read_hourly_radolan_historical_bin_for_region` + - `remove_left` + - `remove_protocol` + - `remove_right` + - `split_radolan_header` + - `unzip_tar_file` + - `unzip_tar_gz_file` + - `unzip_zip_file` + - `url_to_relative_path` +* modify functions + - `check_or_download_shapes_germany`: add arguments "url", "timeout", report + about "timeout" error, rename to `download_shapes_germany` + - `default_projection_file`: add argument "quiet" + - `download_if_not_there`: add arguments "target_dir", "mode", "timeout", + rename to `download` + - `extract_radolan_zip_files`: refactor + - `filter_shapes`: use accessor function, check that one row is selected + - `get_berlin_dwd_mask`: simplify + - `get_shapes_of_germany`: add argument "use_sf", return shapes that are + provided as datasets in the package + - `last_month_as_yyyymm`: rename to "last_month", add argument "format" + - `list_zip_files`: refactor + - `month_sequence`: add argument "simple" + - `provide_projection_file`: refactor + - `raster_stats`: use raster`::getValues + - `read_binary_radolan_file`: add argument "consider_flags" + - `read_binary_radolan_header`: add argument "dbg" + - `read_monthly_data_over_shape`: add argument "quiet", "shape", "use_sf" + - `read_shape_file`: merge two functions (function was defined twice!) + - `select_shapes`: improve output + - `temp_dir`: rename arguments (remove dot) and export + - `transform_coords`: ? +* remove functions + - `assert_ending_gz` (use `assert_all_ending_with`) + - `extract_metadata_from_files_daily` (use `extract_metadata_from_files`) + - `extract_metadata_from_files_monthly` (use `extract_metadata_from_files`) + - `extract_yyyymm` (integrated where it was used) + - `filter_by_extension_asc_gz` (use `filter_by_extension`) + - `filter_by_extension_tgz` (use `filter_by_extension`) + - `frequency_prefix` (integrated where it was used) + - `ftp_path_daily_grids` (use `ftp_path_grids_germany`) + - `ftp_path_monthly_grids` (use `ftp_path_grids_germany`) + - `list_daily_grids_germany_tgz` (use `list_grids_germany`) + - `list_monthly_grids_germany_asc_gz` (use `list_grids_germany`) + - `main_columns_first` (integrated where it was used) + - `month_sequence_simple` (use `month_sequence_simple`) + - `url_projection` + +# kwb.dwd 0.2.1 (2024-04-08) + +* Install `rgdal` dependency from CRAN`s GitHub account (as it has been archived +since 2023-10-16, see [here](https://cran.r-project.org/web/packages/rgdal/index.html)). + # kwb.dwd 0.2.0 (2022-09-20) * add contributors Michael Rustler, Lukas Guericke * use GitHub actions instead of Travis and Appveyor * add tests -* update dataset [dwd_files](../reference/dwd_files.html) +* update dataset `dwd_files` * modify functions - `get_radolan_url()`: add arg "ftp_root" - `get_radolan_urls()`: add args "..." diff --git a/R/check_or_download_shapes_germany.R b/R/check_or_download_shapes_germany.R deleted file mode 100644 index 7ad0588c..00000000 --- a/R/check_or_download_shapes_germany.R +++ /dev/null @@ -1,37 +0,0 @@ -# check_or_download_shapes_germany --------------------------------------------- - -#' Check Local Availability or Download Shape Files -#' -#' This function checks if shape files for Germany are available in the folder -#' `\%TEMP\%/R_kwb.dwd/gadm40_DEU_shp`. If not, the shape files are downloaded -#' from \url{https://gadm.org} (URL to zip-file: -#' \url{https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip}) -#' and unpacked into that folder. -#' -#' @param quiet passed if \code{TRUE} status messages are suppressed -#' @return path to folder containing shape files -#' @export -#' @importFrom archive archive_extract -#' @importFrom kwb.utils createDirectory removeExtension -check_or_download_shapes_germany <- function(quiet = FALSE) -{ - url <- "https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip" - - # Path to sub folder below %TEMP% containing shape files for Germany - shape_dir <- temp_dir(template. = url) - - # If the shape directory contains at least one .shp file, return the path to - # the directory - if (length(dir(shape_dir, "\\.shp$")) > 0L) { - return(shape_dir) - } - - # If does not contain .shp files, download the zip-archive from - # and extract it into - file <- download_if_not_there(url, quiet = quiet) - - # Extract the archive file into the shape directory - archive::archive_extract(file, dir = shape_dir) - - shape_dir -} diff --git a/R/configure_radolan.R b/R/configure_radolan.R new file mode 100644 index 00000000..3a909983 --- /dev/null +++ b/R/configure_radolan.R @@ -0,0 +1,38 @@ +# configure_radolan ------------------------------------------------------------ +configure_radolan <- function( + from = NULL, + to = NULL, + resolution, + format, + year = NULL, + config = NULL +) +{ + if (!is.null(config)) { + stopifnot(inherits(config, "radolan_configuration")) + return(config) + } + + safe_element(resolution, c("hourly", "daily")) + safe_element(format, c("bin", "asc")) + + if (is.null(year)) { + stopifnot(!is.null(from), !is.null(to)) + } else { + stopifnot(is.integer(year), length(year) > 0L) + } + + year_month <- function(year, month) sprintf("%4d%02d", year, month) + + from <- kwb.utils::defaultIfNULL(from, year_month(year[1L], 1L)) + to <- kwb.utils::defaultIfNULL(to, year_month(year[length(year)], 12L)) + + structure(class = "radolan_configuration", list( + method = "radolan", + variable = "precipitation", + from = from, + to = to, + resolution = resolution, + format = format + )) +} diff --git a/R/convert_bin_to_raster_file.R b/R/convert_bin_to_raster_file.R index db9a7325..fa5ac4ba 100644 --- a/R/convert_bin_to_raster_file.R +++ b/R/convert_bin_to_raster_file.R @@ -5,10 +5,12 @@ #' @param bin_file path to binary radolan file or vector of such paths #' @param target_dir directory in which to create the raster file(s). By default #' the files are created in a subfolder "rst" parallel to the folder in which -#' the first element of \code{bin_file} resides. -#' @param dbg if \code{TRUE}, debug messages are shown +#' the first element of `bin_file` resides. +#' @param dbg if `TRUE`, debug messages are shown #' @export #' @importFrom kwb.utils createDirectory +#' @seealso +#' * [write_raster_to_file]. convert_bin_to_raster_file <- function(bin_file, target_dir = NULL, dbg = TRUE) { stopifnot(is.character(bin_file)) @@ -60,6 +62,8 @@ convert_bin_to_raster_file <- function(bin_file, target_dir = NULL, dbg = TRUE) #' @export #' #' @importFrom raster writeRaster +#' @seealso +#' * [convert_bin_to_raster_file]. write_raster_to_file <- function(rb, file, dbg = TRUE) { kwb.utils::catAndRun( diff --git a/R/crop_radolan_radial.R b/R/crop_radolan_radial.R index 0ba02300..140cf91f 100644 --- a/R/crop_radolan_radial.R +++ b/R/crop_radolan_radial.R @@ -2,18 +2,22 @@ #' Crop Radolan Data #' -#' @param radolan radolan data as returned by -#' \code{\link{read_relevant_years_radolan}} +#' @param radolan radolan data as returned by [read_relevant_years_radolan] #' @param longitude longitude #' @param latitude latitude #' @param radius distance from point (latitude/longitude) in km -#' @param as_data_frame if \code{TRUE}, a data frame with columns -#' \code{SAMPLE_DATE} and \code{rain_mean} is returned, otherwise the raster -#' object returned by \code{\link[raster]{crop}} +#' @param as_data_frame if `TRUE`, a data frame with columns +#' `SAMPLE_DATE` and `rain_mean` is returned, otherwise the raster +#' object returned by [raster::crop] #' @export #' @importFrom sf st_buffer st_transform #' @importFrom raster cellStats crop #' @importFrom lubridate ymd +#' @seealso +#' * [get_radolan_urls], +#' * [extract_radolan_zip_files], +#' * [radolan_raw_to_raster], +#' * [download_radolan]. crop_radolan_radial <- function( radolan, longitude, latitude, radius = 10, as_data_frame = TRUE ) diff --git a/R/datasets.R b/R/datasets.R index b087209d..217211bc 100644 --- a/R/datasets.R +++ b/R/datasets.R @@ -1,12 +1,12 @@ #' Files Available on DWD's FTP Server #' #' Information on files that are available for download at -#' \url{ftp://opendata.dwd.de/climate_environment/CDC/} [base_url]. The -#' information were last updated on 2022-09-17. +#' \[base_url\]. The +#' information were last updated on 2023-04-26. #' -#' @format A data frame with 784332 observations of 8 variables: +#' @format A data frame with 838345 observations of 8 variables: #' \describe{ -#' \item{file}{path to the file below [base_url]} +#' \item{file}{path to the file below \[base_ur\]} #' \item{isdir}{TRUE for a directory, FALSE for a file} #' \item{size}{file size in bytes} #' \item{permissions}{string indicating file permissions} @@ -15,5 +15,57 @@ #' \item{group}{further column provided by the FTP server} #' \item{links}{further column provided by the FTP server} #' } -#' @source \url{ftp://opendata.dwd.de/climate_environment/CDC/Announce_log_CDC_ftp.txt} +#' @source "dwd_files" + +#' Shapes of German Regions (0) +#' +#' Object of class "sf" representing a "Simple feature collection". +#' +#' @format Simple feature collection with 1 feature and 2 fields: +#' * `COUNTRY`, +#' * `ID_0`. +#' @source +#' +"shapes_germany_0" + +#' Shapes of German Regions (1) +#' +#' Object of class "sf" representing a "Simple feature collection". +#' +#' @format Simple feature collection with 16 features and 11 fields: +#' * `ID_0`, +#' * `COUNTRY`, +#' * `ID_1`, +#' * `NAME_1`, +#' * `VARNAME_1`, +#' * `NL_NAME_1`, +#' * `TYPE_1`, +#' * `ENGTYPE_1`, +#' * `CC_1`, +#' * `HASC_1`, +#' * `ISO_1`. +#' @source +#' +"shapes_germany_1" + +#' Shapes of German Regions (2) +#' +#' Object of class "sf" representing a "Simple feature collection". +#' +#' @format Simple feature collection with 403 features and 12 fields: +#' * `ID_0`, +#' * `COUNTRY`, +#' * `NAME_1`, +#' * `NL_NAME_1`, +#' * `ID_2`, +#' * `NAME_2`, +#' * `VARNAME_2`, +#' * `NL_NAME_2`, +#' * `TYPE_2`, +#' * `ENGTYPE_2`, +#' * `CC_2`, +#' * `HASC_2`. +#' @source +#' +"shapes_germany_2" diff --git a/R/download_and_extract_radolan.R b/R/download_and_extract_radolan.R new file mode 100644 index 00000000..02b75baf --- /dev/null +++ b/R/download_and_extract_radolan.R @@ -0,0 +1,120 @@ +# download_and_extract_radolan ------------------------------------------------- +# TODO: compare with download_radolan() +download_and_extract_radolan <- function( + from = NULL, + to = NULL, + resolution, + format, + year = NULL, + config = NULL, + ... +) +{ + #kwb.utils::assignPackageObjects("kwb.dwd") + + # Create a configuration from the arguments, if required + config <- configure_radolan( + from = from, + to = to, + resolution = resolution, + format = format, + year = year, + config = config + ) + + # Now, take the argument values from the configuration + as_configured <- kwb.utils::createAccessor(config) + + from <- as_configured("from") + to <- as_configured("to") + resolution <- as_configured("resolution") + format <- as_configured("format") + + # Pattern to filter for files related to months between from and to + pattern <- sprintf("[^0-9](%s)[.]tar", month_range_pattern(from, to)) + + urls <- kwb.utils::catAndRun( + "Listing available files and filtering for related months", + expr = { + "grids_germany/%s/radolan/historical/%s" %>% + sprintf(resolution, format) %>% + ftp_path_cdc() %>% + list_url(recursive = TRUE, full_names = TRUE, dbg = FALSE) %>% + grep(pattern = pattern, value = TRUE) + # filter_by_month_range(from, to) # TODO: combine both approaches + } + ) + + # Download and extract the files + files <- unlist(lapply( + X = urls, + FUN = download_and_extract_radolan_url, + target_dir = download_dir("dwd"), + ... + )) + + structure( + files, + config = config, + urls = urls + ) +} + +# download_and_extract_radolan_url --------------------------------------------- +# TODO: compare with download_radolan() +download_and_extract_radolan_url <- function( + url, target_dir = download_dir("dwd"), timeout = 120 +) +{ + #kwb.utils::assignPackageObjects("kwb.dwd") + #url <- "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/hourly/radolan/historical/bin/2009/RW200901.tar.gz" + #url <- "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/daily/radolan/historical/bin/2006/SF-200610.tar.gz" + #url <- urls[1L] + + assert_url(url) + + info <- get_radolan_metadata(url) + + resolution <- info$resolution + format <- info$format + + safe_element(resolution, c("daily", "hourly")) + safe_element(format, c("asc", "bin")) + + file <- download_into_folder_structure( + url, + target_dir = target_dir, + skip_url_segments = 3L, + mode = "wb", + timeout = timeout + ) + + full_extension <- get_full_extension(url) + + # Extract the files and return their paths + unzip_dir <- get_relative_path(file) %>% + remove_right(nchar(full_extension) + 1L) %>% + temp_dir() + + if (full_extension == "tar.gz") { + + extracted_files <- unzip_tar_gz_file(file, target_dir = unzip_dir) + + } else if (full_extension == "tar") { + + tar_gz_files <- unzip_tar_file(file, target_dir = unzip_dir) + + extracted_files <- try(unlist(lapply( + tar_gz_files, + unzip_tar_gz_file, + target_dir = dirname(tar_gz_files[1L]) + ))) + + # On success, delete the .tar.gz files that have been extracted + if (!kwb.utils::isTryError(extracted_files)) { + unlink(tar_gz_files) + } + } + + extracted_files +} diff --git a/R/download_daily_grids_germany.R b/R/download_daily_grids_germany.R index 1dec54d5..d54e2762 100644 --- a/R/download_daily_grids_germany.R +++ b/R/download_daily_grids_germany.R @@ -2,53 +2,28 @@ download_daily_grids_germany <- function( variable, from = to, - to = last_month_as_yyyymm(), + to = last_month(), quiet = FALSE ) { - variable %>% - list_daily_grids_germany_tgz(from, to) %>% + list_grids_germany("daily", ".tgz", variable, from, to) %>% lapply(download_and_extract, quiet = quiet) %>% unlist() } -# list_daily_grids_germany_tgz ------------------------------------------------- -list_daily_grids_germany_tgz <- function(variable, from = NULL, to = NULL) -{ - # Base URL to daily grids - base_url <- ftp_path_daily_grids() - - # Code to get the possible choices - # base_url <- kwb.dwd:::ftp_path_cdc("grids_germany/daily") - # kwb.dwd:::url_subdirs_containing_files_with_extension(base_url, ".tgz") - - # Make sure that the given variable name is a possible choice - variable <- match.arg(variable, c( - "evapo_p", - "evapo_r", - "frost_depth", - "soil_moist", - "soil_temperature_5cm" - )) - - "grids_germany/daily" %>% - ftp_path_cdc(variable) %>% - list_url(full_names = TRUE) %>% - filter_by_extension_tgz() %>% - filter_by_month_range(from, to) -} - # download_and_extract --------------------------------------------------------- +#' @importFrom archive archive_extract download_and_extract <- function(url, quiet = FALSE) { # Create a dedicated temporary folder - target_dir <- temp_dir(template. = url) + target_dir <- temp_dir(template = url) # Download the file into the dedicated folder - file <- download_if_not_there( + file <- download( url, - file.path(target_dir, basename(url)), - quiet = quiet + target_dir = target_dir, + quiet = quiet, + mode = "wb" ) # Extract the file into the same folder diff --git a/R/download_grids_germany.R b/R/download_grids_germany.R new file mode 100644 index 00000000..0536ea73 --- /dev/null +++ b/R/download_grids_germany.R @@ -0,0 +1,17 @@ +download_grids_germany <- function(resolution, variable, from, to, quiet = FALSE) +{ + if (resolution == "daily") { + + # Download and extract .tgz files from DWD server + download_daily_grids_germany(variable, from, to, quiet = quiet) + + } else if (resolution == "monthly") { + + # Download files from DWD server + download_monthly_grids_germany(variable, from, to, quiet = quiet) + + } else { + + clean_stop("resolution must be one of 'daily', 'monthly'.") + } +} diff --git a/R/download_into_folder_structure.R b/R/download_into_folder_structure.R new file mode 100644 index 00000000..5847821d --- /dev/null +++ b/R/download_into_folder_structure.R @@ -0,0 +1,41 @@ +# download_into_folder_structure ----------------------------------------------- +download_into_folder_structure <- function( + urls, target_dir, skip_url_segments, ... +) +{ + relative_paths <- url_to_relative_path(urls, skip_url_segments) + + # Paths to target files + target_files <- file.path(target_dir, relative_paths) + + # Paths of directories to be created + directory_paths <- unique(dirname(target_files)) + + # Create required directory structure + kwb.utils::createDirectories(directory_paths, dbg = FALSE) + + # Download the files that are not yet in the target directory structure + mapply( + FUN = download, + urls, + target_files, + MoreArgs = list(...) + ) + + # Return the target paths and the target directory in attribute "base_dir" + structure(target_files, base_dir = target_dir) +} + +# url_to_relative_path --------------------------------------------------------- +url_to_relative_path <- function(url, skip_url_segments = 1L) +{ + stopifnot(skip_url_segments > 0L) + + segments <- strsplit(remove_protocol(url), "/") + + stopifnot(all(lengths(segments) > skip_url_segments)) + + sapply(segments, function(x) { + paste(x[-seq_len(skip_url_segments)], collapse = "/") + }) +} diff --git a/R/download_monthly_grids_germany.R b/R/download_monthly_grids_germany.R index 4784c1a0..4c09ad88 100644 --- a/R/download_monthly_grids_germany.R +++ b/R/download_monthly_grids_germany.R @@ -1,24 +1,28 @@ +#kwb.utils::assignPackageObjects("kwb.dwd") + +if (FALSE) +{ + kwb.dwd:::download_monthly_grids_germany( + variable = "air_temperature_mean" + ) +} + download_monthly_grids_germany <- function( variable, from = to, - to = last_month_as_yyyymm(), + to = last_month(), urls = NULL, quiet = FALSE ) { if (is.null(urls)) { - urls <- list_monthly_grids_germany_asc_gz(variable, from, to) + urls <- list_grids_germany("monthly", ".asc.gz", variable, from, to) } - unlist(lapply(urls, function(url) { - #url <- urls[1L] - download_if_not_there( - url, - file = file.path( - temp_dir(template. = kwb.utils::removeExtension(url)), - basename(url) - ), - quiet = quiet - ) - })) + download_into_folder_structure( + urls, + target_dir = download_dir("dwd"), + skip_url_segments = 3L, + mode = "wb" + ) } diff --git a/R/download_radolan.R b/R/download_radolan.R index 7f19762d..8a6a3d03 100644 --- a/R/download_radolan.R +++ b/R/download_radolan.R @@ -1,11 +1,11 @@ #' Download Radolan Files on DWD Server +#' #' @param resolution temporal resolution, one of "daily" or "hourly" (default: #' "daily") #' @param export_dir export directory (default: "data" in current working #' directory) -#' @param \dots arguments passed to \code{\link{get_radolan_urls}}, such as -#' \code{start_daily}, \code{start_hourly}, \code{end_daily}, -#' \code{end_hourly} +#' @param \dots arguments passed to [get_radolan_urls], such as `start_daily`, +#' `start_hourly`, `end_daily`, `end_hourly`. #' @return list with "daily_historical_urls" and "hourly_historical_urls" #' @importFrom fs dir_create #' @importFrom kwb.utils catAndRun @@ -14,6 +14,11 @@ #' @export #' @examples #' \dontrun{download_radolan(resolution = "daily")} +#' @seealso +#' * [get_radolan_urls], +#' * [extract_radolan_zip_files], +#' * [radolan_raw_to_raster], +#' * [list_extracted_radolan_files]. download_radolan <- function(resolution = "daily", export_dir = "data", ...) { if (! resolution %in% c("daily", "hourly")) { diff --git a/R/download_shapes_germany.R b/R/download_shapes_germany.R new file mode 100644 index 00000000..9333eda9 --- /dev/null +++ b/R/download_shapes_germany.R @@ -0,0 +1,68 @@ +if (FALSE) +{ + url <- "https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip" + url <- "https://www.eea.europa.eu/data-and-maps/data/eea-reference-grids-2/gis-files/germany-shapefile/at_download/file/Germany_shapefile.zip" + url <- "https://www.arcgis.com/sharing/rest/content/items/ae25571c60d94ce5b7fcbf74e27c00e0/data/vg2500_geo84.zip" + + RCurl::url.exists(url) + + file <- kwb.dwd:::download(url, mode = "wb") +} + +# download_shapes_germany ------------------------------------------------------ + +#' Check Local Availability or Download Shape Files +#' +#' This function checks if shape files for Germany are available in the folder +#' `\%TEMP\%/R_kwb.dwd/shapes_germany`. If not, the shape files are +#' downloaded from the URL given in `url` and unpacked into that folder. +#' +#' @param url URL to publicly available zip file containing shape files for +#' Germany. Default: +#' +#' @param quiet passed if `TRUE` status messages are suppressed +#' @param timeout timeout in seconds +#' @return path to folder containing shape files +#' @export +#' @seealso +#' * [get_shapes_of_germany], +#' * [get_example_grid_germany], +#' * [download_radolan]. +download_shapes_germany <- function( + url = "https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip", + quiet = FALSE, + timeout = 60 +) +{ + #kwb.utils::assignPackageObjects("kwb.dwd");quiet=FALSE;timeout=1 + + # Path to sub folder below %TEMP% containing shape files for Germany + shape_dir <- temp_dir("shapes_germany") + + # If the shape directory contains at least one .shp file, return the path to + # the directory + if (contains_file(shape_dir, pattern = "\\.shp$")) { + return(shape_dir) + } + + # If does not contain .shp files, download the zip-archive from + # and extract it into + file <- try(silent = TRUE, suppressWarnings(download( + url, + target_dir = download_dir("shapes_germany"), + quiet = quiet, + mode = "wb", + timeout = timeout + ))) + + if (kwb.utils::isTryError(file)) { + clean_stop(as.character(file)) + } + + stopifnot(file.exists(file), file.exists(shape_dir)) + + # Extract the archive file into the shape directory + unzip_zip_file(file, target_dir = shape_dir) + + shape_dir +} diff --git a/R/extract_radolan_zip_files.R b/R/extract_radolan_zip_files.R index 70943886..0add0c63 100644 --- a/R/extract_radolan_zip_files.R +++ b/R/extract_radolan_zip_files.R @@ -6,52 +6,22 @@ #' in .tar.gz) #' #' @return Nothing. Side effect: Unzipped files in subfolder "bin" below -#' \code{radolan_dir}. +#' `radolan_dir`. #' #' @export -#' @importFrom kwb.utils catAndRun createDirectory -#' @importFrom utils untar +#' @importFrom kwb.utils createDirectory +#' @seealso +#' * [list_extracted_radolan_files]. extract_radolan_zip_files <- function(radolan_dir) { - # Get the paths to the zipped files - pattern <- "\\.tar\\.gz" - zip_files <- dir(radolan_dir, pattern, recursive = TRUE, full.names = TRUE) + #radolan_dir = download_dir("dwd") - # Get the names of the binary files contained in the zip archives - expected_bins <- list_files_in_zip_files(zip_files) + # Get paths to .tar.gz files below + files <- dir(radolan_dir, "\\.tar\\.gz$", recursive = TRUE, full.names = TRUE) - # Directory of extracted binary files - export_dir <- kwb.utils::createDirectory(file.path(radolan_dir, "bin")) + # Define and create target directory: /bin + target_dir <- kwb.utils::createDirectory(file.path(radolan_dir, "bin")) - # Determining files that need to be extracted - to_be_extracted <- kwb.utils::catAndRun( - messageText = "Determining files that need to be extracted", { - - # Get the paths to all binary Radolan files in the export directory - existing_bins <- dir(export_dir, "---bin$", full.names = TRUE) - - # Have the binary files already been extracted? - bin_exists <- expected_bins$file %in% basename(existing_bins) - - # Filter for the files that need to be extracted - expected_bins[! bin_exists, ] - } - ) - - # Extract all those files that do not yet exist in the export directory - for (zip_file in unique(to_be_extracted$zip_file)) { - - zip_file_path <- zip_files[basename(zip_files) == zip_file] - - files <- to_be_extracted$file[to_be_extracted$zip_file == zip_file] - - stopifnot(length(zip_file_path) == 1) - - kwb.utils::catAndRun( - messageText = sprintf( - "Unzipping %d files from %s to %s", length(files), zip_file, export_dir - ), - expr = utils::untar(zip_file_path, files = files, exdir = export_dir) - ) - } + # Unzip files to target directory, invisibly return paths to extracted files + invisible(unlist(lapply(files, unzip_tar_gz_file, target_dir = target_dir))) } diff --git a/R/ftp_path.R b/R/ftp_path.R index 032aacdb..f689a48f 100644 --- a/R/ftp_path.R +++ b/R/ftp_path.R @@ -4,14 +4,10 @@ ftp_path_cdc <- function(...) file.path("ftp://opendata.dwd.de/climate_environment/CDC", ...) } -# ftp_path_monthly_grids ------------------------------------------------------- -ftp_path_monthly_grids <- function(...) +# ftp_path_grids_germany ------------------------------------------------------- +ftp_path_grids_germany <- function(resolution, ...) { - ftp_path_cdc("grids_germany/monthly", ...) -} + safe_element(resolution, c("monthly", "daily")) -# ftp_path_daily_grids --------------------------------------------------------- -ftp_path_daily_grids <- function(...) -{ - ftp_path_cdc("grids_germany/daily", ...) + ftp_path_cdc("grids_germany", resolution, ...) } diff --git a/R/ftp_path_radolan.R b/R/ftp_path_radolan.R new file mode 100644 index 00000000..47f50e59 --- /dev/null +++ b/R/ftp_path_radolan.R @@ -0,0 +1,129 @@ +# MAIN ------------------------------------------------------------------------- +if (FALSE) +{ + #kwb.dwd:::ftp_path_grids_germany("daily") + + ftp_path_radolan_all() + ftp_path_radolan_all(use_placeholder = TRUE) + + # Kann ich alle Radolan-Daten bearbeiten? + get_radolan_metadata("grids_germany/5_minutes/radolan/reproc/_002/asc/") + get_radolan_metadata(url = "grids_germany/5_minutes/radolan/reproc/1999_002/asc/1998") + + ftp_path_radolan() + ftp_path_radolan(resolution = "") + ftp_path_radolan(resolution = "hourly") + ftp_path_radolan(resolution = "5_minutes") + ftp_path_radolan(resolution = "5_minutes", type = "a") + ftp_path_radolan(resolution = "5_minutes", type = "historical") + ftp_path_radolan(type = "historical", resolution = "hourly") + ftp_path_radolan(type = "historical", resolution = "daily") + + ftp_path_radolan(type = "reproc") + ftp_path_radolan(format = "netCDF") +} + +# ftp_path_radolan ------------------------------------------------------------- +ftp_path_radolan <- function( + resolution = NULL, + type = NULL, + format = NULL +) +{ + ### Code to generate the following "templates <- c(...)" assignment + # ftp_path_radolan_all(use_placeholder = TRUE) %>% + # dQuote('"') %>% + # paste(collapse = ",\n ") %>% + # sprintf(fmt = "templates <- c(\n %s\n)") %>% + # cat() + + paths <- ftp_path_radolan_all() + + paths <- c( + "grids_germany/5_minutes/radolan/reproc/_002/asc/", + "grids_germany/5_minutes/radolan/reproc/_002/asc/supplement", + "grids_germany/5_minutes/radolan/reproc/_002/bin/", + "grids_germany/5_minutes/radolan/reproc/_002/bin/supplement", + "grids_germany/5_minutes/radolan/reproc/_002/netCDF/", + "grids_germany/daily/radolan/historical/bin/", + "grids_germany/daily/radolan/recent/bin", + "grids_germany/hourly/radolan/historical/asc/", + "grids_germany/hourly/radolan/historical/asc", + "grids_germany/hourly/radolan/historical/bin/", + "grids_germany/hourly/radolan/historical/bin", + "grids_germany/hourly/radolan/recent/asc", + "grids_germany/hourly/radolan/recent/bin", + "grids_germany/hourly/radolan/reproc/_003/asc/", + "grids_germany/hourly/radolan/reproc/_003/bin/", + "grids_germany/hourly/radolan/reproc/_002/asc/", + "grids_germany/hourly/radolan/reproc/_002/asc/supplement", + "grids_germany/hourly/radolan/reproc/_002/bin/", + "grids_germany/hourly/radolan/reproc/_002/bin/supplement", + "grids_germany/hourly/radolan/reproc/_002/netCDF/" + ) + + metadata <- get_radolan_metadata(paths) + + #View(metadata) + + filter_metadata <- function(metadata, property, value) { + if (is.null(value)) { + return(metadata) + } + values <- kwb.utils::selectColumns(metadata, property) + options <- kwb.utils::toNamedList(unique(values)) + metadata[values == kwb.utils::selectElements(options, value), ] + } + + metadata <- filter_metadata(metadata, "resolution", value = resolution) + metadata <- filter_metadata(metadata, "type", type) + metadata <- filter_metadata(metadata, "format", format) + + kwb.utils::selectColumns(metadata, "url") +} + +# ftp_path_radolan_all --------------------------------------------------------- +ftp_path_radolan_all <- function(use_placeholder = FALSE) +{ + paths <- kwb.dwd::dwd_files$file %>% + grep(pattern = "/radolan/", value = TRUE) %>% + dirname() %>% + unique() + + if (use_placeholder) { + paths <- paths %>% + gsub(pattern = "/\\d{4}(_|$)", replacement = "/\\1") %>% + unique() + } + + paths +} + +# get_radolan_metadata --------------------------------------------------------- +get_radolan_metadata <- function(url) +{ + pattern <- paste0( + "grids_germany", + "/([^/]+)", # 1. pair of parentheses: resolution + "/radolan", + "/([^/]+)", # 2. pair of parentheses: type + "(/(_\\d{3}))?", # 4. pair of parentheses: version (if any) + "/([^/]+)", # 5. pair of parentheses: format + "(/.*)?" + ) + + year_placeholder <- "" + + if (!any(grepl(year_placeholder, url))) { + pattern <- gsub(year_placeholder, "\\\\d{4}", pattern) + } + + metadata <- kwb.utils::extractSubstring(pattern, url, index = c( + resolution = 1L, + type = 2L, + version = 4L, + format = 5L + )) + + cbind(metadata, url = url) +} diff --git a/R/get_dwd_urls_metadata.R b/R/get_dwd_urls_metadata.R index 16ecce4f..87dabc1e 100644 --- a/R/get_dwd_urls_metadata.R +++ b/R/get_dwd_urls_metadata.R @@ -9,6 +9,9 @@ #' @export #' @importFrom stats setNames #' @importFrom kwb.utils pasteColumns +#' @seealso +#' * [get_radolan_urls], +#' * [get_berlin_dwd_mask]. get_dwd_urls_metadata <- function() { # Note: category "solar" is not considered @@ -128,12 +131,6 @@ dwd_filename_stations <- function(category, frequency) sprintf( "%s_%swerte_Beschreibung_Stationen.txt", get_element_or_stop(get_dwd_url_specification(category), "file_prefix"), - frequency_prefix(frequency) + get_element_or_stop(c(daily = "Tages", hourly = "Stunden"), frequency) ) } - -# frequency_prefix ------------------------------------------------------------- -frequency_prefix <- function(frequency) -{ - get_element_or_stop(c(daily = "Tages", hourly = "Stunden"), frequency) -} diff --git a/R/get_example_grid_germany.R b/R/get_example_grid_germany.R index 3a470617..ddd784f3 100644 --- a/R/get_example_grid_germany.R +++ b/R/get_example_grid_germany.R @@ -4,8 +4,10 @@ #' #' Read monthly potential evaporation of January 2022, just as an example. #' @export +#' @seealso +#' * [get_shapes_of_germany]. get_example_grid_germany <- function() { path <- "evapo_p/grids_germany_monthly_evapo_p_202201.asc.gz" - read_asc_gz_file(url = ftp_path_monthly_grids(path)) + read_asc_gz_file(url = ftp_path_grids_germany("monthly", path)) } diff --git a/R/get_radolan_projection_string.R b/R/get_radolan_projection_string.R index 0d22761f..f17df08b 100644 --- a/R/get_radolan_projection_string.R +++ b/R/get_radolan_projection_string.R @@ -6,8 +6,14 @@ #' @examples #' get_radolan_projection_string() #' +#' @seealso +#' * [get_radolan_urls], +#' * [get_radolan_extension]. get_radolan_projection_string <- function() { + # TODO: Is this the same? + # readLines(default_projection_file()) + to_projection_string( parameters = list( proj = "stere", diff --git a/R/get_radolan_urls.R b/R/get_radolan_urls.R index d92a916b..bae84be1 100644 --- a/R/get_radolan_urls.R +++ b/R/get_radolan_urls.R @@ -1,7 +1,7 @@ #' Get URLs to Available Radolan Files #' #' Get URLs to available radolan files on the DWD FTP server below this base -#' address: \url{ftp://opendata.dwd.de/climate_environment/CDC/grids_germany}. +#' address: . #' The user can choose between daily records and hourly records that are located #' at different paths on the server. The paths to the files are not read from #' the FTP server but generated, given the knowledge of where the files should @@ -14,17 +14,15 @@ #' @param end_daily month string (yyyy-mm) of last daily record. Defaults to the #' current month. #' @param end_hourly month string (yyyy-mm) of last hourly records. Defaults to -#' \code{end_daily}. -#' @param \dots further arguments passed to \code{kwb.dwd:::get_radolan_url}, -#' such as \code{ftp_root} +#' `end_daily`. +#' @param \dots further arguments passed to `kwb.dwd:::get_radolan_url`, +#' such as `ftp_root` #' @importFrom magrittr %>% #' @importFrom kwb.utils left resolve stringList #' @importFrom lubridate rollback #' @importFrom stringr str_replace #' @importFrom fs dir_create -#' #' @return list with "daily_historical_urls" and "hourly_historical_urls" -#' #' @export #' @examples #' # Get all expected URLs @@ -41,6 +39,10 @@ #' #' urls$daily_historical_urls #' +#' @seealso +#' * [get_dwd_urls_metadata], +#' * [get_radolan_extension], +#' * [get_radolan_projection_string]. get_radolan_urls <- function( start_daily = "2006-10", start_hourly = "2005-06", diff --git a/R/get_scaling_factors.R b/R/get_scaling_factors.R index 86e03cc0..fb4e06fa 100644 --- a/R/get_scaling_factors.R +++ b/R/get_scaling_factors.R @@ -1,12 +1,12 @@ # # Ask DWD's documentation for the factor: # -# urls <- kwb.dwd:::list_monthly_grids_germany_asc_gz("sunshine_duration") +# urls <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "sunshine_duration") # kwb.dwd:::open_description(urls[1L]) # kwb.dwd:::open_description(dirname(urls[1L])) # alternative # # or: -# urls <- kwb.dwd:::list_daily_grids_germany_tgz("soil_temperature_5cm") +# urls <- kwb.dwd:::list_grids_germany("daily", ".tgz", "soil_temperature_5cm") # kwb.dwd:::open_description(urls[1L]) # diff --git a/R/get_shapes_of_germany.R b/R/get_shapes_of_germany.R index 1b180efb..c756454b 100644 --- a/R/get_shapes_of_germany.R +++ b/R/get_shapes_of_germany.R @@ -2,14 +2,30 @@ #' Provide List of SpatialPolygonsDataFrame for Germany #' -#' @param recreate logical. If \code{TRUE} the required shape files are freshly -#' downloaded from \url{https://gadm.org/}, transformed to the projection used +#' @param recreate logical. If `TRUE` the required shape files are freshly +#' downloaded from , transformed to the projection used #' in DWD data files and stored locally in an RData file. The default is -#' \code{FALSE}, i.e. the required data are read form the locally stored RData +#' `FALSE`, i.e. the required data are read form the locally stored RData #' file, provided that the file exists. +#' @param use_sf passed to `kwb.dwd:::transform_coords` #' @export -get_shapes_of_germany <- function(recreate = FALSE) +#' @seealso +#' * [get_example_grid_germany], +#' * [download_shapes_germany]. +get_shapes_of_germany <- function(recreate = FALSE, use_sf = FALSE) { + if (!recreate) { + + # Create the list from the datasets that are stored in this package + return(list( + gadm40_DEU_0 = kwb.dwd::shapes_germany_0, + gadm40_DEU_1 = kwb.dwd::shapes_germany_1, + gadm40_DEU_2 = kwb.dwd::shapes_germany_2 + )) + } + + #kwb.utils::assignPackageObjects("kwb.dwd") + # Set cache directory in sub folder within Windows TEMP folder cache_dir <- temp_dir("cache") @@ -24,16 +40,31 @@ get_shapes_of_germany <- function(recreate = FALSE) # List shape files. If required, the shape files are downloaded, unzipped and # stored locally. They are downloaded from: # https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip - files <- list_local_shape_files(check_or_download_shapes_germany())[-1L] + shape_dir <- download_shapes_germany() + files <- list_local_shape_files(shape_dir) # Read shapes at different levels of detail - shapes_germany <- lapply(stats::setNames(nm = files), read_shape_file) + shapes_germany <- lapply( + X = stats::setNames(files, kwb.utils::removeExtension(basename(files))), + #FUN = read_shape_file_2 + FUN = read_shape_file, + use_sf = TRUE + ) # Load an example Raster of Germany, just to ask for its projection example_grid <- get_example_grid_germany() + #crs_lines <- readLines("https://opendata.dwd.de/climate_environment/CDC/help/gk3.prj") + #print(example_grid@srs) + #cat(crs_lines) + # Transform all shapes according to the projection of the example grid - shapes_germany <- lapply(shapes_germany, sp::spTransform, example_grid@crs) + shapes_germany <- lapply( + shapes_germany, + FUN = transform_coords, + target_crs = example_grid@srs, + use_sf = use_sf + ) # Save the shapes so that next time they can be loaded directly save(shapes_germany, file = rdata_file) @@ -47,16 +78,3 @@ list_local_shape_files <- function(path) { dir(path, "shp$", full.names = TRUE) } - -# read_shape_file -------------------------------------------------------------- -#' @importFrom rgdal readOGR -read_shape_file <- function(file) -{ - rgdal::readOGR( - dsn = file, - stringsAsFactors = FALSE, - encoding = "UTF-8", - use_iconv = TRUE - ) -} - diff --git a/R/list_contents.R b/R/list_contents.R index e02a324e..0a523a58 100644 --- a/R/list_contents.R +++ b/R/list_contents.R @@ -32,7 +32,7 @@ list_ftp_contents <- function(x = character(), full_info = FALSE, ...) #' @keywords internal #' @noMd #' @noRd -#' @importFrom kwb.utils selectColumns +#' @importFrom kwb.utils commonNames moveColumnsToFront selectColumns response_to_data_frame <- function(response, full_info = FALSE) { template <- empty_file_info(full_info) @@ -53,9 +53,17 @@ response_to_data_frame <- function(response, full_info = FALSE) return(get_info(c("file", "isdir"))) } - # Replace columns "year_or_time", "month", "day" with "modification_time". - # Put the most important columns first. - main_columns_first(simplify_time_info(info)) + # Replace columns "year_or_time", "month", "day" with "modification_time" + simple_info <- simplify_time_info(info) + + # Put the most important columns first + kwb.utils::moveColumnsToFront( + simple_info, + columns = kwb.utils::commonNames( + empty_file_info(full_info = TRUE), + simple_info + ) + ) } # empty_file_info -------------------------------------------------------------- @@ -156,36 +164,24 @@ simplify_time_info <- function(info) #' columns_to_timestamp <- function(info) { - pull <- function(x) kwb.utils::selectColumns(info, x) + pull <- kwb.utils::createAccessor(info) years_or_times <- pull("year_or_time") - is_year <- ! grepl(":", years_or_times) + is_year <- !grepl(":", years_or_times) + + month_numbers <- list( + Jan = 1L, Feb = 2L, Mar = 3L, Apr = 04L, May = 05L, Jun = 06L, + Jul = 7L, Aug = 8L, Sep = 9L, Oct = 10L, Nov = 11L, Dec = 12L + ) # Compose a vector of timestamps. Use the current year in case of missing # years, and use midnight in case of missing times sprintf( "%04d-%02d-%02d %s", as.integer(ifelse(is_year, years_or_times, format(Sys.Date(), "%Y"))), - sapply(pull("month"), kwb.utils::selectElements, x = month_numbers()), + sapply(pull("month"), kwb.utils::selectElements, x = month_numbers), as.integer(pull("day")), ifelse(is_year, "00:00", years_or_times) ) } - -# main_columns_first ----------------------------------------------------------- -#' Main Columns first -#' -#' @param df data.frame -#' @return ??? -#' @keywords internal -#' @noMd -#' @noRd -#' @importFrom kwb.utils moveColumnsToFront -#' -main_columns_first <- function(df) -{ - columns <- intersect(names(empty_file_info(full_info = TRUE)), names(df)) - - kwb.utils::moveColumnsToFront(df, columns) -} diff --git a/R/list_extracted_radolan_files.R b/R/list_extracted_radolan_files.R new file mode 100644 index 00000000..0993e6af --- /dev/null +++ b/R/list_extracted_radolan_files.R @@ -0,0 +1,48 @@ +# list_extracted_radolan_files ------------------------------------------------- + +#' List the Locally Available Extracted Files +#' +#' @param from begin of time interval as "yyyymm" string (4 digits year + 2 +#' digits month) +#' @param to end of time interval as "yyyymm" string (4 digits year + 2 digits +#' month) +#' @param resolution temporal resolution, currently one of "daily", "hourly" +#' @param format file format, currently one of "asc" (ASCII text), "bin" +#' (binary) +#' @return paths to files on the local drive, below the folder returned by +#' [temp_dir], that contain data in the requested `format`, +#' time `resolution` and time interval (specified by `from` and +#' `to`). +#' @export +#' @seealso +#' * [extract_radolan_zip_files]. +list_extracted_radolan_files <- function(from, to, resolution, format) +{ + # resolution = "daily" + # format = "bin" + # from = "201601" + # to = "201612" + + safe_element(resolution, c("daily", "hourly")) + safe_element(format, c("asc", "bin")) + + pattern <- kwb.utils::selectElements(elements = format, list( + asc = "\\.asc$", + bin = "--bin(\\.gz)?$" # files may optionally be zipped + )) + + files <- "grids_germany/%s/radolan/historical/%s" %>% + sprintf(resolution, format) %>% + temp_dir() %>% + dir(pattern = pattern, recursive = TRUE, full.names = TRUE) %>% + filter_by_month_range(from, to) + + if (length(files) == 0L) { + message(paste(collapse = "\n", c( + "No matching files found on the local drive.", + "Please run download_and_extract_radolan() first." + ))) + } + + files +} diff --git a/R/list_grids_germany.R b/R/list_grids_germany.R new file mode 100644 index 00000000..4e8facc5 --- /dev/null +++ b/R/list_grids_germany.R @@ -0,0 +1,121 @@ +if (FALSE) +{ + kwb.utils::assignPackageObjects("kwb.dwd") + + # Code to get the possible choices + get_variable_choices <- function(frequency, extension) + { + stopifnot(frequency %in% c("daily", "monthly", "hourly")) + url_subdirs_containing_files_with_extension( + url = ftp_path_cdc("grids_germany", frequency), + extension = extension + ) + } + + open_radolan_description <- function(path) + { + file.path("grids_germany/hourly/radolan", path) %>% + ftp_path_cdc() %>% + list_url(full_names = TRUE) %>% + `[`(1L) %>% + open_description() + } + + open_radolan_description(path = "historical/bin") + # Historische stuendliche RADOLAN-Raster der Niederschlagshoehe (binaer) + + open_radolan_description(path = "historical/asc") + # Historische stuendliche RADOLAN-Raster der Niederschlagshoehe (GIS-lesbar) + + # get_variable_choices("hourly", ".tar") # -> "radolan" + # get_variable_choices("hourly", ".tar.gz") # -> "radolan" + + variables_grids_germany <- list( + # get_variable_choices("daily", ".tgz") + daily_tgz = c( + "evapo_p", + "evapo_r", + "frost_depth", + "soil_moist", + "soil_temperature_5cm" + ), + # get_variable_choices("monthly", ".asc.gz") + monthly_asc_gz <- c( + "air_temperature_max", + "air_temperature_mean", + "air_temperature_min", + "drought_index", + "evapo_p", + "evapo_r", + "frost_depth", + "precipitation", + "soil_moist", + "soil_temperature_5cm", + "sunshine_duration" + ) + ) +} + +# list_grids_germany ----------------------------------------------------------- + +#' Get URLs to Zipped Files Containing Grid Data for Germany +#' +#' @param resolution one of "monthly", "daily" +#' @param extension file extension of files to be listed, e.g. ".tgz" +#' @param variable variable for which to look for URLs. Must be one of +#' `kwb.dwd::list_url(kwb.dwd:::ftp_path_grids_germany(resolution))` +#' @param from optional. First month to be considered, as "yyyymm" string +#' @param to optional. Last month to be considered, as "yyyymm" string +#' @param recursive whether to list files recursively. Default: `TRUE` +#' +list_grids_germany <- function( + resolution, extension, variable, from = NULL, to = NULL, recursive = TRUE +) +{ + #resolution = "monthly" + #extension = ".asc.gz" + + # Code to get the possible choices + # base_url <- kwb.dwd:::ftp_path_grids_germany(resolution) + # kwb.dwd:::url_subdirs_containing_files_with_extension(base_url, extension) + + # Make sure that the given variable name is a possible choice + if (resolution == "monthly") { + + safe_element(variable, c( + "air_temperature_max", + "air_temperature_mean", + "air_temperature_min", + "drought_index", + "evapo_p", + "evapo_r", + "frost_depth", + "precipitation", + "soil_moist", + "soil_temperature_5cm", + "sunshine_duration" + )) + + } else if (resolution == "daily") { + + safe_element(variable, c( + "evapo_p", + "evapo_r", + "frost_depth", + "soil_moist", + "soil_temperature_5cm" + )) + } + + # Base URL to grids of Germany in requested temporal resolution + base_url <- ftp_path_grids_germany(resolution, variable) + + # List data files + relative_urls <- base_url %>% + list_url(recursive = recursive) %>% + filter_by_extension(extension) %>% + filter_by_month_range(from, to) + + # Provide full URLs to zipped files + file.path(base_url, relative_urls) +} diff --git a/R/list_url.R b/R/list_url.R index 9ddd3c0a..1d426130 100644 --- a/R/list_url.R +++ b/R/list_url.R @@ -4,18 +4,19 @@ #' #' @param url URL to FTP server, including "ftp://" #' @param recursive logical indicating whether to list files in all -#' subdirectories (default: \code{FALSE}) -#' @param max_depth maximum folder depth to consider when -#' \code{recursive = TRUE} -#' @param full_info if \code{TRUE}, not only the path and filename are returned -#' but also the file properties. The default is \code{FALSE}. -#' @param full_names if \code{TRUE}, the full URLs are returned, otherwise (the -#' default) only the paths relative to \code{url}. -#' @param \dots arguments passed to \code{kwb.dwd:::try_to_get_url}, such as -#' \code{n_trials}, \code{timeout}, or \code{sleep_time} +#' subdirectories (default: `FALSE`) +#' @param max_depth maximum folder depth to consider when `recursive = TRUE` +#' @param full_info if `TRUE`, not only the path and filename are returned but +#' also the file properties. The default is `FALSE`. +#' @param full_names if `TRUE`, the full URLs are returned, otherwise (the +#' default) only the paths relative to `url`. +#' @param \dots arguments passed to `kwb.dwd:::try_to_get_url`, such as +#' `n_trials`, `timeout`, or `sleep_time` #' @export #' @importFrom kwb.utils listToDepth selectColumns #' @importFrom RCurl getCurlHandle +#' @seealso +#' * [list_extracted_radolan_files]. list_url <- function( url = ftp_path_cdc(), recursive = ! is.na(max_depth), diff --git a/R/load_monthly_data_for_berlin.R b/R/load_monthly_data_for_berlin.R index bc3162d8..97fd9692 100644 --- a/R/load_monthly_data_for_berlin.R +++ b/R/load_monthly_data_for_berlin.R @@ -5,12 +5,21 @@ #' #' @param from optional. First month to be considered, as yyyymm string #' @param to optional. Last month to be considered, as yyyymm string -#' @return data frame with columns \code{file} (name of file downloaded from -#' DWD), \code{year} (year number as integer), \code{month number as integer}, -#' \code{mean} (mean value), \code{sd} (standard deviation), \code{min} -#' (minimum value), \code{max} (maximum value), \code{n_values} (number of -#' considered values) of potential evaporation calculated for Berlin, Germany +#' @return data frame with columns +#' * `file` (name of file downloaded from DWD), +#' * `year` (year number as integer), +#' * `month number as integer`, +#' * `mean` (mean value), +#' * `sd` (standard deviation), +#' * `min` (minimum value), +#' * `max` (maximum value), +#' * `n_values` (number of considered values) +#' of potential evaporation calculated for Berlin, Germany #' @export +#' @seealso +#' * [load_potential_evaporation_berlin_2], +#' * [get_berlin_dwd_mask], +#' * [load_precipitation_berlin]. load_potential_evaporation_berlin <- function(from = NULL, to = NULL) { load_monthly_variable_for_region( @@ -25,12 +34,20 @@ load_potential_evaporation_berlin <- function(from = NULL, to = NULL) #' #' @param from optional. First month to be considered, as yyyymm string #' @param to optional. Last month to be considered, as yyyymm string -#' @return data frame with columns \code{file} (name of file downloaded from -#' DWD), \code{year} (year number as integer), \code{month number as integer}, -#' \code{mean} (mean value), \code{sd} (standard deviation), \code{min} -#' (minimum value), \code{max} (maximum value) of precipitation -#' calculated for Berlin, Germany +#' @return data frame with columns +#' * `file` (name of file downloaded from DWD), +#' * `year` (year number as integer), +#' * `month number as integer`, +#' * `mean` (mean value), +#' * `sd` (standard deviation), +#' * `min` (minimum value), +#' * `max` (maximum value) +#' of precipitation calculated for Berlin, Germany #' @export +#' @seealso +#' * [load_potential_evaporation_berlin_2], +#' * [load_potential_evaporation_berlin], +#' * [get_berlin_dwd_mask]. load_precipitation_berlin <- function(from = NULL, to = NULL) { load_monthly_variable_for_region( @@ -47,12 +64,21 @@ load_precipitation_berlin <- function(from = NULL, to = NULL) #' #' @param from optional. First month to be considered, as yyyymm string #' @param to optional. Last month to be considered, as yyyymm string -#' @return data frame with columns \code{file} (name of file downloaded from -#' DWD), \code{year} (year number as integer), \code{month number as integer}, -#' \code{mean} (mean value), \code{sd} (standard deviation), \code{min} -#' (minimum value), \code{max} (maximum value), \code{n_values} (number of -#' considered values) of potential evaporation calculated for Berlin, Germany +#' @return data frame with columns +#' * `file` (name of file downloaded from DWD), +#' * `year` (year number as integer), +#' * `month` (month number as integer`, +#' * `mean` (mean value), +#' * `sd` (standard deviation), +#' * `min` (minimum value), +#' * `max` (maximum value), +#' * `n_values` (number of considered values) +#' of potential evaporation calculated for Berlin, Germany #' @export +#' @seealso +#' * [load_potential_evaporation_berlin], +#' * [get_berlin_dwd_mask], +#' * [load_precipitation_berlin]. load_potential_evaporation_berlin_2 <- function(from, to) { load_monthly_variable_for_region( diff --git a/R/load_monthly_variable_for_region.R b/R/load_monthly_variable_for_region.R index 8d8b6bc9..f53317ef 100644 --- a/R/load_monthly_variable_for_region.R +++ b/R/load_monthly_variable_for_region.R @@ -9,9 +9,8 @@ load_monthly_variable_for_region <- function( variable <- match.arg(variable, c("precipitation", "evapo_p", "evapo_r")) # Get URLs to .asc.gz files with monthly grids on DWD server - urls <- list_monthly_grids_germany_asc_gz(variable, from, to) + urls <- list_grids_germany("monthly", ".asc.gz", variable, from, to) - # files <- download_monthly_grids_germany(variable, from, to) if (version == 1L) { @@ -63,21 +62,21 @@ load_monthly_variable_for_region <- function( #' @importFrom utils read.csv #' @examples #' get_berlin_dwd_mask() +#' @seealso +#' * [get_dwd_urls_metadata]. get_berlin_dwd_mask <- function() { - #DWD matrix filled with NA + # DWD matrix filled with NA berlin_matrix <- matrix(NA, nrow = 866, ncol = 654) - #get Berlin coordinates - berlin_coordinates <- utils::read.csv(system.file( - "extdata/berlin_coordinates.csv", package = "kwb.dwd" - )) + # file with coordinates of "Berlin cells" within DWD matrix + file <- system.file("extdata/berlin_coordinates.csv", package = "kwb.dwd") - #set Berlin cells to 1 + # get Berlin coordinates + berlin_coordinates <- utils::read.csv(file) - for (i in seq_along(berlin_coordinates$row)) { - berlin_matrix[berlin_coordinates$row[i], berlin_coordinates$col[i]] <- 1 - } + # set Berlin cells to 1 + berlin_matrix[as.matrix(berlin_coordinates)] <- 1 berlin_matrix } @@ -89,12 +88,19 @@ get_berlin_dwd_mask <- function() #' @param matrices matrices #' @param geo_mask "mask matrix" defining a geographical subset #' -#' @return data frame with one row per matrix in \code{matrices} and columns -#' \code{file}, \code{year}, \code{month}, \code{mean}, \code{sd}, \code{min}, -#' \code{max} +#' @return data frame with one row per matrix in `matrices` and columns +#' * `file`, +#' * `year`, +#' * `month`, +#' * `mean`, +#' * `sd`, +#' * `min`, +#' * `max` #' @export #' @importFrom kwb.utils getAttribute #' @importFrom stats sd +#' @seealso +#' * [get_example_grid_germany]. calculate_masked_grid_stats <- function(matrices, geo_mask) { # Start with metadata from matrices' attributes: file name, year, month @@ -134,8 +140,8 @@ get_shape_of_german_region <- function(name) ) configs <- list( - berlin = configure(1L, "NAME_1", "Berlin"), - cologne = configure(2L, "NAME_2", "K\xF6ln") + berlin = configure(2L, "NAME_1", "Berlin"), + cologne = configure(3L, "NAME_2", "K.ln") ) config <- kwb.utils::selectElements(configs, name) @@ -146,15 +152,47 @@ get_shape_of_german_region <- function(name) # filter_shapes ---------------------------------------------------------------- filter_shapes <- function(shapes, config) { - s <- shapes[[config$index]] - s[grep(config$pattern, s[[config$variable]]), ] -} + as_configured <- kwb.utils::createAccessor(config) + + s <- shapes[[as_configured("index")]] + + variable <- as_configured("variable") + pattern <- as_configured("pattern") + values <- kwb.utils::selectColumns(s, variable) + + indices <- grep(pattern, values) + + n_selected <- length(indices) + + if (n_selected == 0L) { + kwb.utils::stopFormatted( + "'%s' does not match pattern '%s'", variable, pattern + ) + } + + if (n_selected > 1L) { + kwb.utils::stopFormatted( + "'%s' has more than one match with pattern '%s': %s", + variable, pattern, kwb.utils::stringList(values[indices]) + ) + } + + s[indices, ] +} # raster_stats ----------------------------------------------------------------- raster_stats <- function(r, scale = NULL) { - x <- r@data@values + stopifnot(inherits(r, "BasicRaster")) + + x <- raster::getValues(r) + + # Just for my understanding: does getValues() return r@data@values? + if (length(r@data@values) > 0L) { + stopifnot(identical(r@data@values, x)) + } + x <- x[! is.na(x)] if (! is.null(scale)) { diff --git a/R/open_description.R b/R/open_description.R index 2f26f231..e2be9326 100644 --- a/R/open_description.R +++ b/R/open_description.R @@ -44,11 +44,11 @@ open_description <- function(url) #' For a Given URL, Try to Find Description Files #' #' @param url URL to a data file at ftp server by Deutscher Wetterdienst -#' @param full_names logical. If \code{TRUE} the full URLs are returned, -#' otherwise only the file names. The default is \code{FALSE}. +#' @param full_names logical. If `TRUE` the full URLs are returned, +#' otherwise only the file names. The default is `FALSE`. #' @return vector of character with file names of or full URLs to all files with #' extensions ".txt" or ".pdf" that are in the same folder as the file that -#' \code{url} points to +#' `url` points to find_description_files <- function(url, full_names = FALSE) { urls <- list_url(dirname(url), full_names = full_names) diff --git a/R/provide_projection_file.R b/R/provide_projection_file.R index 4e1344c9..2467cc97 100644 --- a/R/provide_projection_file.R +++ b/R/provide_projection_file.R @@ -2,47 +2,34 @@ #' @importFrom kwb.utils catAndRun catIf replaceFileExtension stopFormatted provide_projection_file <- function(file, dbg = FALSE) { - destfile <- file.path( - dirname(file), - kwb.utils::replaceFileExtension(basename(file), ".prj") - ) + target_file <- kwb.utils::replaceFileExtension(file, ".prj") - if (file.exists(destfile)) { - kwb.utils::catIf( - dbg, "There is already a projection file: ", destfile, "\n" - ) - return() - } + if (file.exists(target_file)) { - prj_file <- default_projection_file() + kwb.utils::catIf(dbg, sprintf( + "There is already a projection file: %s\n", target_file + )) - if (! file.exists(prj_file)) { - url <- url_projection() - kwb.utils::catAndRun( - sprintf( - "Downloading projection file from\n %s\nto\n %s", - url, prj_file - ), - newLine = 3L, - download.file(url, prj_file, method = "auto") - ) + return() } - success <- file.copy(from = prj_file, to = destfile) - - if (! all(success)) { - kwb.utils::stopFormatted("Could not copy %s to %s", prj_file, destfile) - } -} - -# url_projection --------------------------------------------------------------- -url_projection <- function() -{ - "https://opendata.dwd.de/climate_environment/CDC/help/gk3.prj" + copy_file( + from = default_projection_file(), + to = target_file + ) } # default_projection_file ------------------------------------------------------ -default_projection_file <- function() +default_projection_file <- function(quiet = TRUE, download = TRUE) { - file.path(system.file("extdata", package = "kwb.dwd"), "gk3.prj") + url <- "https://opendata.dwd.de/climate_environment/CDC/help/gk3.prj" + + if (!download) { + return(url) + } + + download(url = url, quiet = quiet, file = file.path( + system.file("extdata", package = "kwb.dwd"), + basename(url) + )) } diff --git a/R/radolan_raw_to_raster.R b/R/radolan_raw_to_raster.R index bca11362..0752a86e 100644 --- a/R/radolan_raw_to_raster.R +++ b/R/radolan_raw_to_raster.R @@ -7,6 +7,11 @@ #' @return ??? #' @export #' @importFrom raster flip raster +#' @seealso +#' * [get_radolan_urls], +#' * [extract_radolan_zip_files], +#' * [download_radolan], +#' * [list_extracted_radolan_files]. radolan_raw_to_raster <- function(rbi, version = 3) { stopifnot(version %in% 1:3) diff --git a/R/radolan_related.R b/R/radolan_related.R new file mode 100644 index 00000000..47572818 --- /dev/null +++ b/R/radolan_related.R @@ -0,0 +1,319 @@ +# check_binary_radolan_files --------------------------------------------------- +check_binary_radolan_files <- function(bin_files) +{ + # Read information on binary files from their headers + info <- get_radolan_metadata_from_header(bin_files) + + # Check that information that were read are consistent with file properties + stopifnot(identical(file.size(bin_files), as.numeric(info$bytes))) +} + +# get_radolan_format_description ----------------------------------------------- +get_radolan_format_description <- function() +{ + path <- "extdata/radolan_format-description.txt" + + file <- system.file(path, package = "kwb.dwd") + + #file <- "./inst/extdata/radolan_format-description.txt" + + read.table(file, sep = "\t", header = TRUE) +} + +# get_radolan_header_patterns -------------------------------------------------- +get_radolan_header_patterns <- function() +{ + product_keys <- kwb.utils::selectColumns( + get_radolan_format_description(), + "Produktkennung" + ) + + # Different example headers + # "RW010050100000116BY1620142VS 3SW 2.13.1PR E-01INT 60GP 900x 900MS 70 " + # "RW310950100000816BY1620153VS 3SW 2.16.0PR E-01INT 60GP 900x 900MF 00000001MS 70 " + # "RW010050100000116BY1620142VS 3SW 2.13.1PR E-01INT 60GP 900x 900 MS 70 " + + # https://www.dwd.de/DE/leistungen/radolan/radolan_info/radolan_radvor_op_komposit_format_pdf + patterns <- list( + + # One of the product keys described in get_radolan_format_description() + product = paste(product_keys, collapse = "|"), + + # 3I2 Zeitpunkt der Messung: Tag, Stunde und Minute (ddhhmm) in UTC + ddHHMM = "[0-9]{6}", + + # I5 Radarstandort; für Komposit wird immer 10000 verwendet + site = "[0-9]{5}", + + # 2I2 Zeitpunkt der Messung: Monat und Jahr (MMYY) + mmyy = "[0-9]{4}", + + # A2 Kennung "BY“ + # I7 Produktlänge (in Byte); + # bei Version 4: I10; + # bei Version 5: I7 oder I10 (s. Kennung VS) + bytes = "BY([0-9]{7})", + + # A2 Kennung "VS" (falls nicht vorhanden, dann wurden als + # Grundlage zur Generierung des Komposits standortbezogene + # Radardaten mit 100km Radius verwendet) + # I2 Format-Version: + # 0: sog. „Mischversion“ mit 100 km und 128 km Radius, bedingt + # durch die Erweiterung des quantitativen Messbereiches im + # Frühjahr 2000; + # 1: 100 km Radius; + # 2: 128 km Radius; + # 3: 150 km Radius (ab 30.06.2010 gesetzt; ab 17.03.2010 + # fälschlicherweise noch als 2 dokumentiert); + # 4: räumliche Auflösung in 250m und Produktlänge (in Byte) bei + # der Kennung BY mit 10 Stellen (I10); + # 5: WGS84-Georeferenzierung und Produktlänge (in Byte) bei der + # Kennung BY mit 10 Stellen (I10) für die Produkte RV, + # RS und RE (beim RQ, FS und FQ bleibt es bei 7 Stellen (I7) + # bei der Kennung BY) + format_version = "V?S?([0-9 ]{2})", + + # A2 Kennung "SW" + # 1X,A8 Software-Version von RADOLAN - beginnend mit „00.01.00“ für die erste + # Testverion von RADOLAN - bzw. von den RADVOR-/POLARA-Versionen + software_version = "SW.(.{8})", + + # A2 Kennung "PR" + # 1X,A4 Genauigkeit der Daten: „E-00“ für ganze Zahlen, „E-01“ für 1/10; + # „E-02“ für 1/100 + precision = "PR.(.{4})", + + # A3 Kennung "INT" + # I4 Intervalldauer in Minuten + duration = "INT([0-9 ]{4})", + + # A1 Kennung "U"; nur bei den Produkten S2, S3, D2, D3, W1, W2, W3, W4, SM, + # SZ, SJ, SY, AM, %M, AZ, AJ, %J und %Y + # I1 Maßeinheit von "INT": 0 = Minuten, 1 = Tage + unit = "(U[01])?", + + # A2 Kennung "GP" + # A9 Anzahl der Pixel im Ausschnittsgebiet: " 900x 900" für nationale + # Komposits, „1100x 900“ für erweiterte nationale Komposits, "1500x1400" für + # mitteleuropäische Komposits (Bedeutung: 1500 Zeilen und 1400 Spalten (s.a. + # Kap. 3.2)) + n_pixel = "GP([0-9 x-]{9})", + + # A2 Kennung “VV“ (Vorhersagezeitpunkt) + # 1X,I3 Vorhersagezeitpunkt in Minuten nach der Messung + prediction = "(VV.[0-9 ]{3})?", + + # A2 Kennung “MF“ (Modul Flags) + # 1X,I8 Dezimalwert der entsprechenden Binärdarstellung (Erklärung s. beim Produkt RV) + flags = "(MF.[0-9]{8})?", + + # A2 Kennung "QN" (Quantifizierungsart) + # 1X,I3 definierte Quantifizierungen (s. nachfolgende Tabelle) + quantification = "(QN.[0-9 ]{3})?", + + # A2 Kennung "MS" + # I3 Textlänge m (max. 999) + text_length = "MS([0-9 ]{3})", + + # all the rest, not further split + rest = ".*" + ) + + # Enclose elements that do not yet contain parentheses in parentheses + pp <- unlist(patterns) + has_no_parentheses <- !grepl("\\(", pp) + pp[has_no_parentheses] <- paste0("(", pp[has_no_parentheses], ")") + + pp +} + +# get_radolan_metadata_from_header --------------------------------------------- +get_radolan_metadata_from_header <- function(bin_files, dbg = FALSE) +{ + bin_files %>% + sapply(read_binary_radolan_header, dbg = dbg) %>% + split_radolan_header() %>% + kwb.utils::resetRowNames() +} + +# get_radolan_timestamps ------------------------------------------------------- +get_radolan_timestamps <- function(bin_files, from = "headers") +{ + if (from == "headers") { + return(get_radolan_timestamps_from_headers(bin_files)) + } + + if (from == "filenames") { + return(get_radolan_timestamps_from_filenames(bin_files)) + } + + kwb.utils::stopFormatted( + "from must be one of 'headers', 'filenames' but was: '%s'", + from + ) +} + +# get_radolan_timestamps_from_filenames ---------------------------------------- +get_radolan_timestamps_from_filenames <- function(files) +{ + filenames <- basename(files) + + extensions <- unique(kwb.utils::fileExtension(filenames)) + + if (all(extensions %in% c("", "gz"))) { + + pattern <- "-([0-9]{10})-dwd---bin" + format <- "%y%m%d%H%M" + + } else if (all(extensions == "asc")) { + + pattern <- "_([0-9]{8}-[0-9]{4})\\.asc" + format <- "%Y%m%d-%H%M" + + } else { + + kwb.utils::stopFormatted( + "Any of file extension %s not supported.", + kwb.utils::stringList(extensions) + ) + } + + stopifnot(all(grepl(pattern, filenames))) + + timestrings <- kwb.utils::extractSubstring(pattern, filenames, index = 1L) + + as.POSIXct(timestrings, format = format, tz = "UTC") +} + +# get_radolan_timestamps_from_headers ------------------------------------------ +#' @importFrom kwb.utils pasteColumns resetRowNames +get_radolan_timestamps_from_headers <- function(bin_files, dbg = FALSE) +{ + # Read information on binary files from their headers + info <- get_radolan_metadata_from_header(bin_files, dbg = dbg) + + # Create the timestamps that the grids relate to + as.POSIXct( + kwb.utils::pasteColumns(info, c("mmyy", "ddHHMM")), + format = "%m%y %d%H%M", + tz = "UTC" + ) +} + +# get_regional_stats_from_radolan_asc_files ------------------------------------ +get_regional_stats_from_radolan_asc_files <- function( + asc_files, shape, blocksize = 24L, dbg = TRUE +) +{ + get_regional_stats_from_radolan_files( + asc_files, + shape = shape, + read_function = read_asc_file, + blocksize = blocksize, + dbg = dbg + ) +} + +# get_regional_stats_from_radolan_files ---------------------------------------- +get_regional_stats_from_radolan_files <- function( + files, + shape, + read_function, + ..., + blocksize = 24L, + dbg = TRUE, + run_parallel = TRUE, + method = 1L +) +{ + shape <- transform_coords(shape, get_radolan_projection_string()) + + # Create timestamps from file names + datetimes <- get_radolan_timestamps_from_filenames(files) + + block_indices <- data.frame(i = seq_along(files)) %>% + kwb.utils::splitIntoFixSizedBlocks(blocksize = blocksize) %>% + lapply(kwb.utils::selectColumns, "i") + + # Number of cores to use + ncores <- parallel::detectCores() - 1L + + # Can we do parallel processing? + do_run_parallel <- run_parallel && ncores > 1L + + # Prepare parallel processing if required + if (do_run_parallel) { + + cl <- parallel::makeCluster(ncores) + on.exit(parallel::stopCluster(cl)) + + } else { + + ncores <- 1L + } + + read_block_of_files <- function(block_no, method = 1L) { + + #block_no <- 1L + kwb.utils::catAndRun( + sprintf("Reading block %d of %d", block_no, length(block_indices)), + dbg = dbg, + expr = { + + indices <- block_indices[[block_no]] + + # Read files into raster objects using the given read function + grids <- lapply(files[indices], read_function, ...) + + if (method == 1L) { + + as.data.frame(do.call(rbind, lapply(grids, function(grid) { + grid %>% + raster::mask(shape) %>% + raster::crop(shape) %>% + raster_stats() + }))) + + } else if (method == 2L) { + + raster::stack(grids) %>% + raster::mask(shape) %>% + raster::crop(shape) %>% + lapply(raster_stats()) %>% + do.call(what = rbind) %>% + as.data.frame() + } + } + ) + } + + # Vector of indices to loop through + X <- seq_along(block_indices) + + # Call the read function in a (parallel or sequential) loop + result_list <- if (do_run_parallel) { + + parallel::parLapply(cl, X = X, fun = read_block_of_files) + + } else { + + lapply(X = X, FUN = read_block_of_files) + } + + do.call(rbind, result_list) %>% + kwb.utils::setColumns(datetime_utc = datetimes, dbg = FALSE) %>% + kwb.utils::moveColumnsToFront("datetime_utc") +} + +# split_radolan_header --------------------------------------------------------- +split_radolan_header <- function(x) +{ + pattern_parts <- get_radolan_header_patterns() + + pattern <- paste0(pattern_parts, collapse = "") + + index <- stats::setNames(seq_along(pattern_parts), names(pattern_parts)) + + kwb.utils::extractSubstring(pattern, x, index) +} + diff --git a/R/read_asc_gz_file.R b/R/read_asc_gz_file.R index a2c98e85..1db4e7ec 100644 --- a/R/read_asc_gz_file.R +++ b/R/read_asc_gz_file.R @@ -8,12 +8,15 @@ #' @export #' @importFrom kwb.utils callWith removeExtension tempSubdirectory #' @importFrom raster raster +#' @seealso +#' * [read_binary_radolan_file], +#' * [unzip_asc_gz_file]. read_asc_gz_file <- function(file, url = NULL) { target_dir <- if (is.null(url)) { dirname(file) } else { - temp_dir(template. = kwb.utils::removeExtension(url)) + temp_dir(template = kwb.utils::removeExtension(url)) } # Call the unzip function setting either "url" or "file" argument @@ -24,8 +27,38 @@ read_asc_gz_file <- function(file, url = NULL) #dir(target_dir) - # Provide a copy of the projection file in the download folder - provide_projection_file(grid_file) + # Read the .asc file into a raster object (with appropriate projection) + read_asc_file(grid_file) +} + +# read_asc_file ---------------------------------------------------------------- + +#' Read Raster Data from .ASC File +#' +#' @param file path to .asc file +#' @param projection projection string used in Radolan data. Currently not used! +#' @param dbg logical indicating whether to show debug messages +#' @importFrom kwb.utils catAndRun +#' @importFrom raster `crs<-` raster +read_asc_file <- function( + file, + projection = get_radolan_projection_string(), + dbg = TRUE +) +{ + kwb.utils::catAndRun( + sprintf("Reading %s using raster::raster()", basename(file)), + dbg = dbg, + expr = { + + # Provide a copy of the projection file in the same folder + provide_projection_file(file) + result <- raster::raster(file) - raster::raster(grid_file) + #result <- raster::raster(file, values = TRUE) + #raster::crs(result) <- projection + + result + } + ) } diff --git a/R/read_asc_gz_file_into_matrix.R b/R/read_asc_gz_file_into_matrix.R index af220834..3ed0bfc7 100644 --- a/R/read_asc_gz_file_into_matrix.R +++ b/R/read_asc_gz_file_into_matrix.R @@ -53,7 +53,7 @@ read_lines_from_gz_file <- function( encoding = getOption("encoding") ) { - assert_ending_gz(file) + assert_all_ending_with(file, ".gz") # If the file does not exist, treat it as an URL if (!file.exists(file)) { @@ -61,10 +61,11 @@ read_lines_from_gz_file <- function( assert_url(file, final_slash = FALSE) # Download file from URL to temporary directory - file <- download_if_not_there( + file <- download( file, - file.path(temp_dir(), basename(file)), - quiet = TRUE + target_dir = temp_dir(), + quiet = TRUE, + mode = "wb" ) } diff --git a/R/read_binary_radolan_file.R b/R/read_binary_radolan_file.R index 53d7b476..81a5f57e 100644 --- a/R/read_binary_radolan_file.R +++ b/R/read_binary_radolan_file.R @@ -3,18 +3,35 @@ #' Read Binary Radolan File #' #' @param path path to binary Radolan file -#' @param set_projection_and_extent if \code{TRUE} (default), the projection +#' @param set_projection_and_extent if `TRUE` (default), the projection #' and extent of the raster object are set to the Radolan specific values, -#' returned by \code{kwb.dwd::get_radolan_projection_string()} and -#' \code{kwb.dwd::get_radolan_extension()}, respectively. +#' returned by `kwb.dwd::get_radolan_projection_string` and +#' `kwb.dwd::get_radolan_extension`, respectively. +#' @param consider_flags logical. Should the flags be considered? If +#' `TRUE`, values where the "invalid" or "clutter" flag is set are set to +#' `NA` and values where the "negative" flag is set are negated. The +#' default is `TRUE` (for compatibility reasons) but this should change +#' in future! #' @export #' @importFrom sp CRS #' @importFrom raster extent -read_binary_radolan_file <- function(path, set_projection_and_extent = TRUE) +#' @seealso +#' * [read_asc_gz_file], +#' * [read_relevant_years_radolan]. +read_binary_radolan_file <- function( + path, + set_projection_and_extent = TRUE, + consider_flags = FALSE +) { # Read raw data values rbi <- read_binary_radolan_file_raw(path) + # Consider flags, set e.g. invalid values to NA if requested + if (consider_flags) { + rbi <- consider_flags(rbi) + } + # Convert raw data values to raster rb <- radolan_raw_to_raster(rbi) @@ -37,7 +54,26 @@ read_binary_radolan_file <- function(path, set_projection_and_extent = TRUE) #' @examples #' get_radolan_extension() #' +#' @seealso +#' * [get_radolan_urls], +#' * [get_radolan_projection_string]. get_radolan_extension <- function() { c(-523.4622, 376.5378, -4658.645, -3758.645) } + +# consider_flags --------------------------------------------------------------- +#' @importFrom kwb.utils getAttribute +consider_flags <- function(x, flags = kwb.utils::getAttribute(x, "flags")) +{ + bit_is_set <- function(x, bit) bitwAnd(x, 2^(bit - 1L)) > 0L + + is_invalid <- bit_is_set(flags, 14L) + is_negative <- bit_is_set(flags, 15L) + is_clutter <- bit_is_set(flags, 16L) + + x[is_negative] <- -x[is_negative] + x[is_invalid | is_clutter] <- NA + + x +} diff --git a/R/read_binary_radolan_file_raw.R b/R/read_binary_radolan_file_raw.R index e68b7d96..6ef5a802 100644 --- a/R/read_binary_radolan_file_raw.R +++ b/R/read_binary_radolan_file_raw.R @@ -21,7 +21,7 @@ read_binary_radolan_file_raw_v1 <- function(path) { header_end <- regexpr("\003", readLines(path, 1, warn = FALSE)) - rb_stream <- file(path, "rb") + rb_stream <- open_for_reading_in_binary_mode(path) on.exit(close(rb_stream)) skip_temp <- readBin(rb_stream, "raw", n = header_end, endian = "little") @@ -51,8 +51,7 @@ read_binary_radolan_file_raw_v2 <- function(path) # Read the header from the file header <- read_binary_radolan_header(path) - # Open file for binary reading - stream <- file(path, "rb") + stream <- open_for_reading_in_binary_mode(path) # Close file on exit on.exit(close(stream)) @@ -83,16 +82,15 @@ read_binary_radolan_file_raw_v2 <- function(path) read_binary_radolan_file_raw_v3 <- function(path) { # Read the header from the file - header <- read_binary_radolan_header(path) + header <- read_binary_radolan_header(path, dbg = FALSE) - # Open file for binary reading - stream <- file(path, "rb") + stream <- open_for_reading_in_binary_mode(path) # Close file on exit on.exit(close(stream)) # Skip the header - readBin(stream, "raw", nchar(header) + 1) + readBin(stream, "raw", nchar(header) + 1L) # We expect to find 900 x 900 in the header stopifnot(grepl(" 900x 900", header)) @@ -102,7 +100,11 @@ read_binary_radolan_file_raw_v3 <- function(path) # Read integer values of two bytes each integers <- readBin( - stream, "integer", n = n_integers, size = 2, signed = FALSE, + stream, + what = "integer", + n = n_integers, + size = 2, + signed = FALSE, endian = "little" ) @@ -111,27 +113,32 @@ read_binary_radolan_file_raw_v3 <- function(path) } # read_binary_radolan_header --------------------------------------------------- -read_binary_radolan_header <- function(path, buffer_size = 1024L) +read_binary_radolan_header <- function(path, buffer_size = 1024L, dbg = FALSE) { - # Open file for binary reading - stream <- file(path, "rb") + stream <- open_for_reading_in_binary_mode(path) # Close file on exit on.exit(close(stream)) - # Read the first bytes into a buffer - buffer <- readBin(stream, "raw", buffer_size) - - # Which byte indicates the end of the header? - is_end_of_header <- buffer == 0x03 - - if (! any(is_end_of_header)) { - clean_stop( - "Could not find a byte '0x03' indicating the end of the header\n", - "within the first ", buffer_size, " bytes of the file\n", path, "." - ) - } - - # Get the header information as character string - rawToChar(buffer[seq_len(which(is_end_of_header)[1] - 1)]) + kwb.utils::catAndRun( + paste("Reading header from binary file", basename(path)), + dbg = dbg, + expr = { + # Read the first bytes into a buffer + buffer <- readBin(stream, "raw", buffer_size) + + # Which byte indicates the end of the header? + is_end_of_header <- buffer == 0x03 + + if (!any(is_end_of_header)) { + clean_stop( + "Could not find a byte '0x03' indicating the end of the header\n", + "within the first ", buffer_size, " bytes of the file\n", path, "." + ) + } + + # Get the header information as character string + rawToChar(buffer[seq_len(which(is_end_of_header)[1L] - 1L)]) + } + ) } diff --git a/R/read_daily_data_over_shape.R b/R/read_daily_data_over_shape.R deleted file mode 100644 index 2dd0fa22..00000000 --- a/R/read_daily_data_over_shape.R +++ /dev/null @@ -1,176 +0,0 @@ -# read_daily_data_over_shape --------------------------------------------------- - -#' Read daily data from DWD, mask region with given shape file -#' -#' Currently, only full months of data can be loaded, \code{from} and \code{to} -#' must be given -#' -#' @param file path to shape file .shp -#' @param variable currently, the following variables are supported: "evapo_p", -#' "evapo_r", "frost_depth", "soil_moist", "soil_temperature_5cm" -#' @param from first month as "yyyymm" string -#' @param to last month as "yyyymm" string -#' @param quiet passed to \code{\link{download.file}} -#' @return data frame -#' @export -read_daily_data_over_shape <- function(file, variable, from, to, quiet = FALSE) -{ - # Define scaling factors per variable. Depending on the variable, the values - # in the data files need to be multiplied with a scaling factor. - - scales <- get_scaling_factors() - - variable <- match.arg(variable, names(scales)) - - # Select the appropriate scaling factor - scale <- kwb.utils::selectElements(scales, variable) - - # Read shape file and transform to projection used in DWD's grid files - shape <- read_shape_with_dwd_projection(file) - - # Download and extract files from URLs to .tgz files on DWD server - grid_files <- download_daily_grids_germany(variable, from, to, quiet = quiet) - - # Read data within shape from all grid files - get_daily_data_from_grid_files(grid_files, shape, scale) -} - -# read_shape_with_dwd_projection ----------------------------------------------- -read_shape_with_dwd_projection <- function(file, ...) -{ - # Read example grid from DWD, just to get its projection string - example_grid <- get_example_grid_germany() - - # Read the shape file, transforming the projection to DWD's projection - read_shape_file(file, target_crs = example_grid@crs, ...) -} - -# read_shape_file -------------------------------------------------------------- -read_shape_file <- function( - file, - target_crs = NULL, - use_sf = FALSE, - drop_z = FALSE, - as_spatial = FALSE -) -{ - # Stop if this is not a shape file - stopifnot(identical(tolower(kwb.utils::fileExtension(file)), "shp")) - - # Read the shape file - shape <- if (use_sf) { - sf::st_read(file) - } else { - rgdal::readOGR(file) - } - - # Transform to coordinate reference system if given - if (!is.null(target_crs)) { - shape <- if (use_sf) { - sf::st_transform(shape, target_crs) - } else { - sp::spTransform(shape, target_crs) - } - } - - # Drop z dimensions if desired - if (drop_z) { - shape <- sf::st_zm(shape) - } - - # Convert to Spatial* object if desired - if (as_spatial) { - shape <- sf::as_Spatial(shape) - } - - shape -} - -# get_daily_data_from_grid_files ----------------------------------------------- -get_daily_data_from_grid_files <- function(grid_files, shape, scale) -{ - # For each file, provide a projection (.prj) file containing DWD's projection - lapply(grid_files, provide_projection_file) - - # Read the grids, together with the projection - grids <- lapply(grid_files, function(file) { - kwb.utils::catAndRun(paste("Reading", file), raster::raster(file)) - }) - - # Provide file metadata (file, year, month, day) - metadata <- extract_metadata_from_files_daily(files = grid_files) - - # Mask the full grid over Germany with the shape and crop the grid - grids <- mask_and_crop_grids(grids, shape) - - # Calculate statistics, considering the conversion factor "scale" - data <- do.call(rbind, lapply(grids, raster_stats, scale = scale)) - - # Add metadata - cbind(metadata, data) -} - -# extract_metadata_from_files_daily -------------------------------------------- -extract_metadata_from_files_daily <- function(files) -{ - extract_metadata_from_files(files, is_daily = TRUE) -} - -# extract_metadata_from_files_monthly ------------------------------------------ -extract_metadata_from_files_monthly <- function(files) -{ - extract_metadata_from_files(files, is_daily = FALSE) -} - -# extract_metadata_from_files -------------------------------------------------- -extract_metadata_from_files <- function(files, is_daily) -{ - base_names <- basename(files) - - date_parts <- if (is_daily) { - kwb.utils::extractSubstring( - pattern = "_(\\d{4})(\\d{2})(\\d{2})\\.", - base_names, - c(year = 1L, month = 2L, day = 3L) - ) - } else { - kwb.utils::extractSubstring( - pattern = "_(\\d{4})(\\d{2})\\.", - base_names, - c(year = 1L, month = 2L) - ) - } - - date_parts <- as.data.frame(lapply(date_parts, as.integer)) - - date_strings <- if (is_daily) { - sprintf( - "%04d-%02d-%02d", - date_parts$year, date_parts$month, date_parts$day - ) - } else { - sprintf( - "%04d-%02d-01", - date_parts$year, date_parts$month - ) - } - - metadata <- kwb.utils::noFactorDataFrame( - file = base_names, - date = as.Date(date_strings) - ) - - cbind(metadata, date_parts) -} - -# mask_and_crop_grids ---------------------------------------------------------- -mask_and_crop_grids <- function(grids, shape, dbg = TRUE) -{ - lapply(grids, function(grid) { - kwb.utils::catAndRun( - paste("Masking and cropping", grid@data@names), - raster::crop(raster::mask(grid, shape), shape), - dbg = dbg - ) - }) -} diff --git a/R/read_data_over_shape.R b/R/read_data_over_shape.R new file mode 100644 index 00000000..a30cd163 --- /dev/null +++ b/R/read_data_over_shape.R @@ -0,0 +1,226 @@ +# read_monthly_data_over_shape ------------------------------------------------- + +#' Read monthly data from DWD, mask region with given shape file +#' +#' @inheritParams read_data_over_shape +#' @return data frame +#' @export +#' @seealso +#' * [read_binary_radolan_file], +#' * [read_asc_gz_file], +#' * [read_relevant_years_radolan], +#' * [read_daily_data_over_shape]. +read_monthly_data_over_shape <- function( + file = NULL, + variable, + from, + to, + quiet = FALSE, + shape = NULL, + use_sf = TRUE, + ... +) +{ + read_data_over_shape( + "monthly", file, variable, from, to, quiet, shape, use_sf, ... + ) +} + +# read_daily_data_over_shape --------------------------------------------------- + +#' Read daily data from DWD, mask region with given shape file +#' +#' Currently, only full months of data can be loaded, `from` and `to` +#' must be given +#' +#' @inheritParams read_data_over_shape +#' @return data frame +#' @export +#' @seealso +#' * [read_monthly_data_over_shape], +#' * [read_binary_radolan_file], +#' * [read_asc_gz_file], +#' * [read_relevant_years_radolan]. +read_daily_data_over_shape <- function(file, variable, from, to, quiet = FALSE) +{ + read_data_over_shape( + "daily", file, variable, from, to, quiet = quiet + ) +} + +# read_data_over_shape --------------------------------------------------------- + +#' Read data from DWD, mask region with given shape file or spatial object +#' +#' @param file path to shape file .shp +#' @param resolution one of "daily", "monthly" +#' @param variable currently, the following variables are supported: "evapo_p", +#' "evapo_r", "frost_depth", "soil_moist", "soil_temperature_5cm" (daily), +#' "evapo_p" (monthly) +#' @param from first month as "yyyymm" string +#' @param to last month as "yyyymm" string +#' @param quiet passed to [download.file] +#' @param shape object of class sf or sf_layers or SpatialPolygonsDataFrame. +#' If `NULL` (the default), this object is obtained by calling +#' `kwb.dwd:::read_shape_file` on `file`. +#' @param use_sf passed to `kwb.dwd:::read_shape_file` if applicable +#' @param \dots further arguments passed to `kwb.dwd:::read_shape_file`, +#' such as `drop_z = TRUE`, if applicable +#' @return data frame +#' @export +read_data_over_shape <- function( + resolution, + file, + variable, + from, + to, + quiet = FALSE, + shape = NULL, + use_sf = TRUE, + ... +) +{ + # Define scaling factors per variable. Depending on the variable, the values + # in the data files need to be multiplied with a scaling factor. + scales <- get_scaling_factors() + + variable <- match.arg(variable, names(scales)) + + # Select the appropriate scaling factor + scale <- kwb.utils::selectElements(scales, variable) + + # If no spatial object is given in shape and if a shape file is given, read + # a spatial object from the shape file and transform it to the coordinate + # system used in the grids provided by DWD + if (is.null(shape) && !is.null(file)) { + + # Read shape file (and transform to projection used in DWD's grid files) + shape <- if (resolution == "monthly") { + + read_shape_file(file, use_sf = use_sf, ...) + + } else if (resolution == "daily") { + + read_shape_with_dwd_projection(file) + } + } + + # Download (and extract) files from DWD server + grid_files <- download_grids_germany( + resolution, variable, from, to, quiet = quiet + ) + + # Read data within shape from all grid files + get_data_from_grid_files(resolution, grid_files, shape, scale, use_sf) +} + +# read_shape_with_dwd_projection ----------------------------------------------- +read_shape_with_dwd_projection <- function(file, ...) +{ + # Read example grid from DWD, just to get its projection string + example_grid <- get_example_grid_germany() + + # Read the shape file, transforming the projection to DWD's projection + read_shape_file(file, target_crs = example_grid@srs, ...) +} + +# get_data_from_grid_files ----------------------------------------------------- +get_data_from_grid_files <- function( + resolution, grid_files, shape, scale, use_sf +) +{ + # Define read functions for different file formats (depending on resolution) + read_functions <- list( + daily = read_asc_file, + monthly = read_asc_gz_file + ) + + # Select the suitable read function + read <- kwb.utils::selectElements(read_functions, resolution) + + # Read the files into RasterLayer objects with DWD projection + grids <- lapply(grid_files, read) + + # If a shape is given, mask the full grid over Germany with the shape and crop + # the grid + if (!is.null(shape) && length(grids)) { + + # Transform the spatial object to the coordinate system used in the grids + shape <- transform_coords( + shape, + target_crs = grids[[1L]]@crs, + use_sf = use_sf + ) + + grids <- mask_and_crop_grids(grids, shape) + } + + # Provide file metadata (file, year, month[, day]) + metadata <- extract_metadata_from_files(files = grid_files, resolution) + + # Calculate statistics, considering the scaling factor, add metadata + cbind(metadata, summarise_over_all_grids(grids, scale)) +} + +# summarise_over_all_grids ----------------------------------------------------- +summarise_over_all_grids <- function(grids, scale) +{ + do.call(rbind, lapply(grids, raster_stats, scale = scale)) +} + +# extract_metadata_from_files -------------------------------------------------- +extract_metadata_from_files <- function(files, resolution) +{ + # Define arguments to functions, based on time resolution + parameters_by_resolution <- list( + daily = list( + pattern = "_(\\d{4})(\\d{2})(\\d{2})\\.", + index = c(year = 1L, month = 2L, day = 3L), + date_format = "%04d-%02d-%02d" + ), + monthly = list( + pattern = "_(\\d{4})(\\d{2})\\.", + index = c(year = 1L, month = 2L), + date_format = "%04d-%02d-01" + ) + ) + + get_element <- kwb.utils::selectElements + + # Select parameters based on given time resolution + parameters <- get_element(parameters_by_resolution, resolution) + + # Provide arguments for the following extractSubstring() call + pattern <- get_element(parameters, "pattern") + base_names <- basename(files) + index <- get_element(parameters, "index") + + # Call extractSubstring() to split the file names into parts + date_parts <- kwb.utils::extractSubstring(pattern, base_names, index) + + date_parts <- as.data.frame(lapply(date_parts, as.integer)) + + date_strings <- do.call(sprintf, args = c( + list(get_element(parameters, "date_format")), + date_parts[names(index)] + )) + + metadata <- kwb.utils::noFactorDataFrame( + file = base_names, + date = as.Date(date_strings) + ) + + cbind(metadata, date_parts) +} + +# mask_and_crop_grids ---------------------------------------------------------- +mask_and_crop_grids <- function(grids, shape, dbg = TRUE) +{ + lapply(grids, function(grid) { + kwb.utils::catAndRun( + paste("Masking and cropping", grid@data@names), + raster::crop(raster::mask(grid, shape), shape), + dbg = dbg + ) + }) +} diff --git a/R/read_hourly_radolan_historical_bin_for_region.R b/R/read_hourly_radolan_historical_bin_for_region.R new file mode 100644 index 00000000..5262d0a7 --- /dev/null +++ b/R/read_hourly_radolan_historical_bin_for_region.R @@ -0,0 +1,58 @@ +# read_hourly_radolan_historical_bin_for_region -------------------------------- +read_hourly_radolan_historical_bin_for_region <- function( + from = NULL, + to = NULL, + shape = NULL, + year = NULL, + dbg = TRUE, + blocksize = 24L, + run_parallel = TRUE, + ... +) +{ + #kwb.utils::assignPackageObjects("kwb.dwd") + #kwb.utils::assignArgumentDefaults(kwb.dwd:::read_hourly_radolan_historical_bin_for_region) + #year <- 2009L + #`%>%` <- magrittr::`%>%` + #shape <- kwb.dwd:::get_shape_of_german_region("berlin") + + if (!is.null(year)) { + stopifnot(is.integer(year), length(year) == 1L) + } + + bin_files <- list_extracted_radolan_files( + from = kwb.utils::defaultIfNULL(from, paste0(year, "01")), + to = kwb.utils::defaultIfNULL(to, paste0(year, "12")), + resolution = "hourly", + format = "bin" + ) + + #file_sizes_mib <- file.size(bin_files)/2^20 + #max(which(cumsum(file_sizes_mib) <= 1024)) + #sum(file_sizes_mib[1:663]) + + # Read data from binary files + kwb.utils::catAndRun( + sprintf("Reading data from %d binary files", length(bin_files)), + dbg = dbg, + get_regional_stats_from_radolan_bin_files( + bin_files, + shape = shape, + blocksize = blocksize, + run_parallel = run_parallel + , ... + ) + ) +} + +# get_regional_stats_from_radolan_bin_files ------------------------------------ +get_regional_stats_from_radolan_bin_files <- function(bin_files, shape, ...) +{ + get_regional_stats_from_radolan_files( + bin_files, + shape = shape, + read_function = read_binary_radolan_file, + consider_flags = TRUE, + ... + ) +} diff --git a/R/read_monthly_data_over_shape.R b/R/read_monthly_data_over_shape.R deleted file mode 100644 index 77925951..00000000 --- a/R/read_monthly_data_over_shape.R +++ /dev/null @@ -1,44 +0,0 @@ -# read_monthly_data_over_shape ------------------------------------------------- - -#' Read monthly data from DWD, mask region with given shape file -#' -#' @param file path to shape file .shp -#' @param variable currently only "evapo_p" is supported -#' @param from first month as "yyyymm" string -#' @param to last month as "yyyymm" string -#' @param \dots further arguments passed to \code{kwb.dwd:::read_shape_file}, -#' such as \code{drop_z = TRUE, use_sf = TRUE} -#' @return data frame -#' @export -read_monthly_data_over_shape <- function(file, variable, from, to, ...) -{ - # Define scaling factors per variable. Depending on the variable, the values - # in the data files need to be multiplied with a scaling factor. - scales <- get_scaling_factors() - - variable <- match.arg(variable, names(scales)) - - # Select the appropriate scaling factor - scale <- kwb.utils::selectElements(scales, variable) - - # Read shape file and transform to projection used in DWD's grid files - shape <- read_shape_with_dwd_projection(file, ...) - - # Download files from DWD server - grid_files <- download_monthly_grids_germany(variable, from, to) - - # Read the files into RasterLayer objects with DWD projection - grids <- lapply(grid_files, read_asc_gz_file) - - # Mask the full grid over Germany with the shape and crop the grid - grids <- mask_and_crop_grids(grids, shape) - - # Calculate statistics, considering the conversion factor "scale" - data <- do.call(rbind, lapply(grids, raster_stats, scale = scale)) - - # Provide file metadata (file, year, month) - metadata <- extract_metadata_from_files_monthly(files = grid_files) - - # Add metadata - cbind(metadata, data) -} diff --git a/R/read_relevant_years_radolan.R b/R/read_relevant_years_radolan.R index 57f62305..3eac7d24 100644 --- a/R/read_relevant_years_radolan.R +++ b/R/read_relevant_years_radolan.R @@ -11,6 +11,8 @@ #' @importFrom kwb.utils left #' @importFrom raster stack #' @importFrom stats setNames +#' @seealso +#' * [read_binary_radolan_file]. read_relevant_years_radolan <- function(path, years) { stopifnot(is.numeric(years)) @@ -24,8 +26,7 @@ read_relevant_years_radolan <- function(path, years) # Get paths of files matching the pattern files <- list.files(path, pattern, full.names = TRUE, recursive = TRUE) - if (length(files) == 0) { - + if (length(files) == 0L) { message(sprintf("No files found that match '%s'", pattern)) return() } diff --git a/R/read_shape_file.R b/R/read_shape_file.R new file mode 100644 index 00000000..5b90e460 --- /dev/null +++ b/R/read_shape_file.R @@ -0,0 +1,50 @@ +# read_shape_file -------------------------------------------------------------- +#' @importFrom kwb.utils fileExtension +#' @importFrom rgdal readOGR +#' @importFrom sf as_Spatial st_read st_zm +read_shape_file <- function( + file, + target_crs = NULL, + use_sf = FALSE, + drop_z = FALSE, + as_spatial = FALSE +) +{ + # Stop if this is not a shape file + stopifnot(identical(tolower(kwb.utils::fileExtension(file)), "shp")) + + # Read the shape file + shape <- if (use_sf) { + sf::st_read(file) + } else { + rgdal::readOGR(file) + } + + # Transform to target coordinate reference system if given + shape <- transform_coords(shape, target_crs, use_sf) + + # Drop z dimensions if desired + if (drop_z) { + shape <- sf::st_zm(shape) + } + + # Convert to Spatial* object if desired + if (as_spatial) { + shape <- sf::as_Spatial(shape) + } + + shape +} + +#' # read_shape_file_2 ------------------------------------------------------------ +#' #' @importFrom rgdal readOGR +#' read_shape_file_2 <- function(file) +#' { +#' # TODO: Look here: https://r-spatial.org/r/2022/04/12/evolution.html +#' rgdal::readOGR( +#' dsn = file, +#' stringsAsFactors = FALSE, +#' encoding = "UTF-8", +#' use_iconv = TRUE +#' ) +#' } diff --git a/R/select_shapes.R b/R/select_shapes.R index 7308774d..d8d53131 100644 --- a/R/select_shapes.R +++ b/R/select_shapes.R @@ -3,13 +3,14 @@ #' Interactively Configure Selection of SpatialPolygons #' #' @param shapes list of SpatialPolygonsDataFrame objects, as e.g. returned by -#' \code{\link{get_shapes_of_germany}} -#' @return list with elements \code{index} (index of SpatialPolygonsDataFrame in -#' \code{shapes} list), \code{variable} (column in selected -#' SpatialPolygonsDataFrame), \code{pattern} pattern (e.g. the name of a city) -#' to be matched against the values in the selected column of the -#' selected SpatialPolygonsDataFrame. This list simply describes how to select -#' a SpatialPolygon from a list of SpatialPolygonsDataFrames +#' [get_shapes_of_germany] +#' @return list with elements +#' * `index` (index of SpatialPolygonsDataFrame in `shapes` list), +#' * `variable` (column in selected SpatialPolygonsDataFrame), +#' * `pattern` pattern (e.g. the name of a city) +#' to be matched against the values in the selected column of the selected +#' SpatialPolygonsDataFrame. This list simply describes how to select a +#' SpatialPolygon from a list of SpatialPolygonsDataFrames select_shapes <- function(shapes) { # Let the user select a SpatialPolygonsDataFrame (by name of .shp file) @@ -29,8 +30,12 @@ select_shapes <- function(shapes) pattern = pattern ) - cat("Code to create this configuration:\n") - cat("config <-", kwb.utils::objectToText(result)) + writeLines(c( + "***", + "# Code to create this configuration:", + paste("config <-", kwb.utils::objectToText(result)), + "***" + )) result } diff --git a/R/transform_coords.R b/R/transform_coords.R new file mode 100644 index 00000000..1fedbf4e --- /dev/null +++ b/R/transform_coords.R @@ -0,0 +1,16 @@ +# transform_coords ------------------------------------------------------------- +transform_coords <- function(x, target_crs = NULL, use_sf = inherits(x, "sf")) +{ + if (is.null(target_crs)) { + return(x) + } + + if (use_sf) { + + sf::st_transform(x, target_crs) + + } else { + + sp::spTransform(x, target_crs) + } +} diff --git a/R/try_to_get_url.R b/R/try_to_get_url.R index 6b678a0c..522a7447 100644 --- a/R/try_to_get_url.R +++ b/R/try_to_get_url.R @@ -6,7 +6,7 @@ #' @param timeout timeout (default: NULL) #' @param sleep_time sleep time (default: 5) #' @param user_pwd user password (default: NULL) -#' @param ... additional arguments passed to \code{RCurl::getURL} +#' @param ... additional arguments passed to [RCurl::getURL] #' @param dbg debug (default: TRUE) #' #' @return ??? diff --git a/R/unzip.R b/R/unzip.R new file mode 100644 index 00000000..5b7db89a --- /dev/null +++ b/R/unzip.R @@ -0,0 +1,105 @@ +# unzip_asc_gz_file ------------------------------------------------------------ + +#' Download a .gz File and Unzip it +#' +#' @param file path to asc.gz file to be unzipped or URL from which the file is +#' to be downloaded first +#' @param target_dir path to folder into which to (if applicable, download and) +#' unzip the file +#' @return path to the unzipped file +#' @export +#' @importFrom kwb.utils removeExtension +#' @seealso +#' * [read_binary_radolan_file], +#' * [convert_bin_to_raster_file], +#' * [read_asc_gz_file], +#' * [write_raster_to_file]. +unzip_asc_gz_file <- function(file, target_dir = tempdir()) +{ + # Path to the target file + target <- file.path(target_dir, remove_right(basename(file), nchar(".gz"))) + + # Read text lines from (remote or local) .gz file and write to target file + writeLines(read_lines_from_gz_file(file), target) + + # Return the path to the created file + target +} + +# unzip_tar_file --------------------------------------------------------------- +unzip_tar_file <- function(file, target_dir) +{ + relative_paths <- list_zipped_files(file) + + utils::untar(file, exdir = target_dir) + + # Return the paths to the extracted files + file.path(target_dir, relative_paths) +} + +# unzip_tar_gz_file ------------------------------------------------------------ +unzip_tar_gz_file <- function(file, target_dir) +{ + stopifnot(length(file) == 1L) + stopifnot(file.exists(file)) + stopifnot(endsWith(file, ".tar.gz")) + + # Check and expand directory path (e.g. replace tilde with home directory) + target_dir <- path.expand(kwb.utils::safePath(target_dir)) + + # Get the names of the files contained in the zip archive + zipped_files <- list_zipped_files(file) + + # Relative paths to existing files in export directory + existing_files <- dir(target_dir, recursive = TRUE) + + # Files in the zip file that need to be extracted + files_to_extract <- setdiff(zipped_files, existing_files) + + # Paths to all unzipped files + target_files <- file.path(target_dir, zipped_files) + + if (length(files_to_extract) == 0L) { + + writeLines(sprintf( + "\nNothing to do. All files in\n %s\nare already in\n %s.", + file, + target_dir + )) + + return(target_files) + } + + # Extract all those files that do not yet exist in the export directory + kwb.utils::catAndRun( + messageText = sprintf( + "\nUnzipping %d files from\n %s\nto\n %s", + length(files_to_extract), + file, + target_dir + ), + expr = utils::untar( + file, + files = files_to_extract, + exdir = target_dir + ) + ) + + # If the extracted file is a .tar file, extract that file and remove it + if (length(target_files) == 1L && endsWith(target_files, ".tar")) { + tar_file <- target_files + target_files <- unzip_tar_file(tar_file, target_dir = target_dir) + unlink(tar_file) + } + + # Return the paths to the unzipped files + target_files +} + +# unzip_zip_file --------------------------------------------------------------- +unzip_zip_file <- function(file, target_dir) +{ + paths <- archive::archive_extract(file, dir = target_dir) + + file.path(target_dir, paths) +} diff --git a/R/unzip_asc_gz_file.R b/R/unzip_asc_gz_file.R deleted file mode 100644 index eb88105a..00000000 --- a/R/unzip_asc_gz_file.R +++ /dev/null @@ -1,22 +0,0 @@ -# unzip_asc_gz_file ------------------------------------------------------------ - -#' Download a .gz File and Unzip it -#' -#' @param file path to asc.gz file to be unzipped or URL from which the file is -#' to be downloaded first -#' @param target_dir path to folder into which to (if applicable, download and) -#' unzip the file -#' @return path to the unzipped file -#' @export -#' @importFrom kwb.utils removeExtension -unzip_asc_gz_file <- function(file, target_dir = tempdir()) -{ - # Path to the target file - target <- file.path(target_dir, kwb.utils::removeExtension(basename(file))) - - # Read text lines from (remote or local) .gz file and write to target file - writeLines(read_lines_from_gz_file(file), target) - - # Return the path to the created file - target -} diff --git a/R/utils.R b/R/utils.R index 2cd6e967..f9377623 100644 --- a/R/utils.R +++ b/R/utils.R @@ -6,10 +6,10 @@ add_attributes <- function(x, attrs) do.call(structure, c(list(x), attrs)) } -# assert_ending_gz ------------------------------------------------------------- -assert_ending_gz <- function(x) +# assert_all_ending_with ------------------------------------------------------------- +assert_all_ending_with <- function(x, suffix) { - stopifnot(all(endsWith(x, ".gz"))) + stopifnot(all(endsWith(x, suffix))) invisible(x) } @@ -54,6 +54,22 @@ clean_stop <- function(...) stop(..., call. = FALSE) } +# contains_file ---------------------------------------------------------------- +contains_file <- function(path, pattern) +{ + length(dir(path, pattern)) > 0L +} + +# copy_file -------------------------------------------------------------------- +copy_file <- function(from, to) +{ + success <- file.copy(from = from, to = to) + + if (!all(success)) { + kwb.utils::stopFormatted("Could not copy %s to %s", from, to) + } +} + # date_in_bathing_season ------------------------------------------------------- #' @importFrom lubridate month date_in_bathing_season <- function(x) @@ -62,44 +78,70 @@ date_in_bathing_season <- function(x) lubridate::month(x) %in% 5:9 } -# download_if_not_there -------------------------------------------------------- -download_if_not_there <- function( +# download_dir ----------------------------------------------------------------- +download_dir <- function(...) +{ + ifelse(on_windows(), "~/../Downloads", "~/Downloads") %>% + path.expand() %>% + file.path(...) %>% + kwb.utils::createDirectory(dbg = FALSE) +} + +# download --------------------------------------------------------------------- +download <- function( url, - file = file.path(tempdir(), basename(url)), - quiet = FALSE + file = file.path(target_dir, basename(url)), + target_dir = download_dir(), + quiet = FALSE, + mode = "w", + timeout = getOption("timeout") ) { if (file.exists(file)) { - cat("File already available:", file, "\n") - } else { - download.file(url, file, method = "auto", quiet = quiet) + kwb.utils::catIf(!quiet, "\nFile already there:", file, "\n") + return(file) } - file -} + # Temporarily set the timeout option + old_options <- options(timeout = timeout) + on.exit(options(old_options)) + + result <- kwb.utils::catAndRun( + sprintf("\nDownloading\n %s\nto\n %s", url, file), + dbg = !quiet, + expr = try( + silent = TRUE, + download.file( + url = url, + destfile = file, + method = "auto", + quiet = TRUE, + mode = mode + ) + ) + ) -# extract_yyyymm --------------------------------------------------------------- -extract_yyyymm <- function(x) -{ - gsub("^.*(\\d{6}).*$", "\\1", basename(x)) -} + if (kwb.utils::isTryError(result) || !identical(result, 0L)) { -# filter_by_extension ---------------------------------------------------------- -filter_by_extension <- function(x, extension) -{ - x[endsWith(x, extension)] -} + if (file.exists(file)) { + if (!identical(unlink(file), 0L)) { + message("Could not delete incompletely downloaded file: ", file) + } + } -# filter_by_extension_asc_gz --------------------------------------------------- -filter_by_extension_asc_gz <- function(x) -{ - filter_by_extension(x, ".asc.gz") + kwb.utils::stopFormatted( + "Could not download %s within %d seconds.\n%s", + url, timeout, as.character(result) + ) + } + + file } -# filter_by_extension_tgz ------------------------------------------------------ -filter_by_extension_tgz <- function(x) +# filter_by_extension ---------------------------------------------------------- +filter_by_extension <- function(x, extension) { - filter_by_extension(x, ".tgz") + x[endsWith(tolower(x), tolower(extension))] } # filter_by_month_range -------------------------------------------------------- @@ -109,12 +151,15 @@ filter_by_month_range <- function(urls, from = NULL, to = NULL) return(urls) } - from <- kwb.utils::defaultIfNULL(from, extract_yyyymm(urls[1L])) - to <- kwb.utils::defaultIfNULL(to, extract_yyyymm(urls[length(urls)])) + extract_year_month <- function(x) gsub("^.*(\\d{6}).*$", "\\1", basename(x)) + + first_url <- urls[1L] + last_url <- urls[length(urls)] - pattern <- paste(month_sequence_simple(from, to), collapse = "|") + from <- kwb.utils::defaultIfNULL(from, extract_year_month(first_url)) + to <- kwb.utils::defaultIfNULL(to, extract_year_month(last_url)) - urls[grep(pattern, urls)] + grep(month_range_pattern(from, to), urls, value = TRUE) } # get_date_time_from_bin_filename ---------------------------------------------- @@ -143,6 +188,39 @@ get_element_or_stop <- function(x, element, name = deparse(substitute(element))) x[safe_element(element, names(x), name)] } +# get_full_extension ----------------------------------------------------------- +get_full_extension <- function(x) +{ + parts <- lapply(strsplit(x, "\\."), rev) + + result <- extension <- character(length(x)) + + n_parts <- lengths(parts) + + selected <- n_parts > 1L + result[selected] <- sapply(parts[selected], "[", 1L) + + selected <- n_parts > 2L + extension[selected] <- sapply(parts[selected], "[", 2L) + + is_no_extension <- grepl("(^[0-9]+$)|[_-]", extension) + + extension[is_no_extension] <- "" + selected <- extension != "" + result[selected] <- paste0(extension[selected], ".", result[selected]) + + result +} + +# get_relative_path ------------------------------------------------------------ +get_relative_path <- function( + file, + base_dir = kwb.utils::getAttribute(file, "base_dir") +) +{ + remove_left(file, nchar(kwb.utils::assertFinalSlash(base_dir))) +} + # indicate_directories --------------------------------------------------------- #' @importFrom kwb.utils assertFinalSlash indicate_directories <- function(x, is_directory) @@ -161,10 +239,10 @@ is_empty <- function(x) (is.data.frame(x) && nrow(x) == 0L) || (length(x) == 0L) } -# last_month_as_yyyymm --------------------------------------------------------- -last_month_as_yyyymm <- function() +# last_month ------------------------------------------------------------------- +last_month <- function(format = "%Y%m") { - format(Sys.Date() - 31L, "%Y%m") + format.Date(Sys.Date() - 31L, format) } # list_files_in_zip_files ------------------------------------------------------ @@ -172,86 +250,104 @@ last_month_as_yyyymm <- function() #' @importFrom utils untar list_files_in_zip_files <- function(zip_files, dbg = TRUE) { - do.call(rbind, lapply(zip_files, function(x) { + list_files <- function(file) { kwb.utils::catAndRun( - messageText = paste("Getting names of files in", x), + messageText = paste("Getting names of files in", file), dbg = dbg, expr = kwb.utils::noFactorDataFrame( - zip_file = basename(x), - file = utils::untar(x, list = TRUE) + zip_file = basename(file), + file = list_zipped_files(file) ) ) - })) -} + } -# list_monthly_grids_germany_asc_gz ------------------------------------------------- + lapply(zip_files, list_files) %>% + do.call(what = rbind) %>% + kwb.utils::orderBy(c("zip_file", "file")) +} -#' Get URLs to Monthly Grids in Zipped ESRI-ascii-grid Format -#' -#' @param variable variable for which to look for URLs. Must be one of -#' \code{kwb.dwd::list_url(kwb.dwd:::ftp_path_monthly_grids())} -#' @param from optional. First month to be considered, as "yyyymm" string -#' @param to optional. Last month to be considered, as "yyyymm" string -#' @param recursive whether to list files recursively. Default: \code{TRUE} -list_monthly_grids_germany_asc_gz <- function( - variable, from = NULL, to = NULL, recursive = TRUE -) +# list_zipped_files ------------------------------------------------------------ +list_zipped_files <- function(file) { - base_url <- ftp_path_monthly_grids(variable) - - # Code to get the possible choices - # base_url <- kwb.dwd:::ftp_path_monthly_grids() - # kwb.dwd:::url_subdirs_containing_files_with_extension(base_url, ".asc.gz") - - # Make sure that the given variable name is a possible choice - variable <- match.arg(variable, c( - "air_temperature_max", - "air_temperature_mean", - "air_temperature_min", - "drought_index", - "evapo_p", - "evapo_r", - "frost_depth", - "precipitation", - "soil_moist", - "soil_temperature_5cm", - "sunshine_duration" - )) + result <- utils::untar(kwb.utils::safePath(file), list = TRUE) + + if (!is.null(attr(result, "status"))) { + + tar_message <- grep("tar.exe: ", result, value = TRUE) %>% + gsub(pattern = "^.*(tar.exe: .*)$", replacement = "\\1") - # List data files - relative_urls <- base_url %>% - list_url(recursive = recursive) %>% - filter_by_extension_asc_gz() %>% - filter_by_month_range(from, to) + clean_stop( + "There was a warning listing the files in\n ", file, ".\n", + "The file seems to be corrupt.\n", + paste(tar_message, collapse = "\n") + ) + } - # Provide full paths to zipped files in ESRI-ascii-grid-format - file.path(base_url, relative_urls) + result } -# month_numbers ---------------------------------------------------------------- -month_numbers <- function() +# month_range_pattern ---------------------------------------------------------- +month_range_pattern <- function(from, to) { - list( - Jan = 1L, Feb = 2L, Mar = 3L, Apr = 04L, May = 05L, Jun = 06L, - Jul = 7L, Aug = 8L, Sep = 9L, Oct = 10L, Nov = 11L, Dec = 12L - ) + paste(month_sequence(from, to, simple = TRUE), collapse = "|") } # month_sequence --------------------------------------------------------------- #' @importFrom lubridate ymd -month_sequence <- function(start, end) +month_sequence <- function(start, end, simple = FALSE) +{ + if (simple) { + + as_date <- function(x) as.Date(paste0(x, "01"), format = "%Y%m%d") + unique(format(seq(as_date(start), as_date(end), 1L), "%Y%m")) + + } else { + + as_date <- function(x) lubridate::ymd(paste0(x, "-01")) + seq(as_date(start), as_date(end), by = 'months') + } +} + +# on_windows ------------------------------------------------------------------- +on_windows <- function() +{ + Sys.info()[["sysname"]] == "Windows" +} + +# open_for_reading_in_binary_mode ---------------------------------------------- +open_for_reading_in_binary_mode <- function(file) { - to_date <- function(x) lubridate::ymd(paste0(x, "-01")) + if (endsWith(file, ".gz")) { + + base::gzfile(file, "rb") + + } else { - seq(to_date(start), to_date(end), by = 'months') + base::file(file, "rb") + } } -# month_sequence_simple -------------------------------------------------------- -month_sequence_simple <- function(from, to) +# remove_left ------------------------------------------------------------------ +remove_left <- function(x, n) { - as_date <- function(x) as.Date(paste0(x, "01"), format = "%Y%m%d") + n_char <- nchar(x) + stopifnot(all(n_char >= n)) + substr(x, n + 1L, n_char) +} - unique(format(seq(as_date(from), as_date(to), 1L), "%Y%m")) +# remove_protocol -------------------------------------------------------------- +remove_protocol <- function(x) +{ + gsub("^[^/]+://", "", x) +} + + +# remove_right ----------------------------------------------------------------- +remove_right <- function(x, n) +{ + n_char <- nchar(x) + stopifnot(all(n_char >= n)) + substr(x, 1L, n_char - n) } # safe_element ----------------------------------------------------------------- @@ -267,34 +363,47 @@ safe_element <- function(element, elements, name = deparse(substitute(element))) } # temp_dir --------------------------------------------------------------------- -temp_dir <- function(..., template. = NULL, create. = TRUE, dbg. = FALSE) +#' Path to Permanent Temporary Directory +#' +#' @param \dots parts of the path after `/R_kwb.dwd/`, passed to +#' [file.path]] where `` is either the value of environment variable +#' `TEMP` (if set) or `TMP` (if set) or the result of calling [tempdir]. +#' @param template optional. If given, it is assumed to be a path to a file. The +#' name of the file without file name extension is then used as folder name +#' below `/R_kwb.dwd/`. +#' @param create logical indicating whether or not to create the folder if it +#' does not yet exist. Defaults to `TRUE`. +#' @param dbg logical indicating whether or not to print debug messages +#' @return The function returns the path to the temporary folder specified. +#' @export +temp_dir <- function(..., template = NULL, create = TRUE, dbg = FALSE) { dot_args <- list(...) - stop_on_dot_args <- function() { - if (!is_empty(dot_args)) { - clean_stop( - "Further arguments to temp_dir() not allowed if 'template.' is given." - ) - } - } - # If no template (path) is given, use the arguments in ... as sub directory # names. Otherwise, use the base file name of the template without the file # name extension as sub directory name - args <- if (is.null(template.)) { + args <- if (is.null(template)) { + dot_args + + } else if (!is_empty(dot_args)) { + + clean_stop( + "Further arguments to temp_dir() not allowed if 'template' is given." + ) + } else { - stop_on_dot_args() - list(kwb.utils::removeExtension(basename(template.))) + + list(kwb.utils::removeExtension(basename(template))) } tmp_dir <- Sys.getenv("TEMP", Sys.getenv("TMP", tempdir())) path <- do.call(file.path, c(list(tmp_dir, "R_kwb.dwd"), args)) - if (create.) { - kwb.utils::createDirectory(path, dbg = dbg.) + if (create) { + kwb.utils::createDirectory(path, dbg = dbg) } path diff --git a/data/dwd_files.rda b/data/dwd_files.rda index 48164db7..584a6a24 100644 Binary files a/data/dwd_files.rda and b/data/dwd_files.rda differ diff --git a/data/shapes_germany_0.rda b/data/shapes_germany_0.rda new file mode 100644 index 00000000..4f789a76 Binary files /dev/null and b/data/shapes_germany_0.rda differ diff --git a/data/shapes_germany_1.rda b/data/shapes_germany_1.rda new file mode 100644 index 00000000..2e78eed3 Binary files /dev/null and b/data/shapes_germany_1.rda differ diff --git a/data/shapes_germany_2.rda b/data/shapes_germany_2.rda new file mode 100644 index 00000000..d5aa8d0b Binary files /dev/null and b/data/shapes_germany_2.rda differ diff --git a/inst/extdata/add_seealso.R b/inst/extdata/add_seealso.R new file mode 100644 index 00000000..b7626165 --- /dev/null +++ b/inst/extdata/add_seealso.R @@ -0,0 +1,117 @@ +###############################################################################+ +# +# Add @seealso directives to exported functions that link to related functions +# A function is assumed to be related if they have one or more parts of their +# name (as separated by underscore) in common. +# +# - Source the whole script first to load the functions defined below. +# - Then, manually go through the MAIN section +# +###############################################################################+ + +# MAIN ------------------------------------------------------------------------- +if (FALSE) +{ + relations <- get_related_function_names("kwb.dwd") + + files <- dir("R", full.names = TRUE) + + for (file in files) { + + lines <- readLines(file) + + (def_indices <- grep("^\\S+ <- function", lines)) + + for (i in rev(def_indices)) { + #i <- rev(def_indices)[1L] + name <- kwb.utils::extractSubstring("^(\\S+)", lines[i], 1L) + + related_names <- relations[[name]] + n_related <- length(related_names) + + if (n_related > 0L) { + kwb.utils::catAndRun( + sprintf( + "Adding links to %d related functions for %s() in %s", + n_related, name, file + ), + expr = { + see_also <- sprintf( + "#' @seealso\n%s.", + paste0("#' * [", related_names, "]", collapse = ",\n") + ) + lines <- insert_before(lines, see_also, i) + } + ) + } + + } + + writeLines(lines, file) + } +} + +# insert_before ---------------------------------------------------------------- +insert_before <- function(x, y, i = 1L) +{ + parts <- split(x, ifelse(seq_along(x) < i, "before", "after")) + + c(parts$before, y, parts$after) +} + +# get_related_function_names --------------------------------------------------- +get_related_function_names <- function(package, max_relatives = 4L) +{ + #package <- "kwb.dwd" + `%>%` <- magrittr::`%>%` + + ls(getNamespace(package), all.names = FALSE) + + function_names <- getNamespaceExports(package) + names(function_names) <- function_names + + parts <- strsplit(function_names, "_") + + all_keywords <- parts %>% + unlist() %>% + unique() %>% + sort() + + clean_keywords <- function(keywords) { + keywords %>% + gsub(pattern = "[0-9]", replacement = "") %>% + unique() %>% + kwb.utils::removeEmpty() %>% + setdiff(c("and", "by", "or", "to", "with")) + } + + clean_parts <- lapply(parts, clean_keywords) + + clean_parts + + lapply(function_names, function(name_1) { + #name_1 <- function_names[[7L]] + + matches <- sapply(setdiff(function_names, name_1), function(name_2) { + intersect(clean_parts[[name_1]], clean_parts[[name_2]]) + }) + + matches <- matches[lengths(matches) > 0L] + + threshold <- 1L + + while (length(matches) > max_relatives) { + + new_matches <- matches[lengths(matches) > threshold] + + matches <- if (length(new_matches) > 0L) { + threshold <- threshold + 1L + new_matches + } else { + head(matches, max_relatives) + } + } + + names(matches) + }) +} diff --git a/inst/extdata/list_all_dwd_urls.R b/inst/extdata/list_all_dwd_urls.R index b909b890..197f41ad 100644 --- a/inst/extdata/list_all_dwd_urls.R +++ b/inst/extdata/list_all_dwd_urls.R @@ -10,7 +10,7 @@ if (FALSE) }) # User System verstrichen - # 122.08 3.12 461.75 + # 237.30 6.55 763.80 # Save dataset in the package usethis::use_data(dwd_files, overwrite = TRUE) diff --git a/inst/extdata/mask-any-shape.R b/inst/extdata/mask-any-shape.R index 04438d89..13c138c0 100644 --- a/inst/extdata/mask-any-shape.R +++ b/inst/extdata/mask-any-shape.R @@ -1,7 +1,18 @@ +# MAIN ------------------------------------------------------------------------- if (FALSE) { + # Load pipe operator `%>%` <- magrittr::`%>%` + # Read monthly data for the whole of Germany + rain_2012 <- kwb.dwd:::read_monthly_data_over_shape( + variable = "precipitation", + from = "202101", + to = "202112" + ) + + head(rain_2012) + shape_file <- "~/../Downloads/A/amarex/GIS-Verschneidung/EZG_Berlin_BWB_shape.shp" system.time(evapo_p_daily <- kwb.dwd::read_daily_data_over_shape( @@ -24,6 +35,80 @@ if (FALSE) # User System verstrichen # 1.71 0.36 4.08 + # Read the shape file on your own and pass the spatial object in "shape" + shape <- kwb.dwd:::read_shape_file(shape_file, drop_z = TRUE, use_sf = TRUE) + + system.time(evapo_p_monthly2 <- kwb.dwd::read_monthly_data_over_shape( + shape = shape, + variable = "evapo_p", + from = "202001", + to = "202002" + )) + + identical(evapo_p_monthly, evapo_p_monthly2) + + # Now, the same with a subset of the spatial object + system.time(evapo_p_monthly_bln_x <- kwb.dwd::read_monthly_data_over_shape( + shape = shape[shape$Pumpwerk == "APw Bln X", ], + variable = "evapo_p", + from = "202001", + to = "202002" + )) + + # Rainfall in the different Berliner Bezirke + zip_file_bezirke_berlin <- kwb.dwd:::download( + "https://tsb-opendata.s3.eu-central-1.amazonaws.com/bezirksgrenzen/bezirksgrenzen.shp.zip", + target_dir = kwb.dwd:::download_dir("tsb"), + mode = "wb" + ) + + unzipped_files <- kwb.dwd:::unzip_zip_file( + zip_file_bezirke_berlin, + target_dir = kwb.dwd:::temp_dir("bezirke") + ) + + shapes_bezirke <- kwb.dwd:::read_shape_file( + grep("\\.shp$", unzipped_files, value = TRUE), + use_sf = TRUE + ) + + sp::plot(shapes_bezirke) + + shapes_by_bezirk <- split(shapes_bezirke, shapes_bezirke$Gemeinde_n) + + rain_by_bezirk <- lapply(shapes_by_bezirk, function(shape) { + kwb.dwd::read_monthly_data_over_shape( + variable = "precipitation", + from = "202001", + to = "202012", + shape = shape + ) + }) + + rain_by_bezirk_df <- kwb.utils::rbindAll( + rain_by_bezirk, + nameColumn = "bezirk" + ) + + View(rain_by_bezirk_df) + + library(ggplot2) + library(magrittr) + + rain_by_bezirk_df %>% + ggplot(aes( + x = as.factor(.data$month), + y = .data$mean + )) + + geom_bar(stat = 'identity', position = 'dodge') + + facet_wrap(~ .data$bezirk) + + labs(x = "month", y = "precipitation in mm") + + # Problem: the download is repeated for each catchment! + + evapo_p_monthly + evapo_p_monthly_bln_x + # We should find the monthly data when summarising the daily data... evapo_p_daily %>% dplyr::group_by( @@ -63,6 +148,7 @@ if (FALSE) as.matrix(shaped_grid) } +# crop_and_mask ---------------------------------------------------------------- crop_and_mask <- function(grid, shape_spatial) { `%>%` <- magrittr::`%>%` @@ -78,6 +164,7 @@ crop_and_mask <- function(grid, shape_spatial) result } +# as.matrix.RasterLayer -------------------------------------------------------- as.matrix.RasterLayer <- function(x) { matrix(x@data@values, nrow = x@nrows, byrow = TRUE) diff --git a/inst/extdata/provide-data.R b/inst/extdata/provide-data.R new file mode 100644 index 00000000..7401fb77 --- /dev/null +++ b/inst/extdata/provide-data.R @@ -0,0 +1,37 @@ +# +# Provide shapes of Germany as datasets +# + +# Download this file: +# https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip +zip_file <- kwb.dwd:::download_dir("gadm40_DEU_shp.zip") + +# TODO: Find alternatives in case that the above URL cannot be accessed +# url <- "https://www.eea.europa.eu/data-and-maps/data/eea-reference-grids-2/gis-files/germany-shapefile/at_download/file/Germany_shapefile.zip" +# url <- "https://www.arcgis.com/sharing/rest/content/items/ae25571c60d94ce5b7fcbf74e27c00e0/data/vg2500_geo84.zip" + +stopifnot(file.exists(zip_file)) + +target_dir <- kwb.dwd:::temp_dir("shapes_germany") + +files <- kwb.dwd:::unzip_zip_file(zip_file, target_dir) + +shp_files <- grep("\\.shp$", files, value = TRUE) + +# Read shapes at different levels of detail +shapes_germany <- lapply( + X = stats::setNames( + shp_files, + kwb.utils::removeExtension(basename(shp_files)) + ), + FUN = kwb.dwd:::read_shape_file, + use_sf = TRUE +) + +(shapes_germany_0 <- shapes_germany$gadm40_DEU_0) +(shapes_germany_1 <- shapes_germany$gadm40_DEU_1) +(shapes_germany_2 <- shapes_germany$gadm40_DEU_2) + +usethis::use_data(shapes_germany_0, overwrite = TRUE) +usethis::use_data(shapes_germany_1, overwrite = TRUE) +usethis::use_data(shapes_germany_2, overwrite = TRUE) diff --git a/inst/extdata/radolan_format-description.txt b/inst/extdata/radolan_format-description.txt new file mode 100644 index 00000000..20b1cad3 --- /dev/null +++ b/inst/extdata/radolan_format-description.txt @@ -0,0 +1,70 @@ +# RADOLAN/RADVOR +# +# Hoch aufgelöste Niederschlagsanalyse und –vorhersage auf der Basis +# quantitativer Radar- und Ombrometerdaten für grenzüberschreitende +# Fluss-Einzugsgebiete von Deutschland im Echtzeitbetrieb +# +# Beschreibung des Kompositformats +# +# Version 2.5.7 +# +# https://www.dwd.de/DE/leistungen/radolan/radolan_info/radolan_radvor_op_komposit_format_pdf.pdf;jsessionid=3176F4BFFE62D621EA073161C78C29F1.live11041?__blob=publicationFile&v=23 +# +FORTRAN-Bezeichner Produktkennung Dateiname Inhalt +A2 WX raa01-wx_10000-YYMMD-Dhhmm-dwd---bin (INT=5min) qualitätskorrigierte Original Radardaten in qualitativen rvp-6-Einheiten, Codierung in 1 Byte, im erweiterten nationalen Ausschnitt +A2 RX raa01-rx_10000-YYMMDDhhmm-dwd---bin (INT=5min) Original Radardaten in qualitativen rvp-6-Einheiten, Codierung in 1 Byte +A2 RO termocl.pix (INT=60min) bzw. raa01-ro_10000-YYMMD-Dhhmm-dwd---bin (INT=5min) Original Radardaten, mit Standard-Z-R-Beziehung in Niederschlagshöhen umgerechnet +A2 RK antish.pix (INT=60min) bzw. raa01-rk_10000-YYMMDDhhmm-dwd---bin (INT=5min) Radardaten nach Abschattungskorrektur, mit Standard-Z-R-Beziehung in Niederschlagshöhen umgerechnet +A2 RZ raa01-rz_10000-YYMMDDhhmm-dwd---bin (INT=5min) Radardaten nach Abschattungskorrektur und nach Anwendung der verfeinerten Z-R-Beziehungen in Niederschlagshöhen umgerechnet +A2 RY raa01-ry_10000-YYMMDDhhmm-dwd---bin (INT=5min) durch das Qualitätskomposit (QY s. gesonderte Formatbeschreibung in [DWD, 2005b]) korrigierte Radardaten +A2 YW raa01-yw_10000-YYMMD-Dhhmm-dwd---bin (INT=5min) quasi-angeeichte Radardaten (Basis: RY, RH und RW) +A2 ZW raa01-zw_10000-YYMMD-Dhhmm-dwd---bin (INT=10min) quasi-angeeichte Radardaten (Basis: YW) +A2 RH trigger.pix (INT=60min; um hh:35) bzw. bestrain.pix (INT=60min; um hh:45) bzw. raa01-rh_10000-YYMMD-Dhhmm-dwd---bin (INT=60min; alle 5 min) Radardaten nach Abschattungskorrektur und nach Anwendung der verfeinerten Z-R-Beziehungen in Niederschlagshöhen umgerechnet und auf eine Stunde aufsummiert +A2 RJ state.trigger.pix (um hh:35) bzw. state.bestrain.pix (um hh:45) Anzahl am RH beteiligter fünfminütlicher lokaler Radardaten für jedes Pixel (keine Radardaten) +A2 RP kooclu.pix relative Pixelhäufigkeit (keine Radardaten) +A2 RT maxclu.pix Anzahl Vortermine für jedes Pixel (keine Radardaten) +A2 RC ihvkoo.pix Radardaten nach statistischer Clutterkorrektur ohne Clutterpixel +A2 RI intclu.pix Radardaten nach statistischer Clutterkorrektur ohne Clutterpixel; interpoliert +A2 RG glatt8.pix Radardaten nach Glättung mit dem Mittelwertsfilter (sog. BOGRA-Verfahren) +A2 RB borama.pix bzw. raa01-rb_10000-YYMMD-Dhhmm-dwd---bin Radardaten nach Anwendung eines Faktors (Voraneichung mit dem sog. BORAMA-Verfahren) +A2 RA addiff.interim.pix bzw. addiff.relevant.pix Radardaten nach Aneichung mit dem Differenzenverfahren; interim=ohne Kontrollstationen, relevant=mit allen Stationen +A2 RM mulfak.interim.pix bzw. mulfak.relevant.pix Radardaten nach Aneichung mit dem Faktorenverfahren; interim=ohne Kontrollstationen, relevant=mit allen Stationen +A2 RL merge.interim.pix bzw. merge.relevant.pix Radardaten nach Aneichung mit dem Mergingverfahren; interim=ohne Kontrollstationen, relevant=mit allen Stationen +A2 RD dbr.interim.pix bzw. dbr.relevant.pix interpolierte Aneichdifferenzen (keine Radardaten); interim=ohne Kontrollstationen, relevant=mit allen Stationen +A2 RF fbr.interim.pix bzw. fbr.relevant.pix interpolierte Aneichfaktoren (keine Radardaten); interim=ohne Kontrollstationen, relevant=mit allen Stationen +A2 RW adjust.pix bzw. raa01-rw_10000-YYMMD-Dhhmm-dwd---bin Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren 1 +A2 RU adjust.merge.pix bzw. raa01-ru_10000-YYMMD-Dhhmm-dwd---bin Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen-, Faktoren- und Mergingverfahren 1 ab Softwareversion 2.0 werden Radarlücken mit interpolierten Bodenniederschlagshöhen ersetzt +A2 RR bod.pix interpolierte Bodenniederschlagshöhen (keine Radardaten) nach dem RADOLAN-Verfahren +A2 S2 raa01-s2_10000-YYMMD-Dhhmm-dwd---bin 2h-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 S3 raa01-s3_10000-YYMMD-Dhhmm-dwd---bin 3h-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 SQ raa01-sq_10000-YYMMD-Dhhmm-dwd---bin 6h-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 SH raa01-sh_10000-YYMMD-Dhhmm-dwd---bin 12h-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 SF raa01-sf_10000-YYMMDDhhmm-dwd---bin 24h-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 SM raa01-sm_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 1. Tag des Monats bis zum 1. Tag des Folgemonats fortlaufend aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 SZ raa01-sz_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 1. Tag der meteorologischen Jahreszeit bis zum 1. Tag der Folgejahreszeit aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 SJ raa01-sj_10000-YYMMDDhhmm-dwd---bin täglich ab dem 01.01. bis zum 1. Tag des Folgejahres aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 SY raa01-sy_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 01.11. bis zum 1. Tag des folgenden hydrologischen Jahres aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 %M raa01-%m_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 1. Tag des Monats bis zum 1. Tag des Folgemonats fortlaufend aufsummiertes, zum 30-jährigen Mittel relatives Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 AM raa01-am_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 1. Tag des Monats bis zum 1. Tag des Folgemonats fortlaufend aufsummiertes, zum 30-jährigen Mittel des kompletten Monats relatives Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 AZ raa01-az_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 1. Tag der meteorologischen Jahreszeit bis zum 1. Tag der Folgejahreszeit fortlaufend aufsummiertes, zum 30-jährigen Mittel der kompletten meteorologischen Jahreszeit relatives Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 %J raa01-%j_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 01.01. bis zum 1. Tag des Folgejahres aufsummiertes, zum 30-jährigen Mittel relatives Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 AJ raa01-aj_10000-YYMMDDhhmm-dwd---bin täglich ab dem 01.01. bis zum 1. Tag des Folgejahres aufsummiertes, zum 30-jährigen Mittel des kompletten Jahres relatives Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 %Y raa01-%y_10000-YYMMD-Dhhmm-dwd---bin täglich ab dem 01.11. bis zum 1. Tag des folgenden hydrologischen Jahres aufsummiertes, zum 30-jährigen Mittel relatives Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 D2 raa01-d2_10000-YYMMD-Dhhmm-dwd---bin 48h-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 D3 raa01-d3_10000-YYMMD-Dhhmm-dwd---bin 72h-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 W1 raa01-w1_10000-YYMMD-Dhhmm-dwd---bin 7d-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 W2 raa01-w2_10000-YYMMD-Dhhmm-dwd---bin 14d-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 W3 raa01-w3_10000-YYMMD-Dhhmm-dwd---bin 21d-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 W4 raa01-w4_10000-YYMMD-Dhhmm-dwd---bin 30d-aufsummiertes Endergebnis der Aneichung nach Durchführung der gewichteten Mittelung von Differenzen- und Faktorenverfahren +A2 RV RVYYMMddhhmm_vvv (INT=5min) Radardaten, vorhergesagt aus den precipitation scan sweeps; YY=Jahr, MM=Monat, dd=Tag, hh=Stunde, mm=Minute, vvv=vorhergesagter Zeitpunkt in Minuten, bis 24.10.2019 noch mit Suffix „_MFxxx“ 2 +A2 RS RSYYMMddhhmm_vvv (INT=60min; alle 5 min) Radardaten, vorhergesagt aus den precipitation scan sweeps und auf eine Stunde aufsummiert; YY=Jahr, MM=Monat, dd=Tag, hh=Stunde, mm=Minute, vvv=vorhergesagter Zeitpunkt in Minuten, bis 24.10.2019 noch mit Suffix „MFxxx“ +A2 RQ RQYYMMddhhmm_vvv bzw. raa01-rq_10000-YYMMD-Dhhmm_vvv-dwd---bin (INT=60min; alle 15 min) Radardaten: mit der Verschneidung aus dem RW-Produkt quantifiziertes (quasi-angeeichtes) RS-Produkt +A2 RE REYYMMddhhmm_vvv (INT=60min; alle 5 min) Anteil des festen Niederschlags (keine Radardaten) + Hagelflag; +A2 FS FSYYMMddhhmm_vvv (INT=60min; alle 15 min) Schneefallrate in cm/h +A2 FQ FQYYMMddhhmm_vvv (INT=360min; alle 15 min) 6h-aufsummierte Schneefallrate in cm/6h +A2 EX raa01-ex_10000-YYMMD-Dhhmm-dwd---bin (INT=5min) mitteleuropäische qualitätskorrigierte qualitative Radardaten analog WX, in qualitativen rvp-6-Einheiten, Codierung in 1 Byte +A2 EZ raa01-ez_10000-YYMMD-Dhhmm-dwd---bin (INT=5min) mitteleuropäische quantitative Radardaten analog RZ +A2 EY raa01-ey_10000-YYMMD-Dhhmm-dwd---bin (INT=5min) mitteleuropäische qualitätskorrigierte quantitative Radardaten analog RY +A2 EH raa01-eh_10000-YYMMD-Dhhmm-dwd---bin (INT=60min; alle 5 min) mitteleuropäische quantitative Radardaten analog RH +A2 EB raa01-eb_10000-YYMMD-Dhhmm-dwd---bin (INT=60min) mitteleuropäische quantitative Radardaten analog RB +A2 EW raa01-ew_10000-YYMMD-Dhhmm-dwd---bin (INT=60min) mitteleuropäische quantitative Radardaten analog RW diff --git a/inst/extdata/read-daily-braunschweig-data.R b/inst/extdata/read-daily-braunschweig-data.R index 2a533f79..b689d4be 100644 --- a/inst/extdata/read-daily-braunschweig-data.R +++ b/inst/extdata/read-daily-braunschweig-data.R @@ -5,16 +5,16 @@ if (FALSE) { # monthly - urls_monthly <- kwb.dwd:::list_monthly_grids_germany_asc_gz("x") + urls_monthly <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "x") # -> error with possible variables - urls_monthly <- kwb.dwd:::list_monthly_grids_germany_asc_gz("sunshine_duration") + urls_monthly <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "sunshine_duration") # daily - urls_daily <- kwb.dwd:::list_daily_grids_germany_tgz("x") + urls_daily <- kwb.dwd:::list_grids_germany("daily", ".tgz", "x") # -> error with possible variables - urls_daily <- kwb.dwd:::list_daily_grids_germany_tgz("soil_temperature_5cm") + urls_daily <- kwb.dwd:::list_grids_germany("daily", ".tgz", "soil_temperature_5cm") kwb.file::remove_common_root(urls_monthly) kwb.file::remove_common_root(urls_daily) @@ -42,13 +42,13 @@ if (FALSE) files <- kwb.dwd:::download_monthly_grids_germany("frost_depth", from, to) - kwb.file::remove_common_root(files) - file <- files[1L] kwb.utils::hsOpenWindowsExplorer(dirname(file)) - kwb.dwd:::read_asc_gz_file(file) + grid <- kwb.dwd:::read_asc_gz_file(file) + + raster::plot(grid) } # diff --git a/inst/extdata/read_radolan-data.R b/inst/extdata/read_radolan-data.R new file mode 100644 index 00000000..93fefcc5 --- /dev/null +++ b/inst/extdata/read_radolan-data.R @@ -0,0 +1,388 @@ +#remotes::install_github("kwb-r/kwb.dwd@dev") + +# How to find URLs to Radolan files -------------------------------------------- +if (FALSE) +{ + `%>%` <- magrittr::`%>%` + + # All Radolan-related paths (using placeholders) + kwb.dwd:::ftp_path_radolan_all(use_placeholder = TRUE) + + # List availabe files below a certain Radolan-related base directory + urls_all <- "grids_germany/hourly/radolan/historical/bin" %>% + kwb.dwd:::ftp_path_cdc() %>% + kwb.dwd::list_url(recursive = TRUE, full_names = TRUE) + + # TODO: check for what cases filter_by_month_range() does not work + urls <- kwb.dwd:::filter_by_month_range(urls_all, "201601", "201606") + + get_urls <- function(resolution, format, year = 2020L) { + "grids_germany/%s/radolan/historical/%s/%d" %>% + sprintf(resolution, format, year) %>% + kwb.dwd:::ftp_path_cdc() %>% + kwb.dwd:::list_url(recursive = TRUE, full_names = TRUE) %>% + basename() + } + + get_urls("hourly", "asc") + get_urls("hourly", "bin") + get_urls("daily", "bin") +} + +# Download and extract hourly Radolan text files (historical) ------------------ +if (FALSE) +{ + files <- kwb.dwd:::download_and_extract_radolan( + #from = "201406", + #to = "201406", + year = 2014L, + resolution = "hourly", + format = "asc" + ) + + # Get the configuration that the function created. It is intended to be passed + # through to other functions + kwb.utils::getAttribute(files, "config") + + # Get the relevant URLs that were downloaded (if not yet locally available) + urls <- kwb.utils::getAttribute(files, "urls") +} + +# Download and extract daily Radolan binary files (historical) ----------------- +if (FALSE) +{ + files <- kwb.dwd:::download_and_extract_radolan( + from = "201602", + to = "201604", + resolution = "daily", + format = "bin" + ) + + # Get the configuration that the function created. It is intended to be passed + # through to other functions + kwb.utils::getAttribute(files, "config") + + # Get the relevant URLs that were downloaded (if not yet locally available) + urls <- kwb.utils::getAttribute(files, "urls") + + # Read some files into a list of RasterLayer objects + grids <- lapply(files[1:4], kwb.dwd::read_binary_radolan_file) + + # Plot the grids + raster::plot(raster::stack(grids)) +} + +# Load shapes as provided by DWD ----------------------------------------------- +if (FALSE) +{ + zip_file <- kwb.dwd:::download( + url = kwb.dwd:::ftp_path_cdc( + "help/RADOLAN/Unterstuetzungsdokumente/RADOLAN-GIS.zip" + ), + target_dir = kwb.dwd:::download_dir("dwd"), + mode = "wb" + ) + + target_dir <- kwb.dwd:::temp_dir("dwd/radolan-gis") + + files <- kwb.dwd:::unzip_zip_file(zip_file, target_dir) + + prj_files <- grep("\\.prj$", files, value = TRUE) + shp_files <- grep("\\.shp$", files, value = TRUE) + + #shp_files <- dir(target_dir, "\\.shp$", full.names = TRUE) + + (projection_strings <- lapply(prj_files, readLines, warn = FALSE)) + + readLines(kwb.dwd:::default_projection_file()) + + radolan_shapes <- lapply(shp_files, kwb.dwd:::read_shape_file, use_sf = TRUE) + + lapply(radolan_shapes, sf::st_crs) +} + +# Provide shapes --------------------------------------------------------------- +if (FALSE) +{ + `%>%` <- magrittr::`%>%` + + # Get shapes of German regions (in the same projection as used in DWD grids?) + + # Provide the shape of Germany + shapes <- kwb.dwd:::get_shapes_of_germany() + + shape_germany <- shapes$gadm40_DEU_0 %>% + kwb.dwd:::transform_coords(kwb.dwd:::get_radolan_projection_string()) + + # Provide the shape of Berlin/Cologne + shape_berlin <- kwb.dwd:::get_shape_of_german_region("berlin") + shape_cologne <- kwb.dwd:::get_shape_of_german_region("cologne") + + # More general (select other regions) + #kwb.dwd:::select_shapes(shapes) + shape_berlin_2 <- subset(shapes$gadm40_DEU_1, NAME_1 == "Berlin") + identical(shape_berlin, shape_berlin_2) + + shape_wuerzburg <- kwb.dwd:::filter_shapes(shapes, config = list( + index = 3L, + variable = "NAME_2", + pattern = "^W.rzburg$" + )) + + # Plot the shapes + raster::plot(shape_germany[, "ID_0"]) + raster::plot(shape_berlin[, "ID_0"]) + raster::plot(shape_cologne[, "ID_0"]) + raster::plot(shape_wuerzburg[, "ID_0"]) + + # Try to understand coordinate transformation... + shape <- shape_berlin + #shape <- shape_germany + + crs_1 <- kwb.dwd:::get_radolan_projection_string() + crs_2 <- sf::st_crs(radolan_shapes[[1L]]) + + shape_1 <- kwb.dwd:::transform_coords(shape, crs_1) + shape_2 <- kwb.dwd:::transform_coords(shape, crs_2) + + raster::crs(shape) + raster::crs(shape_1) + raster::crs(shape_2) + + # What happens here? + kwb.dwd:::read_shape_with_dwd_projection +} + +# Read hourly/radolan/historical/asc files ------------------------------------- +if (FALSE) +{ + `%>%` <- magrittr::`%>%` + + kwb.dwd:::download_and_extract_radolan( + year = 2016L, + resolution = "hourly", + format = "asc" + ) + + # List the locally available extracted files + asc_files <- kwb.dwd:::list_extracted_radolan_files( + from = "201601", + to = "201612", + resolution = "hourly", + format = "asc" + ) + + length(asc_files) + + 24*366 + + rev(sort(table(substr(basename(asc_files), 1L, 11L)))) + + # Time interval covered by files + range(kwb.dwd:::get_radolan_timestamps_from_filenames(asc_files)) + + # Read the text files into raster objects and set the projection string + grids_asc <- lapply(asc_files[1:24], kwb.dwd:::read_asc_file) + + # Provide shape in the same projection as Radolan data are provided in + shape <- kwb.dwd:::transform_coords( + kwb.dwd:::get_shape_of_german_region("berlin"), + target_crs = kwb.dwd:::get_radolan_projection_string() + ) + + # TODO: Why is shape not plotted? Unit 1m vs. 1000m? + raster::plot(grids_asc[[1L]]) + raster::plot(shape[, 1], axes = TRUE, add = TRUE) + raster::plot(shape[, 1], axes = TRUE) + + # Read data for Berlin from text files + # TODO: Fix error "extents do not overlap" + hourly_precipitation_berlin_asc <- asc_files[1:48] %>% + kwb.dwd:::get_regional_stats_from_radolan_asc_files(shape = shape) +} + +# Download/extract/read hourly/radolan/historical/bin files -------------------- +if (FALSE) +{ + # idea: + #config <- configure_radolan + #download_radolan(config = config) + #read_radolan(config = config) + + # 1. Define a year for which to download data (must be integer!) + year <- 2007L + + # 2. Download and extract files for the given year + files <- kwb.dwd:::download_and_extract_radolan( + year = year, + resolution = "hourly", # daily + format = "bin" + ) + + # Get a configuration object with all relevant information + config <- kwb.utils::getAttribute(files, "config") + + # Or: configure independently + config_2 <- kwb.dwd:::configure_radolan( + year = year, + resolution = "hourly", + format = "bin" + ) + + identical(config, config_2) + + # 3. Provide shape of region to be cut out of the grids + shape <- kwb.dwd:::get_shape_of_german_region("berlin") + + # Test configuration for fast testing + config <- kwb.dwd:::configure_radolan( + from = "200707", + to = "200707", + resolution = "hourly", + format = "bin" + ) + + # 4. Read and cut data from local files for the given year + data <- kwb.dwd:::read_hourly_radolan_historical_bin_for_region( + from = config$from, + to = config$to, + shape = shape, + blocksize = 48L, + run_parallel = TRUE, + dbg = TRUE + ) + + # 5. Save the data for one year + saveRDS(data, sprintf("mydata/radolan_berlin_hourly_%d.rds", year)) +} + +# Read daily/radolan/historical/bin files -------------------------------------- +if (FALSE) +{ + # List locally available extracted binary files + bin_files <- kwb.dwd:::list_extracted_radolan_files( + from = "201601", + to = "201612", + resolution = "daily", + format = "bin" + ) + + # Time interval covered by files + range(kwb.dwd:::get_radolan_timestamps_from_filenames(bin_files)) + + # Read data for Berlin from binary files + shape_berlin <- kwb.dwd:::get_shape_of_german_region("berlin") + + daily_precipitation_berlin <- bin_files %>% + kwb.dwd:::get_regional_stats_from_radolan_bin_files(shape = shape_berlin) + + View(daily_precipitation_berlin) + + saveRDS(daily_precipitation_berlin, "mydata/daily_precipitation_berlin.rds") + daily_precipitation_berlin <- readRDS("mydata/daily_precipitation_berlin.rds") + + library(ggplot2) + + ggplot(daily_precipitation_berlin, aes(datetime_utc, mean)) + + geom_point() +} + +# Plotting --------------------------------------------------------------------- +if (FALSE) +{ + kwb.dwd:::read_hourly_radolan_historical_bin_for_region + + kwb.dwd:::read_binary_radolan_file(files[1L]) + + raster::plot(grids_bin[[1L]]) + raster::plot(shape_germany, add = TRUE) + + raster::plot(shape_berlin, add = TRUE) + raster::plot(shape_berlin_2, add = TRUE) + + raster::plot(shape_germany, add = TRUE) + raster::plot(shape_germany_2, add = TRUE) + + # Stack the raster objects together + stack_bin <- raster::stack(grids_bin) + + raster::plot(stack_bin[[1L]]) + + grid <- grids_bin[[1L]] + + cropped <- raster::crop(stack_bin, shape) + masked <- raster::mask(stack_bin, shape) + + raster::plot(cropped) + raster::plot(masked) + + raster::crs(shape) + raster::crs(grid) + + # Shape of Germany + shapes <- kwb.dwd:::get_shapes_of_germany() + + kwb.dwd:::select_shapes(shapes) + + kwb.utils::toPdf({ + for (i in seq_len(nrow(shape))) { + raster::plot(grids_bin[[1L]]) + raster::plot(shape[i, ], add = TRUE) + raster::plot(raster::crop(stack_bin, shape[i, ])[[1:4]]) + } + }) + + # Compare data from text and binary files + g1a <- grids_asc[[1L]] + g1b <- grids_bin[[1L]] + + g1a@data + + raster::cellStats(g1a, "mean") + raster::cellStats(g1b, "mean") + + raster::plot(g1a) + + kwb.utils::toPdf({ + raster::plot(g1b) + raster::plot(shape, add = TRUE) + }) + + raster::crs(g1a) + raster::crs(g1b) + + grids <- grids_bin + + grid_stack <- raster::stack(grids) + + raster::crop(grid_stack, ...) + + raster::plot(grid_stack) + + values_by_type <- lapply(list(asc = g1a, bin = g1b), raster::getValues) + + kwb.utils::allAreIdentical(values_by_type) + + head(values_by_type$asc) + str(g1a) + + g1a@data@values + + m2 <- matrix( + g@data@values, + byrow = TRUE, + nrow = nrow(m), + ncol = ncol(m) + ) + + table(m) + table(m2) + + findblobs::plot_integer_matrix(m1) + findblobs::plot_integer_matrix(m2) + + summary(m[m != -1]) + + getMethod(raster::raster, "asc") + raster:::.rasterFromASCIIFile +} diff --git a/inst/extdata/setup_package.R b/inst/extdata/setup_package.R deleted file mode 100644 index f0b40280..00000000 --- a/inst/extdata/setup_package.R +++ /dev/null @@ -1,32 +0,0 @@ -# Set the name for your new package -package <- "kwb.dwd" - -# Set the path to your new package -pkg_dir <- file.path("~/HAUKE/R", package) - -# Create a default package structure -withr::with_dir(pkg_dir, kwb.pkgbuild::use_pkg_skeleton(package)) - -#kwb.orcid::get_kwb_orcids() - -author <- list( - name = "Hauke Sonnenberg", - orcid = "0000-0001-9134-2871" -) - -description <- list( - name = package, - title = "Access Information from Deutscher Wetterdienst (DWD)", - desc = paste( - collapse = "\n", - "This package provides functions to simplify the access to the data", - "provided online by the Deutscher Wetterdienst (DWD)." - ) -) - -withr::with_dir(pkg_dir, kwb.pkgbuild::use_pkg( - author, - description, - version = "0.0.0.9000", - stage = "experimental" -)) diff --git a/inst/extdata/validate-berlin-mask.R b/inst/extdata/validate-berlin-mask.R index aab5cb59..93501289 100644 --- a/inst/extdata/validate-berlin-mask.R +++ b/inst/extdata/validate-berlin-mask.R @@ -5,17 +5,14 @@ # Open description file (how to interpret the data?) --------------------------- if (FALSE) { - base_url <- kwb.dwd:::ftp_path_monthly_grids("evapo_p") - urls <- kwb.dwd::list_url(base_url, full_names = TRUE) - (url <- grep("_202201", urls, value = TRUE)) - - kwb.dwd::open_description(url) + urls <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "evapo_p", "202201") + kwb.dwd::open_description(urls[1L]) } # Compare two versions of reading data for Berlin ------------------------------ if (FALSE) { - from <- "199106" + from <- "202105" to <- "202107" # Version 1: use Andreas Matzinger's Berlin mask matrix @@ -54,7 +51,7 @@ if (FALSE) # Read polygons of German cities and apply their masks to Germany -------------- if (FALSE) { - # We need a target projection, take it from an example grid of Germany + # Read shape files for German regions, transformed to projection of DWD grids shapes <- kwb.dwd:::get_shapes_of_germany(recreate = TRUE) # Create a configuration interactively @@ -99,7 +96,7 @@ if (FALSE) raster::plot(munich <- extract("M\xfcnchen$")) # white hole??? } -# Validat Andreas Matzinger's Berlin mask -------------------------------------- +# Validate Andreas Matzinger's Berlin mask ------------------------------------- if (FALSE) { # What is the difference between the Berlin "mask" of Andreas and the mask diff --git a/inst/extdata/validate_radolan-data.R b/inst/extdata/validate_radolan-data.R new file mode 100644 index 00000000..cb520aa3 --- /dev/null +++ b/inst/extdata/validate_radolan-data.R @@ -0,0 +1,39 @@ +# +# Validate Radolan data: Try to calculate daily values from hourly values +# + +# Load the pipe operator +`%>%` <- magrittr::`%>%` + +# Read files that were stored by read_radolan-data.R +files <- dir("mydata", "^radolan_berlin_hourly", full.names = TRUE) + +# Read all files into one data frame +rain_data <- do.call(rbind, lapply(files, readRDS)) + +# Show the data frame +View(rain_data) + +# Number of rows per year +table(substr(rain_data$datetime_utc, 1, 4)) + +# Function to summarise data by time interval +summarise_by_interval <- function(data, fun) { + data %>% + dplyr::group_by(date = fun(.data$datetime_utc)) %>% + dplyr::summarise( + n = dplyr::n(), + sum = sum(.data$mean) / 10 + ) +} + +as_date <- as.Date +as_month <- function(x) substr(x, 1L, 7L) +as_year <- function(x) as.integer(substr(x, 1L, 4L)) + +daily_sums <- summarise_by_interval(rain_data, as_date) +monthly_sums <- summarise_by_interval(rain_data, as_month) +yearly_sums <- summarise_by_interval(rain_data, as_year) + +View(monthly_sums) +View(yearly_sums) diff --git a/man/calculate_masked_grid_stats.Rd b/man/calculate_masked_grid_stats.Rd index a83a3021..057c70dc 100644 --- a/man/calculate_masked_grid_stats.Rd +++ b/man/calculate_masked_grid_stats.Rd @@ -13,9 +13,21 @@ calculate_masked_grid_stats(matrices, geo_mask) } \value{ data frame with one row per matrix in \code{matrices} and columns - \code{file}, \code{year}, \code{month}, \code{mean}, \code{sd}, \code{min}, - \code{max} +\itemize{ +\item \code{file}, +\item \code{year}, +\item \code{month}, +\item \code{mean}, +\item \code{sd}, +\item \code{min}, +\item \code{max} +} } \description{ Calculate Stats of Variable for Geographical Subset of a Grid } +\seealso{ +\itemize{ +\item \link{get_example_grid_germany}. +} +} diff --git a/man/check_or_download_shapes_germany.Rd b/man/check_or_download_shapes_germany.Rd deleted file mode 100644 index 4ed96af6..00000000 --- a/man/check_or_download_shapes_germany.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check_or_download_shapes_germany.R -\name{check_or_download_shapes_germany} -\alias{check_or_download_shapes_germany} -\title{Check Local Availability or Download Shape Files} -\usage{ -check_or_download_shapes_germany(quiet = FALSE) -} -\arguments{ -\item{quiet}{passed if \code{TRUE} status messages are suppressed} -} -\value{ -path to folder containing shape files -} -\description{ -This function checks if shape files for Germany are available in the folder -`\%TEMP\%/R_kwb.dwd/gadm40_DEU_shp`. If not, the shape files are downloaded -from \url{https://gadm.org} (URL to zip-file: -\url{https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip}) -and unpacked into that folder. -} diff --git a/man/convert_bin_to_raster_file.Rd b/man/convert_bin_to_raster_file.Rd index 9a220fa6..9d5b999c 100644 --- a/man/convert_bin_to_raster_file.Rd +++ b/man/convert_bin_to_raster_file.Rd @@ -18,3 +18,8 @@ the first element of \code{bin_file} resides.} \description{ Convert Binary Radolan File to Raster File } +\seealso{ +\itemize{ +\item \link{write_raster_to_file}. +} +} diff --git a/man/crop_radolan_radial.Rd b/man/crop_radolan_radial.Rd index 2af51af6..01e4f652 100644 --- a/man/crop_radolan_radial.Rd +++ b/man/crop_radolan_radial.Rd @@ -13,8 +13,7 @@ crop_radolan_radial( ) } \arguments{ -\item{radolan}{radolan data as returned by -\code{\link{read_relevant_years_radolan}}} +\item{radolan}{radolan data as returned by \link{read_relevant_years_radolan}} \item{longitude}{longitude} @@ -24,8 +23,16 @@ crop_radolan_radial( \item{as_data_frame}{if \code{TRUE}, a data frame with columns \code{SAMPLE_DATE} and \code{rain_mean} is returned, otherwise the raster -object returned by \code{\link[raster]{crop}}} +object returned by \link[raster:crop]{raster::crop}} } \description{ Crop Radolan Data } +\seealso{ +\itemize{ +\item \link{get_radolan_urls}, +\item \link{extract_radolan_zip_files}, +\item \link{radolan_raw_to_raster}, +\item \link{download_radolan}. +} +} diff --git a/man/download_radolan.Rd b/man/download_radolan.Rd index 4e7683d0..03bb2e96 100644 --- a/man/download_radolan.Rd +++ b/man/download_radolan.Rd @@ -13,9 +13,8 @@ download_radolan(resolution = "daily", export_dir = "data", ...) \item{export_dir}{export directory (default: "data" in current working directory)} -\item{\dots}{arguments passed to \code{\link{get_radolan_urls}}, such as -\code{start_daily}, \code{start_hourly}, \code{end_daily}, -\code{end_hourly}} +\item{\dots}{arguments passed to \link{get_radolan_urls}, such as \code{start_daily}, +\code{start_hourly}, \code{end_daily}, \code{end_hourly}.} } \value{ list with "daily_historical_urls" and "hourly_historical_urls" @@ -26,3 +25,11 @@ Download Radolan Files on DWD Server \examples{ \dontrun{download_radolan(resolution = "daily")} } +\seealso{ +\itemize{ +\item \link{get_radolan_urls}, +\item \link{extract_radolan_zip_files}, +\item \link{radolan_raw_to_raster}, +\item \link{list_extracted_radolan_files}. +} +} diff --git a/man/download_shapes_germany.Rd b/man/download_shapes_germany.Rd new file mode 100644 index 00000000..b7068b59 --- /dev/null +++ b/man/download_shapes_germany.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download_shapes_germany.R +\name{download_shapes_germany} +\alias{download_shapes_germany} +\title{Check Local Availability or Download Shape Files} +\usage{ +download_shapes_germany( + url = "https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip", + quiet = FALSE, + timeout = 60 +) +} +\arguments{ +\item{url}{URL to publicly available zip file containing shape files for +Germany. Default: +\url{https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip}} + +\item{quiet}{passed if \code{TRUE} status messages are suppressed} + +\item{timeout}{timeout in seconds} +} +\value{ +path to folder containing shape files +} +\description{ +This function checks if shape files for Germany are available in the folder +\verb{\\\%TEMP\\\%/R_kwb.dwd/shapes_germany}. If not, the shape files are +downloaded from the URL given in \code{url} and unpacked into that folder. +} +\seealso{ +\itemize{ +\item \link{get_shapes_of_germany}, +\item \link{get_example_grid_germany}, +\item \link{download_radolan}. +} +} diff --git a/man/dwd_files.Rd b/man/dwd_files.Rd index c4ff6535..6b8a23be 100644 --- a/man/dwd_files.Rd +++ b/man/dwd_files.Rd @@ -5,16 +5,16 @@ \alias{dwd_files} \title{Files Available on DWD's FTP Server} \format{ -A data frame with 784332 observations of 8 variables: +A data frame with 838345 observations of 8 variables: \describe{ - \item{file}{path to the file below [base_url]} - \item{isdir}{TRUE for a directory, FALSE for a file} - \item{size}{file size in bytes} - \item{permissions}{string indicating file permissions} - \item{modification_time}{time of last modification of the file} - \item{user}{further column provided by the FTP server} - \item{group}{further column provided by the FTP server} - \item{links}{further column provided by the FTP server} +\item{file}{path to the file below [base_ur]} +\item{isdir}{TRUE for a directory, FALSE for a file} +\item{size}{file size in bytes} +\item{permissions}{string indicating file permissions} +\item{modification_time}{time of last modification of the file} +\item{user}{further column provided by the FTP server} +\item{group}{further column provided by the FTP server} +\item{links}{further column provided by the FTP server} } } \source{ @@ -26,6 +26,6 @@ dwd_files \description{ Information on files that are available for download at \url{ftp://opendata.dwd.de/climate_environment/CDC/} [base_url]. The -information were last updated on 2022-09-17. +information were last updated on 2023-04-26. } \keyword{datasets} diff --git a/man/extract_radolan_zip_files.Rd b/man/extract_radolan_zip_files.Rd index be0c4d19..e8a186ad 100644 --- a/man/extract_radolan_zip_files.Rd +++ b/man/extract_radolan_zip_files.Rd @@ -12,8 +12,13 @@ in .tar.gz)} } \value{ Nothing. Side effect: Unzipped files in subfolder "bin" below - \code{radolan_dir}. +\code{radolan_dir}. } \description{ Extract radolan zip files } +\seealso{ +\itemize{ +\item \link{list_extracted_radolan_files}. +} +} diff --git a/man/find_description_files.Rd b/man/find_description_files.Rd index f1e48663..ce288bb5 100644 --- a/man/find_description_files.Rd +++ b/man/find_description_files.Rd @@ -14,8 +14,8 @@ otherwise only the file names. The default is \code{FALSE}.} } \value{ vector of character with file names of or full URLs to all files with - extensions ".txt" or ".pdf" that are in the same folder as the file that - \code{url} points to +extensions ".txt" or ".pdf" that are in the same folder as the file that +\code{url} points to } \description{ For a Given URL, Try to Find Description Files diff --git a/man/get_berlin_dwd_mask.Rd b/man/get_berlin_dwd_mask.Rd index edd4b9a9..4f7f3078 100644 --- a/man/get_berlin_dwd_mask.Rd +++ b/man/get_berlin_dwd_mask.Rd @@ -15,3 +15,8 @@ Get geographical "stamp" for Berlin area \examples{ get_berlin_dwd_mask() } +\seealso{ +\itemize{ +\item \link{get_dwd_urls_metadata}. +} +} diff --git a/man/get_dwd_urls_metadata.Rd b/man/get_dwd_urls_metadata.Rd index 6198f37a..25c1f611 100644 --- a/man/get_dwd_urls_metadata.Rd +++ b/man/get_dwd_urls_metadata.Rd @@ -8,9 +8,15 @@ get_dwd_urls_metadata() } \value{ list of character with each element representing a URL to a metadata - file provided by Deutscher Wetterdienst (DWT), e.g. files - "_Beschreibung_Stationen.txt" describing measurement stations. +file provided by Deutscher Wetterdienst (DWT), e.g. files +"_Beschreibung_Stationen.txt" describing measurement stations. } \description{ Get URLs to DWD Metadata } +\seealso{ +\itemize{ +\item \link{get_radolan_urls}, +\item \link{get_berlin_dwd_mask}. +} +} diff --git a/man/get_example_grid_germany.Rd b/man/get_example_grid_germany.Rd index c386a98e..0553c90c 100644 --- a/man/get_example_grid_germany.Rd +++ b/man/get_example_grid_germany.Rd @@ -9,3 +9,8 @@ get_example_grid_germany() \description{ Read monthly potential evaporation of January 2022, just as an example. } +\seealso{ +\itemize{ +\item \link{get_shapes_of_germany}. +} +} diff --git a/man/get_radolan_extension.Rd b/man/get_radolan_extension.Rd index e76d25c6..f87ea8bb 100644 --- a/man/get_radolan_extension.Rd +++ b/man/get_radolan_extension.Rd @@ -16,3 +16,9 @@ Get Radolan Extension get_radolan_extension() } +\seealso{ +\itemize{ +\item \link{get_radolan_urls}, +\item \link{get_radolan_projection_string}. +} +} diff --git a/man/get_radolan_projection_string.Rd b/man/get_radolan_projection_string.Rd index 44fb2362..67b33cf8 100644 --- a/man/get_radolan_projection_string.Rd +++ b/man/get_radolan_projection_string.Rd @@ -16,3 +16,9 @@ Compose radolan projection string get_radolan_projection_string() } +\seealso{ +\itemize{ +\item \link{get_radolan_urls}, +\item \link{get_radolan_extension}. +} +} diff --git a/man/get_radolan_urls.Rd b/man/get_radolan_urls.Rd index 71e0223c..afa4dfe3 100644 --- a/man/get_radolan_urls.Rd +++ b/man/get_radolan_urls.Rd @@ -56,3 +56,10 @@ urls <- kwb.dwd::get_radolan_urls( urls$daily_historical_urls } +\seealso{ +\itemize{ +\item \link{get_dwd_urls_metadata}, +\item \link{get_radolan_extension}, +\item \link{get_radolan_projection_string}. +} +} diff --git a/man/get_shapes_of_germany.Rd b/man/get_shapes_of_germany.Rd index 7a4ce907..7d2f0902 100644 --- a/man/get_shapes_of_germany.Rd +++ b/man/get_shapes_of_germany.Rd @@ -4,7 +4,7 @@ \alias{get_shapes_of_germany} \title{Provide List of SpatialPolygonsDataFrame for Germany} \usage{ -get_shapes_of_germany(recreate = FALSE) +get_shapes_of_germany(recreate = FALSE, use_sf = FALSE) } \arguments{ \item{recreate}{logical. If \code{TRUE} the required shape files are freshly @@ -12,7 +12,15 @@ downloaded from \url{https://gadm.org/}, transformed to the projection used in DWD data files and stored locally in an RData file. The default is \code{FALSE}, i.e. the required data are read form the locally stored RData file, provided that the file exists.} + +\item{use_sf}{passed to \code{kwb.dwd:::transform_coords}} } \description{ Provide List of SpatialPolygonsDataFrame for Germany } +\seealso{ +\itemize{ +\item \link{get_example_grid_germany}, +\item \link{download_shapes_germany}. +} +} diff --git a/man/list_extracted_radolan_files.Rd b/man/list_extracted_radolan_files.Rd new file mode 100644 index 00000000..3d60ca65 --- /dev/null +++ b/man/list_extracted_radolan_files.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_extracted_radolan_files.R +\name{list_extracted_radolan_files} +\alias{list_extracted_radolan_files} +\title{List the Locally Available Extracted Files} +\usage{ +list_extracted_radolan_files(from, to, resolution, format) +} +\arguments{ +\item{from}{begin of time interval as "yyyymm" string (4 digits year + 2 +digits month)} + +\item{to}{end of time interval as "yyyymm" string (4 digits year + 2 digits +month)} + +\item{resolution}{temporal resolution, currently one of "daily", "hourly"} + +\item{format}{file format, currently one of "asc" (ASCII text), "bin" +(binary)} +} +\value{ +paths to files on the local drive, below the folder returned by +\link{temp_dir}, that contain data in the requested \code{format}, +time \code{resolution} and time interval (specified by \code{from} and +\code{to}). +} +\description{ +List the Locally Available Extracted Files +} +\seealso{ +\itemize{ +\item \link{extract_radolan_zip_files}. +} +} diff --git a/man/list_grids_germany.Rd b/man/list_grids_germany.Rd new file mode 100644 index 00000000..d3cad338 --- /dev/null +++ b/man/list_grids_germany.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_grids_germany.R +\name{list_grids_germany} +\alias{list_grids_germany} +\title{Get URLs to Zipped Files Containing Grid Data for Germany} +\usage{ +list_grids_germany( + resolution, + extension, + variable, + from = NULL, + to = NULL, + recursive = TRUE +) +} +\arguments{ +\item{resolution}{one of "monthly", "daily"} + +\item{extension}{file extension of files to be listed, e.g. ".tgz"} + +\item{variable}{variable for which to look for URLs. Must be one of +\code{kwb.dwd::list_url(kwb.dwd:::ftp_path_grids_germany(resolution))}} + +\item{from}{optional. First month to be considered, as "yyyymm" string} + +\item{to}{optional. Last month to be considered, as "yyyymm" string} + +\item{recursive}{whether to list files recursively. Default: \code{TRUE}} +} +\description{ +Get URLs to Zipped Files Containing Grid Data for Germany +} diff --git a/man/list_monthly_grids_germany_asc_gz.Rd b/man/list_monthly_grids_germany_asc_gz.Rd deleted file mode 100644 index 95ab38c7..00000000 --- a/man/list_monthly_grids_germany_asc_gz.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{list_monthly_grids_germany_asc_gz} -\alias{list_monthly_grids_germany_asc_gz} -\title{Get URLs to Monthly Grids in Zipped ESRI-ascii-grid Format} -\usage{ -list_monthly_grids_germany_asc_gz( - variable, - from = NULL, - to = NULL, - recursive = TRUE -) -} -\arguments{ -\item{variable}{variable for which to look for URLs. Must be one of -\code{kwb.dwd::list_url(kwb.dwd:::ftp_path_monthly_grids())}} - -\item{from}{optional. First month to be considered, as "yyyymm" string} - -\item{to}{optional. Last month to be considered, as "yyyymm" string} - -\item{recursive}{whether to list files recursively. Default: \code{TRUE}} -} -\description{ -Get URLs to Monthly Grids in Zipped ESRI-ascii-grid Format -} diff --git a/man/list_url.Rd b/man/list_url.Rd index 1bc73218..6a9a56ce 100644 --- a/man/list_url.Rd +++ b/man/list_url.Rd @@ -19,11 +19,10 @@ list_url( \item{recursive}{logical indicating whether to list files in all subdirectories (default: \code{FALSE})} -\item{max_depth}{maximum folder depth to consider when -\code{recursive = TRUE}} +\item{max_depth}{maximum folder depth to consider when \code{recursive = TRUE}} -\item{full_info}{if \code{TRUE}, not only the path and filename are returned -but also the file properties. The default is \code{FALSE}.} +\item{full_info}{if \code{TRUE}, not only the path and filename are returned but +also the file properties. The default is \code{FALSE}.} \item{full_names}{if \code{TRUE}, the full URLs are returned, otherwise (the default) only the paths relative to \code{url}.} @@ -34,3 +33,8 @@ default) only the paths relative to \code{url}.} \description{ List Files or Folders in a FTP Directory } +\seealso{ +\itemize{ +\item \link{list_extracted_radolan_files}. +} +} diff --git a/man/load_potential_evaporation_berlin.Rd b/man/load_potential_evaporation_berlin.Rd index 97340f5b..236606f6 100644 --- a/man/load_potential_evaporation_berlin.Rd +++ b/man/load_potential_evaporation_berlin.Rd @@ -12,13 +12,27 @@ load_potential_evaporation_berlin(from = NULL, to = NULL) \item{to}{optional. Last month to be considered, as yyyymm string} } \value{ -data frame with columns \code{file} (name of file downloaded from - DWD), \code{year} (year number as integer), \code{month number as integer}, - \code{mean} (mean value), \code{sd} (standard deviation), \code{min} - (minimum value), \code{max} (maximum value), \code{n_values} (number of - considered values) of potential evaporation calculated for Berlin, Germany +data frame with columns +\itemize{ +\item \code{file} (name of file downloaded from DWD), +\item \code{year} (year number as integer), +\item \verb{month number as integer}, +\item \code{mean} (mean value), +\item \code{sd} (standard deviation), +\item \code{min} (minimum value), +\item \code{max} (maximum value), +\item \code{n_values} (number of considered values) +of potential evaporation calculated for Berlin, Germany +} } \description{ This function loads monthly potential evaporation for Berlin, Germany, from Deutscher Wetterdienst (DWD). } +\seealso{ +\itemize{ +\item \link{load_potential_evaporation_berlin_2}, +\item \link{get_berlin_dwd_mask}, +\item \link{load_precipitation_berlin}. +} +} diff --git a/man/load_potential_evaporation_berlin_2.Rd b/man/load_potential_evaporation_berlin_2.Rd index 4c866db7..5daa457c 100644 --- a/man/load_potential_evaporation_berlin_2.Rd +++ b/man/load_potential_evaporation_berlin_2.Rd @@ -12,13 +12,27 @@ load_potential_evaporation_berlin_2(from, to) \item{to}{optional. Last month to be considered, as yyyymm string} } \value{ -data frame with columns \code{file} (name of file downloaded from - DWD), \code{year} (year number as integer), \code{month number as integer}, - \code{mean} (mean value), \code{sd} (standard deviation), \code{min} - (minimum value), \code{max} (maximum value), \code{n_values} (number of - considered values) of potential evaporation calculated for Berlin, Germany +data frame with columns +\itemize{ +\item \code{file} (name of file downloaded from DWD), +\item \code{year} (year number as integer), +\item \code{month} (month number as integer`, +\item \code{mean} (mean value), +\item \code{sd} (standard deviation), +\item \code{min} (minimum value), +\item \code{max} (maximum value), +\item \code{n_values} (number of considered values) +of potential evaporation calculated for Berlin, Germany +} } \description{ This version uses publicly available shape files to determine the area that is covered by Berlin. This function can easily be adopted to other cities! } +\seealso{ +\itemize{ +\item \link{load_potential_evaporation_berlin}, +\item \link{get_berlin_dwd_mask}, +\item \link{load_precipitation_berlin}. +} +} diff --git a/man/load_precipitation_berlin.Rd b/man/load_precipitation_berlin.Rd index af4b1ec9..abeac757 100644 --- a/man/load_precipitation_berlin.Rd +++ b/man/load_precipitation_berlin.Rd @@ -12,13 +12,26 @@ load_precipitation_berlin(from = NULL, to = NULL) \item{to}{optional. Last month to be considered, as yyyymm string} } \value{ -data frame with columns \code{file} (name of file downloaded from - DWD), \code{year} (year number as integer), \code{month number as integer}, - \code{mean} (mean value), \code{sd} (standard deviation), \code{min} - (minimum value), \code{max} (maximum value) of precipitation - calculated for Berlin, Germany +data frame with columns +\itemize{ +\item \code{file} (name of file downloaded from DWD), +\item \code{year} (year number as integer), +\item \verb{month number as integer}, +\item \code{mean} (mean value), +\item \code{sd} (standard deviation), +\item \code{min} (minimum value), +\item \code{max} (maximum value) +of precipitation calculated for Berlin, Germany +} } \description{ This function loads monthly precipitation for Berlin, Germany, from Deutscher Wetterdienst (DWD). } +\seealso{ +\itemize{ +\item \link{load_potential_evaporation_berlin_2}, +\item \link{load_potential_evaporation_berlin}, +\item \link{get_berlin_dwd_mask}. +} +} diff --git a/man/radolan_raw_to_raster.Rd b/man/radolan_raw_to_raster.Rd index f0c4b998..26732dd6 100644 --- a/man/radolan_raw_to_raster.Rd +++ b/man/radolan_raw_to_raster.Rd @@ -17,3 +17,11 @@ radolan_raw_to_raster(rbi, version = 3) \description{ Radolan raw to raster } +\seealso{ +\itemize{ +\item \link{get_radolan_urls}, +\item \link{extract_radolan_zip_files}, +\item \link{download_radolan}, +\item \link{list_extracted_radolan_files}. +} +} diff --git a/man/read_asc_file.Rd b/man/read_asc_file.Rd new file mode 100644 index 00000000..54deb16f --- /dev/null +++ b/man/read_asc_file.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/read_asc_gz_file.R +\name{read_asc_file} +\alias{read_asc_file} +\title{Read Raster Data from .ASC File} +\usage{ +read_asc_file(file, projection = get_radolan_projection_string(), dbg = TRUE) +} +\arguments{ +\item{file}{path to .asc file} + +\item{projection}{projection string used in Radolan data} + +\item{dbg}{logical indicating whether to show debug messages} +} +\description{ +Read Raster Data from .ASC File +} diff --git a/man/read_asc_gz_file.Rd b/man/read_asc_gz_file.Rd index a998f14a..82a70402 100644 --- a/man/read_asc_gz_file.Rd +++ b/man/read_asc_gz_file.Rd @@ -17,3 +17,9 @@ object of class "RasterLayer" \description{ Read Zipped ESRI-Ascii-Grid File (from URL) } +\seealso{ +\itemize{ +\item \link{read_binary_radolan_file}, +\item \link{unzip_asc_gz_file}. +} +} diff --git a/man/read_binary_radolan_file.Rd b/man/read_binary_radolan_file.Rd index ba8854b6..50d1e03a 100644 --- a/man/read_binary_radolan_file.Rd +++ b/man/read_binary_radolan_file.Rd @@ -4,16 +4,32 @@ \alias{read_binary_radolan_file} \title{Read Binary Radolan File} \usage{ -read_binary_radolan_file(path, set_projection_and_extent = TRUE) +read_binary_radolan_file( + path, + set_projection_and_extent = TRUE, + consider_flags = FALSE +) } \arguments{ \item{path}{path to binary Radolan file} \item{set_projection_and_extent}{if \code{TRUE} (default), the projection and extent of the raster object are set to the Radolan specific values, -returned by \code{kwb.dwd::get_radolan_projection_string()} and -\code{kwb.dwd::get_radolan_extension()}, respectively.} +returned by \code{kwb.dwd::get_radolan_projection_string} and +\code{kwb.dwd::get_radolan_extension}, respectively.} + +\item{consider_flags}{logical. Should the flags be considered? If +\code{TRUE}, values where the "invalid" or "clutter" flag is set are set to +\code{NA} and values where the "negative" flag is set are negated. The +default is \code{TRUE} (for compatibility reasons) but this should change +in future!} } \description{ Read Binary Radolan File } +\seealso{ +\itemize{ +\item \link{read_asc_gz_file}, +\item \link{read_relevant_years_radolan}. +} +} diff --git a/man/read_daily_data_over_shape.Rd b/man/read_daily_data_over_shape.Rd index 83652dbd..fa951e14 100644 --- a/man/read_daily_data_over_shape.Rd +++ b/man/read_daily_data_over_shape.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_daily_data_over_shape.R +% Please edit documentation in R/read_data_over_shape.R \name{read_daily_data_over_shape} \alias{read_daily_data_over_shape} \title{Read daily data from DWD, mask region with given shape file} @@ -10,13 +10,14 @@ read_daily_data_over_shape(file, variable, from, to, quiet = FALSE) \item{file}{path to shape file .shp} \item{variable}{currently, the following variables are supported: "evapo_p", -"evapo_r", "frost_depth", "soil_moist", "soil_temperature_5cm"} +"evapo_r", "frost_depth", "soil_moist", "soil_temperature_5cm" (daily), +"evapo_p" (monthly)} \item{from}{first month as "yyyymm" string} \item{to}{last month as "yyyymm" string} -\item{quiet}{passed to \code{\link{download.file}}} +\item{quiet}{passed to \link{download.file}} } \value{ data frame @@ -25,3 +26,11 @@ data frame Currently, only full months of data can be loaded, \code{from} and \code{to} must be given } +\seealso{ +\itemize{ +\item \link{read_monthly_data_over_shape}, +\item \link{read_binary_radolan_file}, +\item \link{read_asc_gz_file}, +\item \link{read_relevant_years_radolan}. +} +} diff --git a/man/read_data_over_shape.Rd b/man/read_data_over_shape.Rd new file mode 100644 index 00000000..27332968 --- /dev/null +++ b/man/read_data_over_shape.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/read_data_over_shape.R +\name{read_data_over_shape} +\alias{read_data_over_shape} +\title{Read data from DWD, mask region with given shape file or spatial object} +\usage{ +read_data_over_shape( + resolution, + file, + variable, + from, + to, + quiet = FALSE, + shape = NULL, + use_sf = TRUE, + ... +) +} +\arguments{ +\item{resolution}{one of "daily", "monthly"} + +\item{file}{path to shape file .shp} + +\item{variable}{currently, the following variables are supported: "evapo_p", +"evapo_r", "frost_depth", "soil_moist", "soil_temperature_5cm" (daily), +"evapo_p" (monthly)} + +\item{from}{first month as "yyyymm" string} + +\item{to}{last month as "yyyymm" string} + +\item{quiet}{passed to \link{download.file}} + +\item{shape}{object of class sf or sf_layers or SpatialPolygonsDataFrame. +If \code{NULL} (the default), this object is obtained by calling +\code{kwb.dwd:::read_shape_file} on \code{file}.} + +\item{use_sf}{passed to \code{kwb.dwd:::read_shape_file} if applicable} + +\item{\dots}{further arguments passed to \code{kwb.dwd:::read_shape_file}, +such as \code{drop_z = TRUE}, if applicable} +} +\value{ +data frame +} +\description{ +Read data from DWD, mask region with given shape file or spatial object +} diff --git a/man/read_monthly_data_over_shape.Rd b/man/read_monthly_data_over_shape.Rd index 5ed8235d..0d5d1c4e 100644 --- a/man/read_monthly_data_over_shape.Rd +++ b/man/read_monthly_data_over_shape.Rd @@ -1,22 +1,41 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_monthly_data_over_shape.R +% Please edit documentation in R/read_data_over_shape.R \name{read_monthly_data_over_shape} \alias{read_monthly_data_over_shape} \title{Read monthly data from DWD, mask region with given shape file} \usage{ -read_monthly_data_over_shape(file, variable, from, to, ...) +read_monthly_data_over_shape( + file = NULL, + variable, + from, + to, + quiet = FALSE, + shape = NULL, + use_sf = TRUE, + ... +) } \arguments{ \item{file}{path to shape file .shp} -\item{variable}{currently only "evapo_p" is supported} +\item{variable}{currently, the following variables are supported: "evapo_p", +"evapo_r", "frost_depth", "soil_moist", "soil_temperature_5cm" (daily), +"evapo_p" (monthly)} \item{from}{first month as "yyyymm" string} \item{to}{last month as "yyyymm" string} -\item{\dots}{further arguments passed to \code{kwb.dwd:::read_shape_file}, -such as \code{drop_z = TRUE, use_sf = TRUE}} +\item{quiet}{passed to \link{download.file}} + +\item{shape}{object of class sf or sf_layers or SpatialPolygonsDataFrame. +If \code{NULL} (the default), this object is obtained by calling +\code{kwb.dwd:::read_shape_file} on \code{file}.} + +\item{use_sf}{passed to \code{kwb.dwd:::read_shape_file} if applicable} + +\item{...}{further arguments passed to \code{kwb.dwd:::read_shape_file}, +such as \code{drop_z = TRUE}, if applicable} } \value{ data frame @@ -24,3 +43,11 @@ data frame \description{ Read monthly data from DWD, mask region with given shape file } +\seealso{ +\itemize{ +\item \link{read_binary_radolan_file}, +\item \link{read_asc_gz_file}, +\item \link{read_relevant_years_radolan}, +\item \link{read_daily_data_over_shape}. +} +} diff --git a/man/read_relevant_years_radolan.Rd b/man/read_relevant_years_radolan.Rd index 42eae3bf..7014be10 100644 --- a/man/read_relevant_years_radolan.Rd +++ b/man/read_relevant_years_radolan.Rd @@ -15,3 +15,8 @@ read_relevant_years_radolan(path, years) This function reads in relevant radolan data from rst database based on used input data } +\seealso{ +\itemize{ +\item \link{read_binary_radolan_file}. +} +} diff --git a/man/select_shapes.Rd b/man/select_shapes.Rd index 97baf0e5..0a3b5214 100644 --- a/man/select_shapes.Rd +++ b/man/select_shapes.Rd @@ -8,15 +8,18 @@ select_shapes(shapes) } \arguments{ \item{shapes}{list of SpatialPolygonsDataFrame objects, as e.g. returned by -\code{\link{get_shapes_of_germany}}} +\link{get_shapes_of_germany}} } \value{ -list with elements \code{index} (index of SpatialPolygonsDataFrame in - \code{shapes} list), \code{variable} (column in selected - SpatialPolygonsDataFrame), \code{pattern} pattern (e.g. the name of a city) - to be matched against the values in the selected column of the - selected SpatialPolygonsDataFrame. This list simply describes how to select - a SpatialPolygon from a list of SpatialPolygonsDataFrames +list with elements +\itemize{ +\item \code{index} (index of SpatialPolygonsDataFrame in \code{shapes} list), +\item \code{variable} (column in selected SpatialPolygonsDataFrame), +\item \code{pattern} pattern (e.g. the name of a city) +to be matched against the values in the selected column of the selected +SpatialPolygonsDataFrame. This list simply describes how to select a +SpatialPolygon from a list of SpatialPolygonsDataFrames +} } \description{ Interactively Configure Selection of SpatialPolygons diff --git a/man/shapes_germany_0.Rd b/man/shapes_germany_0.Rd new file mode 100644 index 00000000..60bedd39 --- /dev/null +++ b/man/shapes_germany_0.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/datasets.R +\docType{data} +\name{shapes_germany_0} +\alias{shapes_germany_0} +\title{Shapes of German Regions (0)} +\format{ +Simple feature collection with 1 feature and 2 fields: +\itemize{ +\item \code{COUNTRY}, +\item \code{ID_0}. +} +} +\source{ +\url{https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip} +} +\usage{ +shapes_germany_0 +} +\description{ +Object of class "sf" representing a "Simple feature collection". +} +\keyword{datasets} diff --git a/man/shapes_germany_1.Rd b/man/shapes_germany_1.Rd new file mode 100644 index 00000000..95225008 --- /dev/null +++ b/man/shapes_germany_1.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/datasets.R +\docType{data} +\name{shapes_germany_1} +\alias{shapes_germany_1} +\title{Shapes of German Regions (1)} +\format{ +Simple feature collection with 16 features and 11 fields: +\itemize{ +\item \code{ID_0}, +\item \code{COUNTRY}, +\item \code{ID_1}, +\item \code{NAME_1}, +\item \code{VARNAME_1}, +\item \code{NL_NAME_1}, +\item \code{TYPE_1}, +\item \code{ENGTYPE_1}, +\item \code{CC_1}, +\item \code{HASC_1}, +\item \code{ISO_1}. +} +} +\source{ +\url{https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip} +} +\usage{ +shapes_germany_1 +} +\description{ +Object of class "sf" representing a "Simple feature collection". +} +\keyword{datasets} diff --git a/man/shapes_germany_2.Rd b/man/shapes_germany_2.Rd new file mode 100644 index 00000000..9be85a4f --- /dev/null +++ b/man/shapes_germany_2.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/datasets.R +\docType{data} +\name{shapes_germany_2} +\alias{shapes_germany_2} +\title{Shapes of German Regions (2)} +\format{ +Simple feature collection with 403 features and 12 fields: +\itemize{ +\item \code{ID_0}, +\item \code{COUNTRY}, +\item \code{NAME_1}, +\item \code{NL_NAME_1}, +\item \code{ID_2}, +\item \code{NAME_2}, +\item \code{VARNAME_2}, +\item \code{NL_NAME_2}, +\item \code{TYPE_2}, +\item \code{ENGTYPE_2}, +\item \code{CC_2}, +\item \code{HASC_2}. +} +} +\source{ +\url{https://geodata.ucdavis.edu/gadm/gadm4.0/shp/gadm40_DEU_shp.zip} +} +\usage{ +shapes_germany_2 +} +\description{ +Object of class "sf" representing a "Simple feature collection". +} +\keyword{datasets} diff --git a/man/temp_dir.Rd b/man/temp_dir.Rd new file mode 100644 index 00000000..77bbeeee --- /dev/null +++ b/man/temp_dir.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{temp_dir} +\alias{temp_dir} +\title{Path to Permanent Temporary Directory} +\usage{ +temp_dir(..., template = NULL, create = TRUE, dbg = FALSE) +} +\arguments{ +\item{\dots}{parts of the path after \verb{/R_kwb.dwd/}, passed to +\link{file.path}] where \verb{} is either the value of environment variable +\code{TEMP} (if set) or \code{TMP} (if set) or the result of calling \link{tempdir}.} + +\item{template}{optional. If given, it is assumed to be a path to a file. The +name of the file without file name extension is then used as folder name +below \verb{/R_kwb.dwd/}.} + +\item{create}{logical indicating whether or not to create the folder if it +does not yet exist. Defaults to \code{TRUE}.} + +\item{dbg}{logical indicating whether or not to print debug messages} +} +\value{ +The function returns the path to the temporary folder specified. +} +\description{ +Path to Permanent Temporary Directory +} diff --git a/man/unzip_asc_gz_file.Rd b/man/unzip_asc_gz_file.Rd index 81749a81..00319405 100644 --- a/man/unzip_asc_gz_file.Rd +++ b/man/unzip_asc_gz_file.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/unzip_asc_gz_file.R +% Please edit documentation in R/unzip.R \name{unzip_asc_gz_file} \alias{unzip_asc_gz_file} \title{Download a .gz File and Unzip it} @@ -19,3 +19,11 @@ path to the unzipped file \description{ Download a .gz File and Unzip it } +\seealso{ +\itemize{ +\item \link{read_binary_radolan_file}, +\item \link{convert_bin_to_raster_file}, +\item \link{read_asc_gz_file}, +\item \link{write_raster_to_file}. +} +} diff --git a/man/write_raster_to_file.Rd b/man/write_raster_to_file.Rd index 1b217458..b2be6313 100644 --- a/man/write_raster_to_file.Rd +++ b/man/write_raster_to_file.Rd @@ -19,3 +19,8 @@ write raster to file \description{ Write raster to file } +\seealso{ +\itemize{ +\item \link{convert_bin_to_raster_file}. +} +} diff --git a/tests/testthat/test-function-assert_all_ending_with.R b/tests/testthat/test-function-assert_all_ending_with.R new file mode 100644 index 00000000..ca847957 --- /dev/null +++ b/tests/testthat/test-function-assert_all_ending_with.R @@ -0,0 +1,9 @@ +test_that("assert_all_ending_with() works", { + + f <- kwb.dwd:::assert_all_ending_with + + expect_error(f()) + expect_error(f("abc")) + expect_silent(f("abc", "c")) + expect_silent(f("abc.gz", ".gz")) +}) diff --git a/tests/testthat/test-function-assert_ending_gz.R b/tests/testthat/test-function-assert_ending_gz.R deleted file mode 100644 index 35ffc261..00000000 --- a/tests/testthat/test-function-assert_ending_gz.R +++ /dev/null @@ -1,8 +0,0 @@ -test_that("assert_ending_gz() works", { - - f <- kwb.dwd:::assert_ending_gz - - expect_error(f()) - expect_error(f("abc")) - expect_silent(f("abc.gz")) -}) diff --git a/tests/testthat/test-function-check_or_download_shapes_germany.R b/tests/testthat/test-function-check_or_download_shapes_germany.R deleted file mode 100644 index 942ac990..00000000 --- a/tests/testthat/test-function-check_or_download_shapes_germany.R +++ /dev/null @@ -1,8 +0,0 @@ -test_that("check_or_download_shapes_germany() works", { - - f <- kwb.dwd:::check_or_download_shapes_germany - - capture.output(result <- f(quiet = TRUE)) - - expect_true(file.exists(result)) -}) diff --git a/tests/testthat/test-function-download.R b/tests/testthat/test-function-download.R new file mode 100644 index 00000000..88f42152 --- /dev/null +++ b/tests/testthat/test-function-download.R @@ -0,0 +1,23 @@ +#library(testthat) + +test_that("download() works", { + + f <- kwb.dwd:::download + + expect_error(f()) + expect_error(expect_output(suppressWarnings(f("no-such-url")))) + + url <- default_projection_file(download = FALSE) + + target_dir <- tempdir() + + expect_output(file <- f(url, target_dir = target_dir)) + expect_output(file <- f(url, target_dir = target_dir), "already there") + + expect_true(file.exists(file)) + + unlink(file) + + expect_silent(file <- f(url, target_dir = target_dir, quiet = TRUE)) + +}) diff --git a/tests/testthat/test-function-download_and_extract.R b/tests/testthat/test-function-download_and_extract.R index d74f8f3e..e74dd2b1 100644 --- a/tests/testthat/test-function-download_and_extract.R +++ b/tests/testthat/test-function-download_and_extract.R @@ -2,8 +2,7 @@ test_that("download_and_extract() works", { f <- kwb.dwd:::download_and_extract - capture.output(url <- kwb.dwd:::list_daily_grids_germany_tgz("evapo_p")[1L]) - + capture.output(url <- kwb.dwd:::list_grids_germany("daily", ".tgz", "evapo_p")[1L]) capture.output(result <- f(url, quiet = TRUE)) expect_type(result, "character") diff --git a/tests/testthat/test-function-download_daily_grids_germany.R b/tests/testthat/test-function-download_daily_grids_germany.R index e1432436..69442582 100644 --- a/tests/testthat/test-function-download_daily_grids_germany.R +++ b/tests/testthat/test-function-download_daily_grids_germany.R @@ -1,11 +1,13 @@ +#library(testthat) + test_that("download_daily_grids_germany() works", { f <- kwb.dwd:::download_daily_grids_germany expect_error(f()) - expect_error(f("x")) + expect_error(f("x"), "must be one of 'evapo_p'") - capture.output(result <- f("evapo_p", quiet = TRUE)) + capture.output(result <- f(variable = "evapo_p", quiet = TRUE)) expect_type(result, "character") expect_true(all(sapply(result, file.exists))) diff --git a/tests/testthat/test-function-download_if_not_there.R b/tests/testthat/test-function-download_if_not_there.R deleted file mode 100644 index 0af3ad97..00000000 --- a/tests/testthat/test-function-download_if_not_there.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:25. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("download_if_not_there() works", { - - f <- kwb.dwd:::download_if_not_there - - expect_error( - f() - # argument "url" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-download_monthly_grids_germany.R b/tests/testthat/test-function-download_monthly_grids_germany.R index 244bf168..7ba08ad1 100644 --- a/tests/testthat/test-function-download_monthly_grids_germany.R +++ b/tests/testthat/test-function-download_monthly_grids_germany.R @@ -1,9 +1,11 @@ +#library(testthat) + test_that("download_monthly_grids_germany() works", { f <- kwb.dwd:::download_monthly_grids_germany - expect_error(f()) - expect_error(f("unknown-variable"), "should be one of") + expect_error(f(), 'argument "variable" is missing') + expect_error(f("unknown-variable"), "must be one of") expect_output(result <- f("evapo_p")) diff --git a/tests/testthat/test-function-download_shapes_germany.R b/tests/testthat/test-function-download_shapes_germany.R new file mode 100644 index 00000000..f79b0d2f --- /dev/null +++ b/tests/testthat/test-function-download_shapes_germany.R @@ -0,0 +1,24 @@ +#library(testthat) + +test_that("download_shapes_germany() works", { + + f <- kwb.dwd:::download_shapes_germany + + result <- try(f(quiet = FALSE, timeout = 1)) + + if (kwb.utils::isTryError(result)) { + + expect_match( + as.character(result), + "Could not download .* within 1 seconds" + ) + + + } else { + + expect_true(file.exists(result)) + #unlink(result, recursive = TRUE) + #unlink("~/../Downloads/shapes_germany/gadm40_DEU_shp.zip") + } + +}) diff --git a/tests/testthat/test-function-extract_metadata_from_files_daily.R b/tests/testthat/test-function-extract_metadata_from_files_daily.R deleted file mode 100644 index f2b53c36..00000000 --- a/tests/testthat/test-function-extract_metadata_from_files_daily.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:27. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("extract_metadata_from_files_daily() works", { - - f <- kwb.dwd:::extract_metadata_from_files_daily - - expect_error( - f() - # argument "files" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-extract_metadata_from_files_monthly.R b/tests/testthat/test-function-extract_metadata_from_files_monthly.R deleted file mode 100644 index 5bd67173..00000000 --- a/tests/testthat/test-function-extract_metadata_from_files_monthly.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-20 04:44:47. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("extract_metadata_from_files_monthly() works", { - - f <- kwb.dwd:::extract_metadata_from_files_monthly - - expect_error( - f() - # argument "files" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-extract_yyyymm.R b/tests/testthat/test-function-extract_yyyymm.R deleted file mode 100644 index 75591c19..00000000 --- a/tests/testthat/test-function-extract_yyyymm.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:30. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("extract_yyyymm() works", { - - f <- kwb.dwd:::extract_yyyymm - - expect_error( - f() - # argument "x" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-filter_by_extension_asc_gz.R b/tests/testthat/test-function-filter_by_extension_asc_gz.R deleted file mode 100644 index 626e8745..00000000 --- a/tests/testthat/test-function-filter_by_extension_asc_gz.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:30. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("filter_by_extension_asc_gz() works", { - - f <- kwb.dwd:::filter_by_extension_asc_gz - - expect_error( - f() - # argument "x" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-filter_by_extension_tgz.R b/tests/testthat/test-function-filter_by_extension_tgz.R deleted file mode 100644 index b12d6d49..00000000 --- a/tests/testthat/test-function-filter_by_extension_tgz.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:30. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("filter_by_extension_tgz() works", { - - f <- kwb.dwd:::filter_by_extension_tgz - - expect_error( - f() - # argument "x" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-find_description_files.R b/tests/testthat/test-function-find_description_files.R index f45a673c..38d9557a 100644 --- a/tests/testthat/test-function-find_description_files.R +++ b/tests/testthat/test-function-find_description_files.R @@ -4,7 +4,9 @@ test_that("find_description_files() works", { expect_error(f()) - expect_output(result <- f(kwb.dwd:::ftp_path_daily_grids("evapo_p/any-file"))) + expect_output( + result <- f(kwb.dwd:::ftp_path_grids_germany("daily", "evapo_p/any-file")) + ) expect_true("DESCRIPTION_gridsgermany_daily_evapo_p_en.pdf" %in% result) }) diff --git a/tests/testthat/test-function-frequency_prefix.R b/tests/testthat/test-function-frequency_prefix.R deleted file mode 100644 index bef275ce..00000000 --- a/tests/testthat/test-function-frequency_prefix.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:40:06. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("frequency_prefix() works", { - - f <- kwb.dwd:::frequency_prefix - - expect_error( - f() - # argument "frequency" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-ftp_path_daily_grids.R b/tests/testthat/test-function-ftp_path_daily_grids.R deleted file mode 100644 index 83006c3b..00000000 --- a/tests/testthat/test-function-ftp_path_daily_grids.R +++ /dev/null @@ -1,10 +0,0 @@ -test_that("ftp_path_daily_grids() works", { - - f <- kwb.dwd:::ftp_path_daily_grids - - result <- f() - - expect_type(result, "character") - expect_length(result, 1L) - expect_true(startsWith(result, "ftp://")) -}) diff --git a/tests/testthat/test-function-ftp_path_grids_germany.R b/tests/testthat/test-function-ftp_path_grids_germany.R new file mode 100644 index 00000000..9e9d0017 --- /dev/null +++ b/tests/testthat/test-function-ftp_path_grids_germany.R @@ -0,0 +1,17 @@ +test_that("ftp_path_grids_germany() works", { + + f <- kwb.dwd:::ftp_path_grids_germany + + expect_error(f()) + expect_error(f("unknown-resolution")) + + check <- function(x) { + expect_type(x, "character") + expect_length(x, 1L) + expect_true(startsWith(x, "ftp://")) + expect_true(grepl(x, x)) + } + + check(f("monthly")) + check(f("daily")) +}) diff --git a/tests/testthat/test-function-ftp_path_monthly_grids.R b/tests/testthat/test-function-ftp_path_monthly_grids.R deleted file mode 100644 index eab68c72..00000000 --- a/tests/testthat/test-function-ftp_path_monthly_grids.R +++ /dev/null @@ -1,10 +0,0 @@ -test_that("ftp_path_monthly_grids() works", { - - f <- kwb.dwd:::ftp_path_monthly_grids - - result <- f() - - expect_type(result, "character") - expect_length(result, 1L) - expect_true(startsWith(result, "ftp://")) -}) diff --git a/tests/testthat/test-function-get_daily_data_from_grid_files.R b/tests/testthat/test-function-get_daily_data_from_grid_files.R deleted file mode 100644 index aed0c840..00000000 --- a/tests/testthat/test-function-get_daily_data_from_grid_files.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:27. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("get_daily_data_from_grid_files() works", { - - f <- kwb.dwd:::get_daily_data_from_grid_files - - expect_error( - f() - # argument "grid_files" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-get_data_from_grid_files.R b/tests/testthat/test-function-get_data_from_grid_files.R new file mode 100644 index 00000000..df2775a8 --- /dev/null +++ b/tests/testthat/test-function-get_data_from_grid_files.R @@ -0,0 +1,9 @@ +#library(testthat) + +test_that("get_data_from_grid_files() works", { + + f <- kwb.dwd:::get_data_from_grid_files + + expect_error(f()) + expect_error(f("no-such-resolution")) +}) diff --git a/tests/testthat/test-function-get_example_grid_germany.R b/tests/testthat/test-function-get_example_grid_germany.R index d4c3c44e..4341ed5e 100644 --- a/tests/testthat/test-function-get_example_grid_germany.R +++ b/tests/testthat/test-function-get_example_grid_germany.R @@ -2,7 +2,7 @@ test_that("get_example_grid_germany() works", { f <- kwb.dwd:::get_example_grid_germany - capture.output(suppressMessages(result <- f())) + capture.output(suppressWarnings(result <- f())) expect_true(inherits(result, "RasterLayer")) }) diff --git a/tests/testthat/test-function-get_shape_of_german_region.R b/tests/testthat/test-function-get_shape_of_german_region.R index 1b8a6c08..2b40e9f1 100644 --- a/tests/testthat/test-function-get_shape_of_german_region.R +++ b/tests/testthat/test-function-get_shape_of_german_region.R @@ -1,17 +1,14 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:40:56. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# +#library(testthat) test_that("get_shape_of_german_region() works", { f <- kwb.dwd:::get_shape_of_german_region - expect_error( - f() - # argument "name" is missing, with no default - ) + expect_error(f()) + expect_error(f("no-such-region"), "No such element") + + result <- f("berlin") + + expect_s3_class(result, "sf") }) diff --git a/tests/testthat/test-function-get_shapes_of_germany.R b/tests/testthat/test-function-get_shapes_of_germany.R index c2ddc8e3..57553051 100644 --- a/tests/testthat/test-function-get_shapes_of_germany.R +++ b/tests/testthat/test-function-get_shapes_of_germany.R @@ -1,13 +1,12 @@ #library(testthat) + test_that("get_shapes_of_germany() works", { f <- kwb.dwd:::get_shapes_of_germany - capture.output(result <- f()) + result <- f() expect_true(is.list(result)) - expect_length(result, 4L) - - # Running the function again should load from an RData file - expect_output(f(), "Loading.*from.*RData") + expect_length(result, 3L) + expect_true(all(sapply(result, inherits, "sf"))) }) diff --git a/tests/testthat/test-function-last_month.R b/tests/testthat/test-function-last_month.R new file mode 100644 index 00000000..cd17113e --- /dev/null +++ b/tests/testthat/test-function-last_month.R @@ -0,0 +1,14 @@ +test_that("last_month_as_yyyymm() works", { + + f <- kwb.dwd:::last_month + + test_properties <- function(x, pattern) { + expect_type(x, "character") + expect_length(x, 1L) + expect_true(startsWith(x, substr(Sys.Date(), 1L, 4L))) + expect_true(grepl(pattern, x)) + } + + test_properties(f(), "\\d{6}") + test_properties(f(format = "%Y-%m"), "\\d{4}-\\d{2}") +}) diff --git a/tests/testthat/test-function-last_month_as_yyyymm.R b/tests/testthat/test-function-last_month_as_yyyymm.R deleted file mode 100644 index 0b8839db..00000000 --- a/tests/testthat/test-function-last_month_as_yyyymm.R +++ /dev/null @@ -1,10 +0,0 @@ -test_that("last_month_as_yyyymm() works", { - - f <- kwb.dwd:::last_month_as_yyyymm - - result <- f() - - expect_type(result, "character") - expect_length(result, 1L) - expect_true(startsWith(result, substr(Sys.Date(), 1L, 4L))) -}) diff --git a/tests/testthat/test-function-list_daily_grids_germany_tgz.R b/tests/testthat/test-function-list_daily_grids_germany_tgz.R deleted file mode 100644 index 518eb410..00000000 --- a/tests/testthat/test-function-list_daily_grids_germany_tgz.R +++ /dev/null @@ -1,7 +0,0 @@ -test_that("list_daily_grids_germany_tgz() works", { - - f <- kwb.dwd:::list_daily_grids_germany_tgz - - expect_error(f()) - -}) diff --git a/tests/testthat/test-function-list_files_in_zip_files.R b/tests/testthat/test-function-list_files_in_zip_files.R index 91a7932e..175a6217 100644 --- a/tests/testthat/test-function-list_files_in_zip_files.R +++ b/tests/testthat/test-function-list_files_in_zip_files.R @@ -1,10 +1,10 @@ +#library(testthat) + test_that("list_files_in_zip_files() works", { f <- kwb.dwd:::list_files_in_zip_files expect_error(f()) - expect_warning(expect_error( - f(c("no-such-file-1", "no-such-file-2"), dbg = FALSE) - )) + expect_error(f(c("no-such-file-1", "no-such-file-2"), dbg = FALSE)) }) diff --git a/tests/testthat/test-function-list_grids_germany.R b/tests/testthat/test-function-list_grids_germany.R new file mode 100644 index 00000000..039eb905 --- /dev/null +++ b/tests/testthat/test-function-list_grids_germany.R @@ -0,0 +1,24 @@ +#library(testthat) + +test_that("list_grids_germany() works", { + + f <- kwb.dwd:::list_grids_germany + + expect_error(f()) + + expect_error( + f("hourly"), + "must be one of 'monthly', 'daily'" + ) + + expect_error( + f("daily", ".tgz", "sunshine_duration"), + "must be one of 'evapo_p'" + ) + + expect_output( + result <- f("monthly", ".tgz", "sunshine_duration", recursive = FALSE) + ) + + expect_identical(result, character(0)) +}) diff --git a/tests/testthat/test-function-list_monthly_grids_germany_asc_gz.R b/tests/testthat/test-function-list_monthly_grids_germany_asc_gz.R deleted file mode 100644 index 240e4b33..00000000 --- a/tests/testthat/test-function-list_monthly_grids_germany_asc_gz.R +++ /dev/null @@ -1,10 +0,0 @@ -test_that("list_monthly_grids_germany_asc_gz() works", { - - f <- kwb.dwd:::list_monthly_grids_germany_asc_gz - - expect_error(f()) - expect_error(f("no-such-variable")) - - expect_output(result <- f("sunshine_duration", recursive = FALSE)) - expect_identical(result, character(0)) -}) diff --git a/tests/testthat/test-function-main_columns_first.R b/tests/testthat/test-function-main_columns_first.R deleted file mode 100644 index c1856ccd..00000000 --- a/tests/testthat/test-function-main_columns_first.R +++ /dev/null @@ -1,14 +0,0 @@ -test_that("main_columns_first() works", { - - f <- kwb.dwd:::main_columns_first - - expect_error(f()) - - x <- data.frame(a = 1, b = 2) - - expect_identical(f(x), x) - - x <- data.frame(isdir = TRUE, file = "a") - - expect_identical(f(x), x[, 2:1]) -}) diff --git a/tests/testthat/test-function-month_numbers.R b/tests/testthat/test-function-month_numbers.R deleted file mode 100644 index 0b6b54d5..00000000 --- a/tests/testthat/test-function-month_numbers.R +++ /dev/null @@ -1,9 +0,0 @@ -test_that("month_numbers() works", { - - f <- kwb.dwd:::month_numbers - - result <- f() - - expect_true(is.list(result)) - expect_identical(as.integer(result), 1:12) -}) diff --git a/tests/testthat/test-function-month_sequence.R b/tests/testthat/test-function-month_sequence.R index 7cbe8e17..4be41ce1 100644 --- a/tests/testthat/test-function-month_sequence.R +++ b/tests/testthat/test-function-month_sequence.R @@ -1,17 +1,23 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:30. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# +#library(testthat) test_that("month_sequence() works", { f <- kwb.dwd:::month_sequence - expect_error( - f() - # argument "start" is missing, with no default + expect_error(f()) + + expect_identical( + f("202301", "202302"), + as.Date(c("2023-01-01", "2023-02-01")) + ) + + expect_identical( + f("202311", "202402"), + as.Date(c("2023-11-01", "2023-12-01", "2024-01-01", "2024-02-01")) ) + expect_identical( + f("202311", "202402", simple = TRUE), + c("202311", "202312", "202401", "202402") + ) }) diff --git a/tests/testthat/test-function-month_sequence_simple.R b/tests/testthat/test-function-month_sequence_simple.R deleted file mode 100644 index 86abcdc9..00000000 --- a/tests/testthat/test-function-month_sequence_simple.R +++ /dev/null @@ -1,17 +0,0 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:30. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# - -test_that("month_sequence_simple() works", { - - f <- kwb.dwd:::month_sequence_simple - - expect_error( - f() - # argument "from" is missing, with no default - ) - -}) diff --git a/tests/testthat/test-function-open_description.R b/tests/testthat/test-function-open_description.R index 218bcc3c..1526564b 100644 --- a/tests/testthat/test-function-open_description.R +++ b/tests/testthat/test-function-open_description.R @@ -4,6 +4,9 @@ test_that("open_description() works", { expect_error(f()) - expect_output(result <- f(kwb.dwd:::ftp_path_daily_grids("evapo_p"))) + expect_output( + result <- f(kwb.dwd:::ftp_path_grids_germany("daily", "evapo_p")) + ) + expect_null(result) }) diff --git a/tests/testthat/test-function-raster_stats.R b/tests/testthat/test-function-raster_stats.R index a0b4d694..baf2a123 100644 --- a/tests/testthat/test-function-raster_stats.R +++ b/tests/testthat/test-function-raster_stats.R @@ -1,17 +1,18 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:40:56. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# +#library(testthat) test_that("raster_stats() works", { f <- kwb.dwd:::raster_stats - expect_error( - f() - # argument "r" is missing, with no default - ) + expect_error(f()) + expect_error(f(1)) + + r <- raster::raster(matrix(1:12, nrow = 3)) + result <- f(r) + + expect_identical( + colnames(result), + c("mean", "sd", "min", "max", "n_values") + ) }) diff --git a/tests/testthat/test-function-read_asc_gz_file_into_matrix.R b/tests/testthat/test-function-read_asc_gz_file_into_matrix.R index 6555e23d..6ec5b375 100644 --- a/tests/testthat/test-function-read_asc_gz_file_into_matrix.R +++ b/tests/testthat/test-function-read_asc_gz_file_into_matrix.R @@ -1,17 +1,21 @@ -# -# This test file has been generated by kwb.test::create_test_files() -# launched by user hsonne on 2022-09-16 16:43:25. -# Your are strongly encouraged to modify the dummy functions -# so that real cases are tested. You should then delete this comment. -# +#library(testthat) test_that("read_asc_gz_file_into_matrix() works", { f <- kwb.dwd:::read_asc_gz_file_into_matrix - expect_error( - f() - # argument "url" is missing, with no default + expect_error(f()) + + url <- kwb.dwd:::list_grids_germany( + resolution = "monthly", + extension = ".asc.gz", + variable = "evapo_p", + from = "202001", + to = "202001" ) + result <- f(file = url) + + expect_true(is.matrix(result)) + expect_true("NODATA_value" %in% names(attributes(result))) }) diff --git a/tests/testthat/test-function-read_relevant_years_radolan.R b/tests/testthat/test-function-read_relevant_years_radolan.R index 70343077..82c5b37d 100644 --- a/tests/testthat/test-function-read_relevant_years_radolan.R +++ b/tests/testthat/test-function-read_relevant_years_radolan.R @@ -1,8 +1,10 @@ +#library(testthat) + test_that("read_relevant_years_radolan() works", { - f <- kwb.dwd:::read_relevant_years_radolan + f <- kwb.dwd::read_relevant_years_radolan - expect_error(f()) + expect_error(f(), 'argument "years" is missing') expect_error(f(years = 1999L)) expect_error(f("/no/such/path", years = 2000L)) @@ -11,6 +13,10 @@ test_that("read_relevant_years_radolan() works", { writeLines("this is a test", file.path(tempdir(), "0-test.gri")) - expect_error(result <- f(tempdir(), 2000L), "Cannot create a RasterLayer") + expect_error( + result <- suppressWarnings(f(path = tempdir(), years = 2000L)), + "Cannot create a RasterLayer" + ) + expect_null(result) }) diff --git a/tests/testthat/test-function-temp_dir.R b/tests/testthat/test-function-temp_dir.R index e7ccf931..ee5bbe97 100644 --- a/tests/testthat/test-function-temp_dir.R +++ b/tests/testthat/test-function-temp_dir.R @@ -11,5 +11,5 @@ test_that("temp_dir() works", { result <- f("test") expect_true(file.exists(result)) - expect_error(f("a", "b", template. = "x"), "Further arguments .* not allowed") + expect_error(f("a", "b", template = "x"), "Further arguments .* not allowed") }) diff --git a/tests/testthat/test-function-url_projection.R b/tests/testthat/test-function-url_projection.R deleted file mode 100644 index e1982e7f..00000000 --- a/tests/testthat/test-function-url_projection.R +++ /dev/null @@ -1,10 +0,0 @@ -test_that("url_projection() works", { - - f <- kwb.dwd:::url_projection - - result <- f() - - expect_type(result, "character") - expect_length(result, 1L) - expect_true(endsWith(result, ".prj")) -}) diff --git a/vignettes/overview.Rmd b/vignettes/overview.Rmd new file mode 100644 index 00000000..a2ad960b --- /dev/null +++ b/vignettes/overview.Rmd @@ -0,0 +1,483 @@ +--- +title: "Overview on Functions in R-package kwb.dwd" +output: + rmarkdown::html_vignette: + toc: true +vignette: > + %\VignetteIndexEntry{Overview} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + chunk_output_type: console +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = FALSE +) + +hyperlink <- function(x) sprintf("[%s](%s)", x, x) +``` + +## List and Download Data from Deutscher Wetterdienst (DWD) + +DWD provides data for download via a web interface. The base address to the web interface is: `r hyperlink("https://opendata.dwd.de")`. + +There is also an FTP server. The base address to the ftp server +is: `r hyperlink("ftp://opendata.dwd.de")`. + +The most relevant files are in +`r hyperlink("ftp://opendata.dwd.de/climate_environment/CDC")`. + +You may use the function `ftp_path_cdc` to get this path: + +```{r} +kwb.dwd:::ftp_path_cdc() +``` + +### List Files or Folders in a FTP Directory + +The package contains a function to list all files below a certain +FTP address. + +Function: `list_url()` + +Example: + +```{r} +base_url <- kwb.dwd:::ftp_path_cdc("grids_germany") +files <- kwb.dwd::list_url(base_url, max_depth = 1L) +head(files) +``` + +Set the argument `full_names` to `TRUE` to get the full addresses. + +### What files are available on DWD's FTP Server? + +Getting a full list of all available files using the `list_url` function takes a while. +Therefore this package contains a data frame with all file paths +as they were available when the package was last updated. + +Dataset: `dwd_files` + +Example: + +```{r} +file_info <- kwb.dwd::dwd_files + +# Which files have "evapo" (evaporation) in their name? +is_evapo <- grep("evapo", file_info$file) + +head(file_info[is_evapo, c("file", "size", "modification_time")]) +``` + +### Get URLs to Radolan Files + +Function: `get_radolan_urls()` + +```{r} +radolan_urls <- kwb.dwd::get_radolan_urls() + +head(radolan_urls$daily_historical_urls) +tail(radolan_urls$hourly_historical_urls) +``` + +### Get URLs to Monthly Grids in Zipped ESRI-ascii-grid Format + +Function: `list_grids_germany()` + +Example: + +```{r eval = FALSE} +urls <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "precipitation") + +head(urls) +``` + +``` +[1] "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/precipitation/01_Jan/grids_germany_monthly_precipitation_188101.asc.gz" +[2] "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/precipitation/01_Jan/grids_germany_monthly_precipitation_188201.asc.gz" +[3] "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/precipitation/01_Jan/grids_germany_monthly_precipitation_188301.asc.gz" +[4] "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/precipitation/01_Jan/grids_germany_monthly_precipitation_188401.asc.gz" +[5] "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/precipitation/01_Jan/grids_germany_monthly_precipitation_188501.asc.gz" +[6] "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/precipitation/01_Jan/grids_germany_monthly_precipitation_188601.asc.gz" +``` + +### Get URLs to DWD Metadata + +Function: `get_dwd_urls_metadata()` + +Example: + +```{r} +urls_meta <- kwb.dwd::get_dwd_urls_metadata() + +head(urls_meta) + +# Read the content of one metadata file +writeLines(kwb.utils::readLinesWithEncoding( + urls_meta[1L], + fileEncoding = "WINDOWS-1252", + n = 10 +)) +``` + +### For a Given URL, Try to Find Description Files + +Function: `find_description_files()` + +Once you have a URL to a data file, you can look for description files that may +be contained in the same folder: + +```{r} +example_url <- paste0( + "ftp://opendata.dwd.de/climate_environment/CDC/observations_germany/", + "climate/daily/kl/historical/tageswerte_KL_05424_19490301_20211231_hist.zip" +) + +kwb.dwd:::find_description_files(example_url) +``` + +### Open Description for DWD Record in Web Browser + +Function: `open_description()` + +Example: + +```{r eval = FALSE} +kwb.dwd::open_description(example_url) +``` + +You will be asked something like this if there are description files available: + +``` +Which file should I open? (0 = Cancel) + +1: BESCHREIBUNG_obsgermany_climate_daily_kl_historical_de.pdf +2: DESCRIPTION_obsgermany_climate_daily_kl_historical_en.pdf +3: KL_Tageswerte_Beschreibung_Stationen.txt +4: KL_Tageswerte_mn4_Beschreibung_Stationen.txt + +Auswahl: +``` + +### Download Radolan Data in Binary Format from DWD Server + +Function: `download_radolan()` + +Example: + +```{r eval = FALSE} +# Take care, this takes time! +kwb.dwd::download_radolan(resolution = "daily") +``` + +```{r} +head(dir(kwb.dwd:::download_dir("radolan/daily/historical"))) +``` + +## Download data from other sources + +### Download Shape Files for Germany + +Function: `download_shapes_germany()` + +This function downloads shape files for Germany. They are not provided by DWD +so this package may not be the best place for this function. + +```{r} +target_path <- kwb.dwd::download_shapes_germany() +``` + +Shape files have been downloaded and extracted to the target path: + +```{r} +shape_files <- dir(target_path, "[.]shp$", recursive = TRUE, full.names = TRUE) +shape_files +``` + +What can we do with these shape files? We can read and show them, for example: + +```{r fig.width = 6} +shape <- sf::read_sf(shape_files[2L]) +plot(shape[, "NAME_1"]) +``` + +### Provide List of SpatialPolygonsDataFrame for Germany + +Function: `get_shapes_of_germany()` + +Example: + +```{r eval = FALSE} +shapes <- kwb.dwd::get_shapes_of_germany() +``` + +### Interactively Configure Selection of SpatialPolygons + +Function: `select_shapes()` + +Example: + +```{r eval = FALSE} +kwb.dwd:::select_shapes(shapes) +``` + +You will be asked to select a layer... + +``` +Select layer + +1: gadm40_DEU_1.shp +2: gadm40_DEU_2.shp +3: gadm40_DEU_3.shp +4: gadm40_DEU_4.shp + +Auswahl: +``` + +### Let User Select a Column from a SpatialPolygonsDataFrame + +Function: `select_variable()` + +Example: + +```{r eval = FALSE} +kwb.dwd:::select_variable(shapes[[2L]]) +``` + +You will be asked to select a variable... + +``` +Select variable + +1: ID_0 (DEU) +2: COUNTRY (Germany) +3: NAME_1 (Baden-Württemberg, Bayern, Berlin) +4: ID_2 (DEU.1.1_1, DEU.1.2_1, DEU.1.3_1) +5: NAME_2 (Alb-Donau-Kreis, Baden-Baden, Biberach) +6: TYPE_2 (Landkreis, Stadtkreis, Water body) +7: ENGTYPE_2 (District, Water body) +8: CC_2 (08425, 08211, 08426) +9: HASC_2 (DE.BW.AD, DE.BW.BB, DE.BW.BR) +``` + +## Extract downloaded files + +### Extract radolan zip files + +Function: `extract_radolan_zip_files()` + +### Download a .gz File and Unzip it + +Function: `unzip_asc_gz_file()` + +## Conversion + +### Convert Binary Radolan File to Raster File + +Function: `convert_bin_to_raster_file()` + +We need a binary file as provided by DWD. See above for how to download +Radolan binary files. + +```{r} +bin_file <- file.path( + kwb.dwd:::download_dir("radolan"), + "raa01-sf_10000-1808041150-dwd---bin" +) + +raster <- kwb.dwd::convert_bin_to_raster_file(bin_file) +``` + +We can plot the content of the raster file using the `plot` function of the +raster package: + +```{r fig.width = 6} +raster::plot(raster) +``` + +### Radolan raw to raster + +Function: `radolan_raw_to_raster()` + +### Conversion of coordinates + +#### Coordinates to EPSG-4326 + +Function: `coordinates_to_EPSG_4326()` + +```{r} +kwb.dwd::coordinates_to_EPSG_4326(longitude = 0, latitude = 0) +``` + +Where do we need this? Good question, next question. + +### Cropping + +Crop a circle-shaped region from the Radolan data grid of Germany + +Function: `crop_radolan_radial()` + +We need a folder with rst files... + +```{r eval = FALSE} +rst_path <- kwb.dwd:::download_dir("rst") + +files <- dir(rst_path, full.names = TRUE) + +radolan_data <- raster::stack(files) + +names(radolan_data) <- substr( + gsub("raa01-sf_10000-", "", basename(files)), + start = 1, + stop = 6 +) + +# Error! +#radolan_data <- kwb.dwd::read_relevant_years_radolan( +# rst_path, years = 2018 +#) + +cropped <- kwb.dwd::crop_radolan_radial( + radolan_data, + latitude = 52.520008, + longitude = 13.404954 +) + +# What does the warning mean? +cropped +``` + +**Problem here:** `read_relevant_years_radolan` is too specific, expects a certain file name pattern + +## Functions Related to Radolan Data + +that are not alread mentioned elsewhere... + +### Get Radolan Extension ("Bounding box" of Radolan area) + +Function: `get_radolan_extension()` + +```{r} +kwb.dwd::get_radolan_extension() +``` + +**Which coordinate system?** + +### Compose radolan projection string + +Function: `get_radolan_projection_string()` + +```{r} +kwb.dwd::get_radolan_projection_string() +``` + +## Read different file formats + +### Read Zipped ESRI-Ascii-Grid File (from URL) + +Function: `read_asc_gz_file()` + +### Read an Example Raster File for Germany + +Function: `get_example_grid_germany()` + +Example: + +```{r} +grid <- kwb.dwd::get_example_grid_germany() +raster::plot(grid) +``` + +### Read Binary Radolan File + +Function: `read_binary_radolan_file()` + +### Read Relevant Radolan Data from rst Database + +Function: `read_relevant_years_radolan()` + +## Write different file formats + +### Writing raster data to a file + +Function: `write_raster_to_file()` + +```{r} +kwb.dwd::write_raster_to_file( + raster, + file.path(tempdir(), "raster.rst") +) +``` + +## High-Level Functions, General + +### Read daily data from DWD, mask region with given shape file + +Function: `read_daily_data_over_shape()` + +### Read monthly data from DWD, mask region with given shape file + +Function: `read_monthly_data_over_shape()` + +### Download, crop, summarise + +Function: `calculate_masked_grid_stats()` + +This seems to be a highly specific function that requires a list of matrices as input. But where to get this list from... ? We can create an example from +scratch to demonstrate what the function does: + +```{r} +#writeLines(paste(sample(0:3, 12, replace = TRUE), collapse = ", ")) +to_matrix <- function(...) matrix(c(...), ncol = 3, byrow = TRUE) + +matrix_1 <- structure(file = "file_1", year = 2022L, month = 1L, to_matrix( + 2, 3, 1, + 0, 2, 3, + 1, 3, 2, + 1, 2, 0 +)) + +matrix_2 <- structure(file = "file_2", year = 2022L, month = 2L, to_matrix( + 3, 0, 2, + 0, 0, 0, + 3, 0, 1, + 3, 2, 1 +)) + +matrices <- list(matrix_1, matrix_2) + +# Take car to use NA, not zero! +geo_mask <- to_matrix( + NA, 1, NA, + 1, 1, 1, + 1, 1, 1, + NA, 1, NA +) + +kwb.dwd::calculate_masked_grid_stats(matrices, geo_mask) +``` + +This was a simple example. We have used this function to calculate mean +evaporation values for Berlin. Thanks to Andreas Matzinger we have a function +that returns the matrix that can be used to crop the Berlin area. + +Function: `get_berlin_dwd_mask` + +```{r} +raster::plot(raster::raster(kwb.dwd::get_berlin_dwd_mask())) +``` + +## High-Level Functions, Specific to Berlin + +### Load monthly potential evaporation for Berlin from DWD + +Function: `load_potential_evaporation_berlin()` +Function: `load_potential_evaporation_berlin_2()` (newer version) + +### Load monthly precipitation for Berlin from DWD + +Function: `load_precipitation_berlin()` diff --git a/vignettes/radolan.Rmd b/vignettes/radolan.Rmd index 9f4a318d..778a5b78 100644 --- a/vignettes/radolan.Rmd +++ b/vignettes/radolan.Rmd @@ -72,7 +72,7 @@ tail(kwb.utils::resetRowNames(radolan_files)) ```{r} # Set the target directory -export_dir <- "~/Downloads/radolan" +export_dir <- kwb.dwd:::download_dir("radolan") # Create required directories kwb.utils::createDirectory(file.path(export_dir, "daily/historical"))