diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
deleted file mode 100644
index 7444810d..00000000
--- a/.github/workflows/R-CMD-check.yaml
+++ /dev/null
@@ -1,92 +0,0 @@
-on:
- push:
- branches:
- - master
- - main
- - dev
- pull_request:
- branches:
- - master
- - main
- - dev
-
-name: R-CMD-check
-
-jobs:
- R-CMD-check:
- runs-on: ${{ matrix.config.os }}
-
- name: ${{ matrix.config.os }} (${{ matrix.config.r }})
-
- strategy:
- 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: windows-latest, r: 'oldrel'}
- - {os: windows-latest, r: 'release'}
-
- env:
- GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
- R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
- RSPM: ${{ matrix.config.rspm }}
-
- steps:
- - uses: actions/checkout@v2
-
- - uses: r-lib/actions/setup-r@v2
- with:
- r-version: ${{ matrix.config.r }}
-
- - 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')
- saveRDS(remotes::dev_package_deps(dependencies = TRUE), "depends.Rds", version = 2)
- shell: Rscript {0}
-
- - name: Cache R packages
- if: runner.os != 'Windows'
- uses: actions/cache@v3
- with:
- path: ${{ env.R_LIBS_USER }}
- key: ${{ runner.os }}-r-${{ matrix.config.r }}-3-${{ hashFiles('depends.Rds') }}
- restore-keys: ${{ runner.os }}-r-${{ matrix.config.r }}-3-
-
- - name: Install system dependencies
- if: runner.os == 'Linux'
- env:
- RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
- run: |
- Rscript -e "remotes::install_github('r-hub/sysreqs')"
- sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
- sudo -s eval "$sysreqs"
- - name: Install dependencies
- run: |
- remotes::install_deps(dependencies = TRUE)
- remotes::install_cran("rcmdcheck")
- shell: Rscript {0}
-
- - name: Check
- run: rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "warning", check_dir = "check")
- shell: Rscript {0}
-
- - name: Upload check results
- if: failure()
- uses: actions/upload-artifact@v3
- with:
- name: ${{ runner.os }}-r${{ matrix.config.r }}-results
- path: check
diff --git a/DESCRIPTION b/DESCRIPTION
index 7493329e..91cd5cf3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -41,11 +41,10 @@ Imports:
lubridate (>= 1.7.4),
magrittr (>= 1.5),
raster (>= 2.8),
- rgdal (>= 1.5-31),
RCurl (>= 1.95.4.11),
sf (>= 0.7.4),
- sp (>= 1.3.1),
- stringr (>= 1.4.0)
+ stringr (>= 1.4.0),
+ terra (>= 1.7)
Suggests:
covr (>= 3.2.1),
knitr (>= 1.22),
@@ -55,11 +54,9 @@ VignetteBuilder:
knitr
Remotes:
github::kwb-r/kwb.utils
-Additional_repositories:
- https://packagemanager.posit.co/cran/2023-09-20/
Encoding: UTF-8
LazyData: true
LazyDataCompression: bzip2
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
Roxygen: list(markdown = TRUE)
Config/testthat/edition: 3
diff --git a/LICENSE b/LICENSE
index 4cb39e11..32aa5255 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,6 +1,6 @@
# MIT License
-Copyright (c) 2019-2022 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
+Copyright (c) 2019-2024 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
diff --git a/LICENSE.md b/LICENSE.md
index 4cb39e11..32aa5255 100644
--- a/LICENSE.md
+++ b/LICENSE.md
@@ -1,6 +1,6 @@
# MIT License
-Copyright (c) 2019-2022 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
+Copyright (c) 2019-2024 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
diff --git a/NAMESPACE b/NAMESPACE
index c836774a..42e3e28a 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,6 +9,7 @@ export(download_shapes_germany)
export(extract_radolan_zip_files)
export(get_berlin_dwd_mask)
export(get_dwd_urls_metadata)
+export(get_epsg_from_url)
export(get_example_grid_germany)
export(get_radolan_extension)
export(get_radolan_projection_string)
@@ -38,7 +39,6 @@ importFrom(bitops,bitAnd)
importFrom(fs,dir_create)
importFrom(kwb.utils,assertFinalSlash)
importFrom(kwb.utils,backspace)
-importFrom(kwb.utils,callWith)
importFrom(kwb.utils,catAndRun)
importFrom(kwb.utils,catIf)
importFrom(kwb.utils,clearConsole)
@@ -66,31 +66,32 @@ importFrom(kwb.utils,setColumns)
importFrom(kwb.utils,space)
importFrom(kwb.utils,stopFormatted)
importFrom(kwb.utils,stringList)
-importFrom(kwb.utils,tempSubdirectory)
importFrom(lubridate,month)
importFrom(lubridate,rollback)
importFrom(lubridate,ymd)
importFrom(magrittr,"%>%")
-importFrom(raster,`crs<-`)
importFrom(raster,cellStats)
importFrom(raster,crop)
importFrom(raster,extent)
importFrom(raster,flip)
+importFrom(raster,projection)
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_crs)
importFrom(sf,st_read)
importFrom(sf,st_transform)
importFrom(sf,st_zm)
-importFrom(sp,CRS)
importFrom(stats,sd)
importFrom(stats,setNames)
importFrom(stringr,str_replace)
+importFrom(terra,`crs<-`)
+importFrom(terra,rast)
importFrom(utils,browseURL)
+importFrom(utils,capture.output)
importFrom(utils,download.file)
importFrom(utils,head)
importFrom(utils,read.csv)
diff --git a/NEWS.md b/NEWS.md
index 2ff2bad0..ffb76857 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,4 @@
-# kwb.dwd 0.3.0 (2023-05-23)
+# kwb.dwd 0.3.0 (2024-04-xx)
* update/improve/fix GitHub actions workflow files
* depend on R >= 3.5.0 (Required by R CMD check)
@@ -95,7 +95,7 @@
* 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)
+# [kwb.dwd 0.2.0](https://github.com/KWB-R/kwb.dwd/releases/tag/v0.2.0) 2022-09-17
* add contributors Michael Rustler, Lukas Guericke
* use GitHub actions instead of Travis and Appveyor
diff --git a/R/datasets.R b/R/datasets.R
index 217211bc..ed5c726f 100644
--- a/R/datasets.R
+++ b/R/datasets.R
@@ -2,9 +2,9 @@
#'
#' Information on files that are available for download at
#' \[base_url\]. The
-#' information were last updated on 2023-04-26.
+#' information were last updated on 2024-04-19.
#'
-#' @format A data frame with 838345 observations of 8 variables:
+#' @format A data frame with 902382 observations of 8 variables:
#' \describe{
#' \item{file}{path to the file below \[base_ur\]}
#' \item{isdir}{TRUE for a directory, FALSE for a file}
@@ -69,3 +69,13 @@
#' @source
#'
"shapes_germany_2"
+
+#' Information on EPSG codes
+#'
+#' @format A data frame with 902382 observations of 8 variables:
+#' \describe{
+#' \item{dir}{path to the file below }
+#' \item{file}{name of the file}
+#' \item{epsg}{EPSG code (integer)}
+#' }
+"epsg_info"
diff --git a/R/get_epsg_from_url.R b/R/get_epsg_from_url.R
new file mode 100644
index 00000000..9f44f8d2
--- /dev/null
+++ b/R/get_epsg_from_url.R
@@ -0,0 +1,60 @@
+# get_epsg_from_url ------------------------------------------------------------
+
+#' Get EPSG Code as Found in Description File for a Given URL
+#'
+#' The URL is looked up in column \code{dir} of \code{\link{epsg_info}}. If the
+#' URL is found and results in a unique EPSG code (in column \code{epsg}),
+#' that EPSG code is returned. If the URL is not found or if the corresponding
+#' EPSG codes are not unique, an error is raised.
+#'
+#' @param url URL to the file below \code{kwb.dwd:::ftp_path_cdc()} for which to
+#' find out the EPSC code
+#' @return In the case of success, an integer number is returned. The number
+#' represents the EPSG code of the projection that is to be applied for the data
+#' in the given URL.
+#' @importFrom kwb.utils stopFormatted
+#' @export
+#' @examples
+#' \dontrun{
+#' url <- kwb.dwd::get_radolan_urls()$daily_historical_urls[1L]
+#' kwb.dwd::get_epsg_from_url(url) # error: no unique EPSG code
+#' }
+get_epsg_from_url <- function(url)
+{
+ path <- gsub("^(ftp|https?)://", "", url)
+
+ find_matching <- function(path) {
+ data <- kwb.dwd::epsg_info
+ unique(data[grep(path, data$dir, fixed = TRUE), - 2L])
+ }
+
+ info <- find_matching(path)
+
+ while(nzchar(path) && nrow(info) == 0L) {
+ path <- dirname(path)
+ info <- find_matching(path)
+ }
+
+ if (nrow(info) == 0L) {
+ kwb.utils::stopFormatted("I cannot determine the EPSG code for %s", url)
+ }
+
+ epsg <- kwb.utils::selectColumns(info, "epsg")
+ unique_epsg <- unique(epsg)
+
+ if (length(unique_epsg) > 1L) {
+ print(split(info, epsg))
+ kwb.utils::stopFormatted(
+ paste(
+ "I cannot determine a unique EPSG code for:\n %s\nin:\n %s\n",
+ "See above for EPSG codes (%s) that I found for files in similar",
+ "directories"
+ ),
+ basename(url),
+ dirname(url),
+ paste(unique_epsg, collapse = ", ")
+ )
+ }
+
+ unique_epsg
+}
diff --git a/R/get_example_grid_germany.R b/R/get_example_grid_germany.R
index ddd784f3..227fa16b 100644
--- a/R/get_example_grid_germany.R
+++ b/R/get_example_grid_germany.R
@@ -8,6 +8,15 @@
#' * [get_shapes_of_germany].
get_example_grid_germany <- function()
{
+ #kwb.utils::assignPackageObjects("kwb.dwd")
+
path <- "evapo_p/grids_germany_monthly_evapo_p_202201.asc.gz"
- read_asc_gz_file(url = ftp_path_grids_germany("monthly", path))
+ url <- ftp_path_grids_germany("monthly", path)
+
+ #epsg <- get_epsg_from_url(url)
+ epsg <- 31467L
+
+ crs <- paste("EPSG", epsg, sep = ":")
+
+ read_asc_gz_file(url = url, crs = crs)
}
diff --git a/R/get_radolan_projection_string.R b/R/get_radolan_projection_string.R
index f17df08b..5ce5352e 100644
--- a/R/get_radolan_projection_string.R
+++ b/R/get_radolan_projection_string.R
@@ -1,18 +1,45 @@
#' Compose radolan projection string
#'
+#' @param from_prj_file whether or not to return the string that is provided
+#' in "radolanproj.prj" on FTP server of Deutscher Wetterdienst. The default
+#' is \code{FALSE}, i.e. a constant string of the form \code{+proj=...}
+#' is returned.
+#' @param \dots further arguments passed to \code{kwb.dwd:::to_projection_string}
#' @return default radolan projection string
#' @export
-#'
#' @examples
#' get_radolan_projection_string()
-#'
#' @seealso
#' * [get_radolan_urls],
#' * [get_radolan_extension].
-get_radolan_projection_string <- function()
+get_radolan_projection_string <- function(from_prj_file = FALSE, ...)
{
+ string <- paste(
+ "PROJCS[\"Stereographic_North_Pole\"",
+ "GEOGCS[\"GCS_unnamed ellipse\"",
+ "DATUM[\"D_unknown\"",
+ "SPHEROID[\"Unknown\",6370040,0]]",
+ "PRIMEM[\"Greenwich\",0]",
+ "UNIT[\"Degree\",0.017453292519943295]]",
+ "PROJECTION[\"Stereographic_North_Pole\"]",
+ "PARAMETER[\"standard_parallel_1\",60]",
+ "PARAMETER[\"central_meridian\",10]",
+ "PARAMETER[\"false_easting\",0]",
+ "PARAMETER[\"false_northing\",0]",
+ "UNIT[\"Meter\",1]]",
+ sep = ","
+ )
+
+ stopifnot(identical(
+ string,
+ readLines(default_projection_file(radolan = TRUE), warn = FALSE)
+ ))
+
+ if (from_prj_file) {
+ return(string)
+ }
+
# TODO: Is this the same?
- # readLines(default_projection_file())
to_projection_string(
parameters = list(
@@ -25,7 +52,8 @@ get_radolan_projection_string <- function()
y_0 = 0,
a = 6370040,
b = 6370040,
- to_meter = 1000
+ to_meter = 1000,
+ ...
),
switches = "no_defs"
)
diff --git a/R/get_shapes_of_germany.R b/R/get_shapes_of_germany.R
index c756454b..2e21e5c1 100644
--- a/R/get_shapes_of_germany.R
+++ b/R/get_shapes_of_germany.R
@@ -7,12 +7,11 @@
#' in DWD data files and stored locally in an RData file. The default is
#' `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
#' @seealso
#' * [get_example_grid_germany],
#' * [download_shapes_germany].
-get_shapes_of_germany <- function(recreate = FALSE, use_sf = FALSE)
+get_shapes_of_germany <- function(recreate = FALSE)
{
if (!recreate) {
@@ -43,27 +42,14 @@ get_shapes_of_germany <- function(recreate = FALSE, use_sf = FALSE)
shape_dir <- download_shapes_germany()
files <- list_local_shape_files(shape_dir)
- # Read shapes at different levels of detail
- 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
+ # Read shapes at different levels of detail
shapes_germany <- lapply(
- shapes_germany,
- FUN = transform_coords,
- target_crs = example_grid@srs,
- use_sf = use_sf
+ X = stats::setNames(files, kwb.utils::removeExtension(basename(files))),
+ FUN = read_shape_file,
+ target_crs = terra::crs(example_grid)
)
# Save the shapes so that next time they can be loaded directly
diff --git a/R/list_grids_germany.R b/R/list_grids_germany.R
index 4e8facc5..9c051a73 100644
--- a/R/list_grids_germany.R
+++ b/R/list_grids_germany.R
@@ -67,13 +67,16 @@ if (FALSE)
#' @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`
-#'
+#' @importFrom utils capture.output
list_grids_germany <- function(
resolution, extension, variable, from = NULL, to = NULL, recursive = TRUE
)
{
#resolution = "monthly"
#extension = ".asc.gz"
+ #variable = "evapo_p"
+ #from = "202001"
+ #to = "202001"
# Code to get the possible choices
# base_url <- kwb.dwd:::ftp_path_grids_germany(resolution)
@@ -111,8 +114,9 @@ list_grids_germany <- function(
base_url <- ftp_path_grids_germany(resolution, variable)
# List data files
- relative_urls <- base_url %>%
- list_url(recursive = recursive) %>%
+ utils::capture.output(urls <- list_url(base_url, recursive = recursive))
+
+ relative_urls <- urls %>%
filter_by_extension(extension) %>%
filter_by_month_range(from, to)
diff --git a/R/load_monthly_data_for_berlin.R b/R/load_monthly_data_for_berlin.R
index 97fd9692..1b22d164 100644
--- a/R/load_monthly_data_for_berlin.R
+++ b/R/load_monthly_data_for_berlin.R
@@ -20,10 +20,15 @@
#' * [load_potential_evaporation_berlin_2],
#' * [get_berlin_dwd_mask],
#' * [load_precipitation_berlin].
-load_potential_evaporation_berlin <- function(from = NULL, to = NULL)
+load_potential_evaporation_berlin <- function(from = to, to = last_month())
{
+ #kwb.utils::assignPackageObjects("kwb.dwd")
load_monthly_variable_for_region(
- variable = "evapo_p", region = "berlin", scale = 0.1, from, to
+ variable = "evapo_p",
+ region = "berlin",
+ scale = 0.1,
+ from = from,
+ to = to
)
}
@@ -48,10 +53,14 @@ load_potential_evaporation_berlin <- function(from = NULL, to = NULL)
#' * [load_potential_evaporation_berlin_2],
#' * [load_potential_evaporation_berlin],
#' * [get_berlin_dwd_mask].
-load_precipitation_berlin <- function(from = NULL, to = NULL)
+load_precipitation_berlin <- function(from = to, to = last_month())
{
load_monthly_variable_for_region(
- "precipitation", "berlin", scale = NULL, from, to
+ variable = "precipitation",
+ region = "berlin",
+ scale = NULL,
+ from = from,
+ to = to
)
}
@@ -82,6 +91,11 @@ load_precipitation_berlin <- function(from = NULL, to = NULL)
load_potential_evaporation_berlin_2 <- function(from, to)
{
load_monthly_variable_for_region(
- "evapo_p", "berlin", scale = 0.1, from, to, version = 2L
+ variable = "evapo_p",
+ region = "berlin",
+ scale = 0.1,
+ from = from,
+ to = to,
+ version = 2L
)
}
diff --git a/R/load_monthly_variable_for_region.R b/R/load_monthly_variable_for_region.R
index f53317ef..3e186d09 100644
--- a/R/load_monthly_variable_for_region.R
+++ b/R/load_monthly_variable_for_region.R
@@ -33,7 +33,7 @@ load_monthly_variable_for_region <- function(
if (version == 2L) {
# Read all files into a list of RasterLayer objects
- grids <- lapply(files, read_asc_gz_file)
+ grids <- lapply(files, read_asc_gz_file, crs = "EPSG:31467")
# Get shape of region in same projection as grid
shape <- get_shape_of_german_region(region)
@@ -184,13 +184,23 @@ filter_shapes <- function(shapes, config)
# raster_stats -----------------------------------------------------------------
raster_stats <- function(r, scale = NULL)
{
- stopifnot(inherits(r, "BasicRaster"))
+ is_BasicRaster <- inherits(r, "BasicRaster")
+ is_SpatRaster <- inherits(r, "SpatRaster")
- x <- raster::getValues(r)
+ stopifnot(is_BasicRaster || is_SpatRaster)
- # Just for my understanding: does getValues() return r@data@values?
- if (length(r@data@values) > 0L) {
- stopifnot(identical(r@data@values, x))
+ if (is_BasicRaster) {
+
+ x <- raster::getValues(r)
+
+ # Just for my understanding: does getValues() return r@data@values?
+ if (length(values <- r@data@values) > 0L) {
+ stopifnot(identical(values, x))
+ }
+
+ } else if (is_SpatRaster) {
+
+ x <- terra::values(r)
}
x <- x[! is.na(x)]
diff --git a/R/provide_projection_file.R b/R/provide_projection_file.R
index 2467cc97..42d2fc02 100644
--- a/R/provide_projection_file.R
+++ b/R/provide_projection_file.R
@@ -5,31 +5,30 @@ provide_projection_file <- function(file, dbg = FALSE)
target_file <- kwb.utils::replaceFileExtension(file, ".prj")
if (file.exists(target_file)) {
-
kwb.utils::catIf(dbg, sprintf(
"There is already a projection file: %s\n", target_file
))
-
- return()
+ } else {
+ copy_file(
+ from = default_projection_file(),
+ to = target_file
+ )
}
- copy_file(
- from = default_projection_file(),
- to = target_file
- )
+ # Return the path to the target file, invisibly
+ invisible(target_file)
}
# default_projection_file ------------------------------------------------------
-default_projection_file <- function(quiet = TRUE, download = TRUE)
+default_projection_file <- function(radolan = FALSE)
{
- url <- "https://opendata.dwd.de/climate_environment/CDC/help/gk3.prj"
+ prj_dir <- system.file("extdata/projections", package = "kwb.dwd")
+ prj_files <- dir(prj_dir, "\\.prj$", full.names = TRUE)
- if (!download) {
- return(url)
- }
+ file_list <- stats::setNames(as.list(prj_files), basename(prj_files))
- download(url = url, quiet = quiet, file = file.path(
- system.file("extdata", package = "kwb.dwd"),
- basename(url)
- ))
+ kwb.utils::selectElements(
+ file_list,
+ ifelse(radolan, "radolanproj.prj", "gk3.prj")
+ )
}
diff --git a/R/read_asc_gz_file.R b/R/read_asc_gz_file.R
index 1db4e7ec..65392c60 100644
--- a/R/read_asc_gz_file.R
+++ b/R/read_asc_gz_file.R
@@ -4,14 +4,15 @@
#'
#' @param file path to zipped file in ESRI-ascii-grid format (.asc.gz)
#' @param url optional. URL to zipped file in ESRI-ascii-grid format (.asc.gz)
-#' @return object of class "RasterLayer"
+#' @param crs optional. Coordinate reference system, passed to
+#' \code{\link{read_asc_file}}.
+#' @return object of class "SpatRaster"
#' @export
-#' @importFrom kwb.utils callWith removeExtension tempSubdirectory
-#' @importFrom raster raster
+#' @importFrom kwb.utils removeExtension
#' @seealso
#' * [read_binary_radolan_file],
#' * [unzip_asc_gz_file].
-read_asc_gz_file <- function(file, url = NULL)
+read_asc_gz_file <- function(file, url = NULL, crs = NULL)
{
target_dir <- if (is.null(url)) {
dirname(file)
@@ -26,9 +27,11 @@ read_asc_gz_file <- function(file, url = NULL)
)
#dir(target_dir)
+ #kwb.utils::hsOpenWindowsExplorer(target_dir)
- # Read the .asc file into a raster object (with appropriate projection)
- read_asc_file(grid_file)
+ # Read the .asc file into a raster object and set the appropriate coordinate
+ # reference system (CRS)
+ read_asc_file(file = grid_file, crs = crs)
}
# read_asc_file ----------------------------------------------------------------
@@ -36,29 +39,38 @@ read_asc_gz_file <- function(file, url = NULL)
#' Read Raster Data from .ASC File
#'
#' @param file path to .asc file
-#' @param projection projection string used in Radolan data. Currently not used!
+#' @param crs coordinate reference system in which the data are given. String
+#' as expected by \code{\link[terra]{crs}}.
#' @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
-)
+#' @importFrom terra `crs<-` rast
+read_asc_file <- function(file, crs = NULL, dbg = TRUE)
{
kwb.utils::catAndRun(
- sprintf("Reading %s using raster::raster()", basename(file)),
+ sprintf("Reading%swith terra::rast()", format_file_path(file)),
dbg = dbg,
expr = {
-
- # Provide a copy of the projection file in the same folder
- provide_projection_file(file)
- result <- raster::raster(file)
-
- #result <- raster::raster(file, values = TRUE)
- #raster::crs(result) <- projection
-
- result
+ raster <- terra::rast(file)
+ if (is.null(crs)) {
+ if (identical(terra::crs(raster), "")) {
+ warning(
+ "No coordinate reference system (CRS) was set for the raster read ",
+ "from", format_file_path(file),
+ "Please set a CRS, e.g. with\n ",
+ "terra::crs(raster) <- \"EPSG:31467\"",
+ call. = FALSE
+ )
+ }
+ } else {
+ terra::crs(raster) <- crs
+ }
+ raster
}
)
}
+
+# format_file_path -------------------------------------------------------------
+format_file_path <- function(file)
+{
+ sprintf("\n %s\nin\n %s\n", basename(file), dirname(file))
+}
diff --git a/R/read_binary_radolan_file.R b/R/read_binary_radolan_file.R
index 81a5f57e..aa4e97ed 100644
--- a/R/read_binary_radolan_file.R
+++ b/R/read_binary_radolan_file.R
@@ -13,8 +13,8 @@
#' default is `TRUE` (for compatibility reasons) but this should change
#' in future!
#' @export
-#' @importFrom sp CRS
-#' @importFrom raster extent
+#' @importFrom sf st_crs
+#' @importFrom raster extent projection
#' @seealso
#' * [read_asc_gz_file],
#' * [read_relevant_years_radolan].
@@ -38,7 +38,7 @@ read_binary_radolan_file <- function(
# Set projection and extent
if (set_projection_and_extent) {
- raster::projection(rb) <- sp::CRS(get_radolan_projection_string())
+ raster::projection(rb) <- sf::st_crs(get_radolan_projection_string())
raster::extent(rb) <- raster::extent(get_radolan_extension())
}
diff --git a/R/read_data_over_shape.R b/R/read_data_over_shape.R
index a30cd163..37c50e01 100644
--- a/R/read_data_over_shape.R
+++ b/R/read_data_over_shape.R
@@ -3,6 +3,7 @@
#' Read monthly data from DWD, mask region with given shape file
#'
#' @inheritParams read_data_over_shape
+#' @param \dots further arguments passed to \code{\link{read_data_over_shape}}
#' @return data frame
#' @export
#' @seealso
@@ -17,12 +18,19 @@ read_monthly_data_over_shape <- function(
to,
quiet = FALSE,
shape = NULL,
- use_sf = TRUE,
...
)
{
+ #variable="evapo_p";from="202001";to="202002";resolution="monthly";quiet=FALSE
read_data_over_shape(
- "monthly", file, variable, from, to, quiet, shape, use_sf, ...
+ resolution = "monthly",
+ file = file,
+ variable = variable,
+ from = from,
+ to = to,
+ quiet = quiet,
+ shape = shape,
+ ...
)
}
@@ -34,6 +42,7 @@ read_monthly_data_over_shape <- function(
#' must be given
#'
#' @inheritParams read_data_over_shape
+#' @param \dots further arguments passed to \code{\link{read_data_over_shape}}
#' @return data frame
#' @export
#' @seealso
@@ -41,10 +50,23 @@ read_monthly_data_over_shape <- function(
#' * [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_daily_data_over_shape <- function(
+ file,
+ variable,
+ from,
+ to,
+ quiet = FALSE,
+ ...
+)
{
read_data_over_shape(
- "daily", file, variable, from, to, quiet = quiet
+ resolution = "daily",
+ file = file,
+ variable = variable,
+ from = from,
+ to = to,
+ quiet = quiet,
+ ...
)
}
@@ -63,23 +85,31 @@ read_daily_data_over_shape <- function(file, variable, from, to, quiet = FALSE)
#' @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,
+ file = NULL,
variable,
from,
to,
quiet = FALSE,
shape = NULL,
- use_sf = TRUE,
...
)
{
+ # if (!is.null(file)) {
+ # stop(
+ # "The 'file' argument is not supported any more by ",
+ # "read_data_over_shape(). Please read the shape file on your own ",
+ # "(e.g. with kwb.dwd:::read_shape_file()) and pass it in argument 'shape'."
+ # )
+ # }
+
+ #kwb.utils::assignPackageObjects("kwb.dwd")
+
# 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()
@@ -94,39 +124,32 @@ read_data_over_shape <- function(
# 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)
- }
+ # Read shape file and transform to coordinate reference system in which
+ # grid data are provided by Deutscher Wetterdienst
+ read_shape_file(file, target_crs = terra::crs("EPSG:31467"), ...)
}
# Download (and extract) files from DWD server
grid_files <- download_grids_germany(
- resolution, variable, from, to, quiet = quiet
+ resolution = resolution,
+ variable = variable,
+ from = from,
+ to = 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(
+ resolution = resolution,
+ grid_files = grid_files,
+ shape = shape,
+ scale = scale
+ )
}
# get_data_from_grid_files -----------------------------------------------------
get_data_from_grid_files <- function(
- resolution, grid_files, shape, scale, use_sf
+ resolution, grid_files, shape, scale, crs = "EPSG:31467"
)
{
# Define read functions for different file formats (depending on resolution)
@@ -138,19 +161,15 @@ get_data_from_grid_files <- function(
# 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)
+ # Read the files into SpatRaster objects with DWD projection
+ grids <- lapply(grid_files, read, crs = crs)
# 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
- )
+ shape <- transform_coords(shape, target_crs = terra::crs(grids[[1L]]))
grids <- mask_and_crop_grids(grids, shape)
}
@@ -217,9 +236,13 @@ extract_metadata_from_files <- function(files, resolution)
mask_and_crop_grids <- function(grids, shape, dbg = TRUE)
{
lapply(grids, function(grid) {
+
+ grid_name <- names(grid)
+ stopifnot(length(grid_name) == 1L)
+
kwb.utils::catAndRun(
- paste("Masking and cropping", grid@data@names),
- raster::crop(raster::mask(grid, shape), shape),
+ paste("Masking and cropping", grid_name),
+ terra::crop(terra::mask(grid, shape), shape),
dbg = dbg
)
})
diff --git a/R/read_shape_file.R b/R/read_shape_file.R
index 5b90e460..2b85602a 100644
--- a/R/read_shape_file.R
+++ b/R/read_shape_file.R
@@ -1,11 +1,9 @@
# 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
)
@@ -14,20 +12,16 @@ read_shape_file <- function(
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)
+ shape <- sf::st_read(file)
# Drop z dimensions if desired
if (drop_z) {
shape <- sf::st_zm(shape)
}
+ # Transform to target coordinate reference system if given
+ shape <- transform_coords(shape, target_crs)
+
# Convert to Spatial* object if desired
if (as_spatial) {
shape <- sf::as_Spatial(shape)
@@ -35,16 +29,3 @@ read_shape_file <- function(
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/transform_coords.R b/R/transform_coords.R
index 1fedbf4e..09ccbeb5 100644
--- a/R/transform_coords.R
+++ b/R/transform_coords.R
@@ -1,16 +1,9 @@
# transform_coords -------------------------------------------------------------
-transform_coords <- function(x, target_crs = NULL, use_sf = inherits(x, "sf"))
+transform_coords <- function(x, target_crs = NULL)
{
if (is.null(target_crs)) {
return(x)
}
- if (use_sf) {
-
- sf::st_transform(x, target_crs)
-
- } else {
-
- sp::spTransform(x, target_crs)
- }
+ sf::st_transform(x, target_crs)
}
diff --git a/data/dwd_files.rda b/data/dwd_files.rda
index 584a6a24..8bf2fa4e 100644
Binary files a/data/dwd_files.rda and b/data/dwd_files.rda differ
diff --git a/data/epsg_info.rda b/data/epsg_info.rda
new file mode 100644
index 00000000..7cf750dd
Binary files /dev/null and b/data/epsg_info.rda differ
diff --git a/inst/extdata/projections/README.txt b/inst/extdata/projections/README.txt
new file mode 100644
index 00000000..2ac031ff
--- /dev/null
+++ b/inst/extdata/projections/README.txt
@@ -0,0 +1,10 @@
+https://opendata.dwd.de/climate_environment/CDC/help:
+- gk3.prj
+
+https://opendata.dwd.de/climate_environment/CDC/help/RADOLAN/gis:
+- radolanproj.prj
+
+ftp://opendata.dwd.de/climate_environment/CDC/help/RADOLAN/Unterstuetzungsdokumente/RADOLAN-GIS.zip:
+- radolan_polygons.prj
+- rahmen_radolan_proj.prj
+- rahmen_radolan_wgs84.prj
diff --git a/inst/extdata/projections/gk3.prj b/inst/extdata/projections/gk3.prj
new file mode 100644
index 00000000..38c1e585
--- /dev/null
+++ b/inst/extdata/projections/gk3.prj
@@ -0,0 +1 @@
+PROJCS["DHDN_3_Degree_Gauss_Zone_3",GEOGCS["GCS_Deutsches_Hauptdreiecksnetz",DATUM["D_Deutsches_Hauptdreiecksnetz",SPHEROID["Bessel_1841",6377397.155,299.1528128]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]],PROJECTION["Gauss_Kruger"],PARAMETER["False_Easting",3500000.0],PARAMETER["False_Northing",0.0],PARAMETER["Central_Meridian",9.0],PARAMETER["Scale_Factor",1.0],PARAMETER["Latitude_Of_Origin",0.0],UNIT["Meter",1.0]]
diff --git a/inst/extdata/projections/radolan_polygons.prj b/inst/extdata/projections/radolan_polygons.prj
new file mode 100644
index 00000000..392f2ceb
--- /dev/null
+++ b/inst/extdata/projections/radolan_polygons.prj
@@ -0,0 +1 @@
+PROJCS["North_Pole_Stereographic",GEOGCS["GCS_WGS_1984_DWD",DATUM["",SPHEROID["",6370040.0,0.0]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]],PROJECTION["Stereographic_North_Pole"],PARAMETER["False_Easting",0.0],PARAMETER["False_Northing",0.0],PARAMETER["Central_Meridian",10.0],PARAMETER["Standard_Parallel_1",60.0],UNIT["Kilometer",1000.0]]
\ No newline at end of file
diff --git a/inst/extdata/projections/radolanproj.prj b/inst/extdata/projections/radolanproj.prj
new file mode 100644
index 00000000..30d2321a
--- /dev/null
+++ b/inst/extdata/projections/radolanproj.prj
@@ -0,0 +1 @@
+PROJCS["Stereographic_North_Pole",GEOGCS["GCS_unnamed ellipse",DATUM["D_unknown",SPHEROID["Unknown",6370040,0]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]],PROJECTION["Stereographic_North_Pole"],PARAMETER["standard_parallel_1",60],PARAMETER["central_meridian",10],PARAMETER["false_easting",0],PARAMETER["false_northing",0],UNIT["Meter",1]]
\ No newline at end of file
diff --git a/inst/extdata/projections/rahmen_radolan_proj.prj b/inst/extdata/projections/rahmen_radolan_proj.prj
new file mode 100644
index 00000000..392f2ceb
--- /dev/null
+++ b/inst/extdata/projections/rahmen_radolan_proj.prj
@@ -0,0 +1 @@
+PROJCS["North_Pole_Stereographic",GEOGCS["GCS_WGS_1984_DWD",DATUM["",SPHEROID["",6370040.0,0.0]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]],PROJECTION["Stereographic_North_Pole"],PARAMETER["False_Easting",0.0],PARAMETER["False_Northing",0.0],PARAMETER["Central_Meridian",10.0],PARAMETER["Standard_Parallel_1",60.0],UNIT["Kilometer",1000.0]]
\ No newline at end of file
diff --git a/inst/extdata/projections/rahmen_radolan_wgs84.prj b/inst/extdata/projections/rahmen_radolan_wgs84.prj
new file mode 100644
index 00000000..50780008
--- /dev/null
+++ b/inst/extdata/projections/rahmen_radolan_wgs84.prj
@@ -0,0 +1 @@
+GEOGCS["GCS_WGS_1984",DATUM["",SPHEROID["",6370040.0,0.0]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]]
\ No newline at end of file
diff --git a/inst/extdata/provide-data.R b/inst/extdata/provide-data.R
deleted file mode 100644
index 7401fb77..00000000
--- a/inst/extdata/provide-data.R
+++ /dev/null
@@ -1,37 +0,0 @@
-#
-# 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/read-daily-braunschweig-data.R b/inst/extdata/read-daily-braunschweig-data.R
deleted file mode 100644
index b689d4be..00000000
--- a/inst/extdata/read-daily-braunschweig-data.R
+++ /dev/null
@@ -1,71 +0,0 @@
-#
-# List URLs with monthly/daily grid data for Germany
-#
-if (FALSE)
-{
- # monthly
-
- urls_monthly <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "x")
- # -> error with possible variables
-
- urls_monthly <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "sunshine_duration")
-
- # daily
- urls_daily <- kwb.dwd:::list_grids_germany("daily", ".tgz", "x")
- # -> error with possible variables
-
- 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)
-}
-
-#
-# Download daily grids for Germany (.asc files)
-#
-if (FALSE)
-{
- from = "202201"
- to = "202207"
-
- files_evapo_p <- kwb.dwd:::download_daily_grids_germany("evapo_p", from, to)
- files_evapo_r <- kwb.dwd:::download_daily_grids_germany("evapo_r", from, to)
-}
-
-#
-# Download monthly grids for Germany (.asc.gz files)
-#
-if (FALSE)
-{
- from = "202201"
- to = "202207"
-
- files <- kwb.dwd:::download_monthly_grids_germany("frost_depth", from, to)
-
- file <- files[1L]
-
- kwb.utils::hsOpenWindowsExplorer(dirname(file))
-
- grid <- kwb.dwd:::read_asc_gz_file(file)
-
- raster::plot(grid)
-}
-
-#
-# Read daily data from DWD, mask region with given shape file
-#
-
-if (FALSE)
-{
- shape_file <- "~/../Downloads/A/Abwasserverregnungsgebiet/Abwasserverregnungsgebiet.shp"
-
- # Only data of full months can currently be read!
- evapo_p <- kwb.dwd::read_daily_data_over_shape(
- file = shape_file,
- variable = "evapo_p",
- from = "202001",
- to = "202002"
- )
-
- View(evapo_p)
-}
diff --git a/inst/extdata/add_seealso.R b/inst/extdata/scripts/add_seealso.R
similarity index 100%
rename from inst/extdata/add_seealso.R
rename to inst/extdata/scripts/add_seealso.R
diff --git a/inst/extdata/list_all_dwd_urls.R b/inst/extdata/scripts/list_all_dwd_urls.R
similarity index 92%
rename from inst/extdata/list_all_dwd_urls.R
rename to inst/extdata/scripts/list_all_dwd_urls.R
index 197f41ad..c2fb1d40 100644
--- a/inst/extdata/list_all_dwd_urls.R
+++ b/inst/extdata/scripts/list_all_dwd_urls.R
@@ -5,12 +5,14 @@ if (FALSE)
kwb.utils::clearConsole()
- system.time({
- dwd_files <- kwb.dwd::list_url(base_url, recursive = TRUE, full_info = TRUE)
- })
+ system.time(dwd_files <- kwb.dwd::list_url(
+ url = base_url,
+ recursive = TRUE,
+ full_info = TRUE
+ ))
# User System verstrichen
- # 237.30 6.55 763.80
+ # 275.32 18.00 613.42
# Save dataset in the package
usethis::use_data(dwd_files, overwrite = TRUE)
diff --git a/inst/extdata/list_and_check_urls.R b/inst/extdata/scripts/list_and_check_urls.R
similarity index 100%
rename from inst/extdata/list_and_check_urls.R
rename to inst/extdata/scripts/list_and_check_urls.R
diff --git a/inst/extdata/mask-any-shape.R b/inst/extdata/scripts/mask-any-shape.R
similarity index 82%
rename from inst/extdata/mask-any-shape.R
rename to inst/extdata/scripts/mask-any-shape.R
index 13c138c0..c8a6f432 100644
--- a/inst/extdata/mask-any-shape.R
+++ b/inst/extdata/scripts/mask-any-shape.R
@@ -5,13 +5,13 @@ if (FALSE)
`%>%` <- magrittr::`%>%`
# Read monthly data for the whole of Germany
- rain_2012 <- kwb.dwd:::read_monthly_data_over_shape(
+ rain_2021 <- kwb.dwd:::read_monthly_data_over_shape(
variable = "precipitation",
from = "202101",
to = "202112"
)
- head(rain_2012)
+ head(rain_2021)
shape_file <- "~/../Downloads/A/amarex/GIS-Verschneidung/EZG_Berlin_BWB_shape.shp"
@@ -19,24 +19,26 @@ if (FALSE)
file = shape_file,
variable = "evapo_p",
from = "202001",
- to = "202002"
+ to = "202002",
+ drop_z = TRUE
))
- # User System verstrichen
- # 32.27 4.37 37.36
system.time(evapo_p_monthly <- kwb.dwd::read_monthly_data_over_shape(
file = shape_file,
variable = "evapo_p",
from = "202001",
to = "202002",
- drop_z = TRUE, # passed to kwb.dwd:::read_shape_file()
- use_sf = TRUE # passed to kwb.dwd:::read_shape_file()
+ drop_z = TRUE
))
- # 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)
+ shape <- kwb.dwd:::read_shape_file(
+ file = shape_file,
+ target_crs = terra::crs("EPSG:31467"),
+ drop_z = TRUE
+ )
+
+ terra::plot(shape, axes = TRUE)
system.time(evapo_p_monthly2 <- kwb.dwd::read_monthly_data_over_shape(
shape = shape,
@@ -46,6 +48,7 @@ if (FALSE)
))
identical(evapo_p_monthly, evapo_p_monthly2)
+ all.equal(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(
@@ -55,7 +58,7 @@ if (FALSE)
to = "202002"
))
- # Rainfall in the different Berliner Bezirke
+ # Rainfall in the different districts of Berlin
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"),
@@ -68,11 +71,10 @@ if (FALSE)
)
shapes_bezirke <- kwb.dwd:::read_shape_file(
- grep("\\.shp$", unzipped_files, value = TRUE),
- use_sf = TRUE
+ grep("\\.shp$", unzipped_files, value = TRUE)
)
- sp::plot(shapes_bezirke)
+ sf::plot_sf(shapes_bezirke)
shapes_by_bezirk <- split(shapes_bezirke, shapes_bezirke$Gemeinde_n)
@@ -123,9 +125,9 @@ if (FALSE)
evapo_p_monthly
# Read shape file as Spatial object and transform to projection used by DWD
- shape_spatial <- kwb.dwd:::read_shape_with_dwd_projection(
+ shape_spatial <- kwb.dwd:::read_shape_file(
shape_file,
- use_sf = TRUE,
+ target_crs = terra::crs("EPSG:31467"),
drop_z = TRUE,
as_spatial = TRUE
)
@@ -133,17 +135,16 @@ if (FALSE)
# Filter for features
shape_spatial <- shape_spatial[grepl(" (X|VII)$", shape_spatial$Pumpwerk), ]
- sp::plot(shape_spatial)
-
grid <- kwb.dwd::get_example_grid_germany()
- sp::plot(grid)
+ terra::plot(grid)
+ terra::plot(shape_spatial, add = TRUE)
shaped_grid <- crop_and_mask(grid, shape_spatial)
- sp::plot(grid)
- sp::plot(shaped_grid)
- sp::plot(shape_spatial, add = TRUE)
+ sf::plot_sf(grid)
+ sf::plot_sf(shaped_grid)
+ sf::plot_sf(shape_spatial, add = TRUE)
as.matrix(shaped_grid)
}
diff --git a/inst/extdata/scripts/provide-data.R b/inst/extdata/scripts/provide-data.R
new file mode 100644
index 00000000..9cb0a0f0
--- /dev/null
+++ b/inst/extdata/scripts/provide-data.R
@@ -0,0 +1,166 @@
+`%>%` <- magrittr::`%>%`
+
+provide_shapes_of_germany <- FALSE
+provide_projection_files <- FALSE
+provide_epsg_codes <- FALSE
+
+# Provide shapes of Germany as datasets ----------------------------------------
+if (provide_shapes_of_germany)
+{
+ # 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
+ )
+
+ (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)
+}
+
+# Provide projection files -----------------------------------------------------
+if (provide_projection_files)
+{
+ # 1. Create a "projections" folder in the package
+
+ prj_dir <- kwb.utils::createDirectory("inst/extdata/projections")
+
+ # 2. Provide the main projection files
+
+ relative_paths <- grep("\\.prj$", kwb.dwd::dwd_files$file, value = TRUE)
+ base_url <- "https://opendata.dwd.de/climate_environment/CDC/"
+ prj_urls <- paste0(base_url, relative_paths)
+
+ download.file(
+ url = prj_urls,
+ destfile = file.path(prj_dir, basename(prj_urls))
+ )
+
+ # 3. Provide further RADOLAN-related projection files
+
+ # URL to zip file containing RADOLAN-related shape files
+ radolan_gis_url <- "help/RADOLAN/Unterstuetzungsdokumente/RADOLAN-GIS.zip" %>%
+ kwb.dwd:::ftp_path_cdc()
+
+ # Download the zip file and unzip it into an empty temporary directory
+ extracted_files <- radolan_gis_url %>%
+ kwb.dwd:::download(target_dir = tempdir(), mode = "wb") %>%
+ kwb.dwd:::unzip_zip_file(kwb.utils::createDirectory(tempfile("dir_")))
+
+ # Copy the .prj files into the "projections" folder
+ prj_files <- grep("\\.prj$", extracted_files, value = TRUE)
+ file.copy(from = prj_files, to = prj_dir)
+
+ # 4. Write a README file
+
+ dirname_as_caption <- function(url) {
+ c(paste0(dirname(url), ":"), paste0("- ", basename(url)))
+ }
+
+ writeLines(con = file.path(prj_dir, "README.txt"), c(
+ dirname_as_caption(prj_urls[1L]),
+ "",
+ dirname_as_caption(prj_urls[2L]),
+ "",
+ paste0(radolan_gis_url, ":"),
+ paste0("- ", basename(prj_files))
+ ))
+
+}
+
+# Provide information on EPSG codes --------------------------------------------
+if (provide_epsg_codes)
+{
+ files <- kwb.dwd::dwd_files$file
+
+ is_pdf <- endsWith(files, ".pdf")
+
+ pdf_urls <- gsub("^ftp:", "https:", kwb.dwd:::ftp_path_cdc(files[is_pdf]))
+
+ global_pattern <- "EPSG"
+ local_pattern <- "^.*(EPSG[:/-](\\d+)).*$"
+
+ matches <- lapply(pdf_urls, function(pdf_url) {
+ kwb.utils::catAndRun(
+ sprintf(
+ "Reading %d/%d: %s",
+ which(pdf_url == pdf_urls),
+ length(pdf_urls),
+ pdf_url
+ ),
+ expr = {
+ try(grep(
+ global_pattern,
+ pdftools::pdf_text(pdf_url),
+ value = TRUE,
+ ignore.case = TRUE
+ ))
+ }
+ )
+ })
+
+ kwb.utils:::cache_and_return(matches, "matches")
+
+ matches <- kwb.utils:::get_cached("matches")
+
+ length(matches)
+
+ keep <- lengths(matches) > 0L & !sapply(matches, kwb.utils::isTryError)
+
+ matching_dirs <- dirname(pdf_urls[keep])
+ matching_names <- basename(pdf_urls[keep])
+ matching_pages <- matches[keep]
+
+ stopifnot(identical(length(matching_names), length(matching_pages)))
+
+ head(matching_pages)
+
+ which(lengths(matching_pages) > 1L)
+
+
+ local_matches <- sapply(matching_pages, function(x) {
+ x %>%
+ strsplit("\n") %>%
+ unlist() %>%
+ grep(pattern = local_pattern, value = TRUE, ignore.case = TRUE) %>%
+ gsub(pattern = local_pattern, replacement = "\\2", ignore.case = TRUE) %>%
+ trimws() %>%
+ unique() %>%
+ paste(collapse = " ")
+ })
+
+ stopifnot(all(nchar(local_matches) > 0L))
+
+ epsg_info <- data.frame(
+ dir = matching_dirs,
+ file = matching_names,
+ epsg = as.integer(local_matches)
+ )
+
+ #View(epsg_info)
+
+ usethis::use_data(epsg_info)
+}
diff --git a/inst/extdata/scripts/read-daily-braunschweig-data.R b/inst/extdata/scripts/read-daily-braunschweig-data.R
new file mode 100644
index 00000000..e411cef9
--- /dev/null
+++ b/inst/extdata/scripts/read-daily-braunschweig-data.R
@@ -0,0 +1,106 @@
+# List URLs with monthly/daily grid data for Germany ---------------------------
+if (FALSE)
+{
+ #
+ # monthly
+ #
+
+ urls_monthly <- kwb.dwd:::list_grids_germany(
+ resolution = "monthly",
+ extension = ".asc.gz",
+ variable = "x"
+ )
+ # -> error with possible variables
+
+ urls_monthly <- kwb.dwd:::list_grids_germany(
+ resolution = "monthly",
+ extension = ".asc.gz",
+ variable = "sunshine_duration"
+ )
+
+ #
+ # daily
+ #
+
+ urls_daily <- kwb.dwd:::list_grids_germany(
+ resolution = "daily",
+ extension = ".tgz",
+ variable = "x"
+ )
+ # -> error with possible variables
+
+ urls_daily <- kwb.dwd:::list_grids_germany(
+ resolution = "daily",
+ extension = ".tgz",
+ variable = "soil_temperature_5cm"
+ )
+
+ kwb.file::remove_common_root(urls_monthly)
+ kwb.file::remove_common_root(urls_daily)
+}
+
+# Download daily grids for Germany (.asc files) --------------------------------
+if (FALSE)
+{
+ from <- "202201"
+ to <- "202207"
+
+ files_evapo_p <- kwb.dwd:::download_daily_grids_germany("evapo_p", from, to)
+ files_evapo_r <- kwb.dwd:::download_daily_grids_germany("evapo_r", from, to)
+}
+
+# Download monthly grids for Germany (.asc.gz files) ---------------------------
+if (FALSE)
+{
+ from <- "202201"
+ to <- "202207"
+
+ files <- kwb.dwd:::download_monthly_grids_germany("frost_depth", from, to)
+
+ file <- files[1L]
+
+ kwb.utils::hsOpenWindowsExplorer(dirname(file))
+
+ epsg <- kwb.dwd:::get_epsg_from_url(urls_monthly[1L])
+
+ crs <- paste0("EPSG:", epsg)
+ #crs <- NULL
+
+ grid <- kwb.dwd:::read_asc_gz_file(file, crs = crs)
+
+ raster::plot(grid)
+}
+
+# Read daily data from DWD, mask region with given shape file ------------------
+if (FALSE)
+{
+ shape_file_bs <- "~/../Downloads/A/Abwasserverregnungsgebiet/Abwasserverregnungsgebiet.shp"
+
+ grid <- kwb.dwd::get_example_grid_germany()
+
+ target_crs <- terra::crs(grid)
+
+ shape_bs <- kwb.dwd:::read_shape_file(
+ file = shape_file_bs,
+ target_crs = target_crs
+ )
+
+ shape_berlin <- kwb.dwd:::transform_coords(
+ kwb.dwd:::get_shape_of_german_region("berlin"),
+ target_crs = target_crs
+ )
+
+ terra::plot(grid)
+ terra::plot(shape_bs, add = TRUE)
+ terra::plot(shape_berlin, add = TRUE)
+
+ # Only data of full months can currently be read!
+ evapo_p <- kwb.dwd::read_daily_data_over_shape(
+ file = shape_file_bs,
+ variable = "evapo_p",
+ from = "202001",
+ to = "202002"
+ )
+
+ View(evapo_p)
+}
diff --git a/inst/extdata/read_radolan-data.R b/inst/extdata/scripts/read_radolan-data.R
similarity index 94%
rename from inst/extdata/read_radolan-data.R
rename to inst/extdata/scripts/read_radolan-data.R
index 93fefcc5..214e83ca 100644
--- a/inst/extdata/read_radolan-data.R
+++ b/inst/extdata/scripts/read_radolan-data.R
@@ -8,7 +8,7 @@ if (FALSE)
# 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
+ # List available 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)
@@ -83,22 +83,23 @@ if (FALSE)
mode = "wb"
)
- target_dir <- kwb.dwd:::temp_dir("dwd/radolan-gis")
-
- files <- kwb.dwd:::unzip_zip_file(zip_file, target_dir)
+ files <- kwb.dwd:::unzip_zip_file(
+ file = zip_file,
+ target_dir = kwb.dwd:::temp_dir("dwd/radolan-gis")
+ )
- prj_files <- grep("\\.prj$", files, value = TRUE)
+ # Read the shapes
shp_files <- grep("\\.shp$", files, value = TRUE)
+ radolan_shapes <- lapply(shp_files, kwb.dwd:::read_shape_file)
- #shp_files <- dir(target_dir, "\\.shp$", full.names = TRUE)
-
- (projection_strings <- lapply(prj_files, readLines, warn = FALSE))
+ # Get the Coordinate Reference Systems
+ coord_ref_systems <- lapply(radolan_shapes, sf::st_crs)
- 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)
+ # They are also stored in the package
+ "extdata/projections" %>%
+ system.file(package = "kwb.dwd") %>%
+ dir("prj$", full.names = TRUE) %>%
+ lapply(raster:::.spCRS)
}
# Provide shapes ---------------------------------------------------------------
@@ -148,9 +149,6 @@ if (FALSE)
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 -------------------------------------
diff --git a/inst/extdata/test_performance.R b/inst/extdata/scripts/test_performance.R
similarity index 100%
rename from inst/extdata/test_performance.R
rename to inst/extdata/scripts/test_performance.R
diff --git a/inst/extdata/scripts/untitled-1.R b/inst/extdata/scripts/untitled-1.R
new file mode 100644
index 00000000..cf580765
--- /dev/null
+++ b/inst/extdata/scripts/untitled-1.R
@@ -0,0 +1,110 @@
+# Load the pipe operator and define helper functions ---------------------------
+`%>%` <- magrittr::`%>%`
+grep_value <- function(x, p) grep(p, x, value = TRUE)
+
+# Provide information on all files on the DWD server in variable "x" -----------
+x <- kwb.dwd::dwd_files
+
+# What file name extensions do the files on the DWD server have? ---------------
+files <- kwb.utils::selectColumns(x, "file")
+
+extensions <- kwb.utils::fileExtension(files)
+
+table(extensions)
+
+# sort(unique(extensions))
+# ""
+# "alt" -> neglect
+# "asc"
+# "bz2"
+# "css"
+# "csv"
+# "db"
+# "gif"
+# "gz"
+# "html"
+# "ico"
+# "java"
+# "jpg"
+# "nc"
+# "pdf"
+# "png"
+# "prj"
+# "qpj"
+# "sav"
+# "sh"
+# "svgz"
+# "tar"
+# "tgz"
+# "txt"
+# "txt~"
+# "xlsx"
+# "xml"
+# "zip"
+
+# What and how many files have a certain file name extension? ------------------
+extension <- "asc"
+
+(files_with_extension <- files[extensions == extension])
+
+length(files_with_extension)
+
+# What are the full URLs to these files? ---------------------------------------
+urls <- file.path(kwb.dwd:::ftp_path_cdc(), files_with_extension)
+
+# Try to read one of these files -----------------------------------------------
+url <- gsub("^ftp:", "https", urls[1L])
+
+kwb.dwd:::read_esri_ascii_grid_lines_into_matrix(url)
+readLines(url, 6L)
+readLines(url, 10L)
+
+# What methods does raster::raster() have? -------------------------------------
+showMethods(raster::raster)
+
+# What does the "character" method of raster::raster do? -----------------------
+getMethod(raster::raster, signature = "character")
+
+r <- raster:::.rasterObjectFromFile(url)
+m <- raster::getValues(r)
+
+str(m)
+
+mask <- kwb.dwd:::get_berlin_dwd_mask()
+dim(mask)
+findblobs::plot_integer_matrix(mask)
+
+m1 <- raster::as.matrix(r)
+dim(m1)
+
+str(m1)
+
+kwb.dwd:::read_asc_gz_file
+
+# What are the unique directory paths? -----------------------------------------
+dir_paths <- unique(dirname(x$file))
+length(dir_paths)
+head(dir_paths)
+
+# What directory paths have "historical" in their name? ------------------------
+dph <- grep_value(dir_paths, "historical")
+
+# Radolan monthly|daily|hourly
+
+# Convert directory paths to path templates ------------------------------------
+dp <- dir_paths %>%
+ grep_value("grids_germany") %>%
+ grep_value("monthly|daily|hourly")
+
+#dp <- x$file[startsWith(x$file, "grids_germany/monthly/sunshine_duration")]
+#basename(dp)
+
+templates <- unique(kwb.utils::multiSubstitute(dp, list(
+ "/\\d{4}$" = "/",
+ "/\\d{2}_(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)$" = "/",
+ "/v\\d{3}(/|$)" = "/\\1",
+ "_(min|mean|max)(/|$)" = "_\\2"
+)))
+
+templates
+# 84
diff --git a/inst/extdata/scripts/untitled-2.R b/inst/extdata/scripts/untitled-2.R
new file mode 100644
index 00000000..99e6e50d
--- /dev/null
+++ b/inst/extdata/scripts/untitled-2.R
@@ -0,0 +1,39 @@
+kwb.dwd:::list_daily_grids_germany_tgz
+list_urls_grids_germany("daily", "tgz")
+
+kwb.dwd:::list_monthly_grids_germany_asc_gz
+list_urls_grids_germany("daily", "asc.gz")
+
+variable <- "a"
+
+base_url <- kwb.dwd:::ftp_path_monthly_grids(variable)
+
+file.exists("ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly")
+
+# 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"
+))
+
+# List data files
+relative_urls <- base_url %>%
+ list_url(recursive = recursive) %>%
+ filter_by_extension_asc_gz() %>%
+ filter_by_month_range(from, to)
+
+# Provide full paths to zipped files in ESRI-ascii-grid-format
+file.path(base_url, relative_urls)
diff --git a/inst/extdata/scripts/untitled-3.R b/inst/extdata/scripts/untitled-3.R
new file mode 100644
index 00000000..a701743f
--- /dev/null
+++ b/inst/extdata/scripts/untitled-3.R
@@ -0,0 +1,38 @@
+x <- basename(kwb.dwd::dwd_files$file)
+
+writeLines(sort(unique(kwb.dwd:::get_full_extension(x))))
+
+# asc
+# asc.gz
+# asc.zip
+# css
+# csv
+# csv.zip
+# db
+# gdb.zip
+# gif
+# gz
+# html
+# ico
+# java
+# jpg
+# nc
+# nc.bz2
+# nc.gz
+# pdf
+# png
+# prj
+# qpj
+# sav
+# sh
+# svgz
+# tar
+# tar.gz
+# tgz
+# txt
+# txt.alt
+# txt.gz
+# txt~
+# xlsx
+# xml
+# zip
diff --git a/inst/extdata/scripts/untitled-4.R b/inst/extdata/scripts/untitled-4.R
new file mode 100644
index 00000000..27d216f2
--- /dev/null
+++ b/inst/extdata/scripts/untitled-4.R
@@ -0,0 +1,37 @@
+kwb.dwd:::get_regional_stats_from_radolan_files
+
+as_temp_dir <- function(x)
+{
+ stopifnot(is.character(x), length(x) == 1L)
+ result <- kwb.dwd::temp_dir(x)
+ kwb.utils::addClass(result, c("temporary", "directory"))
+}
+
+as_temp_dir("a")
+
+contains <- function(x, ...)
+{
+ UseMethod("contains")
+}
+
+contains.file <- function(x, pattern)
+{
+ kwb.dwd:::contains_file(kwb.utils::safePath(x), pattern)
+}
+
+contains.temp_dir <- function(x, pattern)
+{
+
+}
+
+as_file <- function(x)
+{
+ UseMethod("as_file")
+}
+
+as_file.character <- function(x)
+{
+ kwb.utils::addClass(x, "file")
+}
+
+contains(as_file(tempdir()), "xls")
diff --git a/inst/extdata/scripts/use_terra.R b/inst/extdata/scripts/use_terra.R
new file mode 100644
index 00000000..ae565eef
--- /dev/null
+++ b/inst/extdata/scripts/use_terra.R
@@ -0,0 +1,108 @@
+# MAIN: Read shape file --------------------------------------------------------
+if (FALSE)
+{
+ shape_1 <- sf::st_read(shape_file)
+ shape_2 <- kwb.dwd:::read_shape_file(shape_file)
+ shape_3 <- kwb.dwd:::read_shape_file(shape_file, drop_z = TRUE)
+ shape_4 <- kwb.dwd:::read_shape_file(shape_file, drop_z = TRUE, as_spatial = TRUE)
+
+ all.equal(shape_1, shape_2)
+
+ shape <- shape_1
+}
+
+# MAIN -------------------------------------------------------------------------
+if (FALSE)
+{
+ raster_files_evapo_p <- dir_asc("~/../Downloads/dwd/grids_germany/monthly/evapo_p")
+ raster_files_precip <- dir_asc("~/../Downloads/dwd/grids_germany/monthly/precipitation")
+
+ gz_files_precip <- kwb.dwd:::download_monthly_grids_germany(
+ variable = "precipitation",
+ from = "201501",
+ to = "202112"
+ )
+
+ asc_files_precip <- unname(sapply(gz_files_precip, kwb.dwd:::unzip_asc_gz_file))
+ prj_files <- sapply(asc_files_precip, kwb.dwd:::provide_projection_file)
+
+ # Read and stamp out raster data files
+ evapo_p <- read_and_stamp_out(raster_files = raster_files_evapo_p, shape)
+ precip <- read_and_stamp_out(raster_files = asc_files_precip, shape)
+
+ # Summarise by year
+ climate_data <- cbind(
+ sum_by_year(evapo_p),
+ sum_by_year(filter_for_summer(evapo_p), prefix = "evapo_p")[-1L],
+ sum_by_year(precip),
+ sum_by_year(filter_for_summer(precip), prefix = "precip")[-1L]
+ )
+
+ climate_data
+
+ # Compare with what I hacked together with Francesco
+ readRDS("~/climate_bln1_2015-2021.rds")
+
+ # Plot the shape onto the raster
+ terra::plot(raster)
+ terra::plot(shape_in_dwd_projection, add = TRUE)
+
+ sf::st_crop()
+
+ terra::values(crop_mask)
+ terra::values(mask_crop)
+
+ shape_projection <- sf::st_crs(shape)
+
+ # Compare the coordinate reference systems
+ shape_projection
+ raster_projection
+ dwd_projection
+
+ # Get the projection file that DWD ships along with its raster files
+ dwd_projection <- readLines(kwb.dwd:::default_projection_file())
+
+}
+
+# dir_asc ----------------------------------------------------------------------
+dir_asc <- function(path)
+{
+ dir(path, pattern = "\\.asc$", full.names = TRUE, recursive = TRUE)
+}
+
+# read_and_stamp_out -----------------------------------------------------------
+read_and_stamp_out <- function(raster_files, shape)
+{
+ rasters_stamped_out <- lapply(raster_files, function(raster_file) {
+ print(raster_file)
+ # Read raster data and stamp the shape out
+ stamp_out(raster = terra::rast(raster_file), shape = shape)
+ })
+
+ values <- rasters_stamped_out %>%
+ lapply(raster::values) %>%
+ sapply(mean, na.rm = TRUE)
+
+ metadata <- kwb.dwd:::extract_metadata_from_urls(raster_files)[, 1:3]
+
+ cbind(metadata, value = values)
+}
+
+# stamp_out --------------------------------------------------------------------
+stamp_out <- function(raster, shape)
+{
+ # Transform crs of shape to crs of raster
+ shape_in_raster_projection <- sf::st_transform(shape, crs = sf::st_crs(raster))
+
+ crop_mask <- raster %>%
+ terra::crop(shape_in_raster_projection) %>%
+ terra::mask(shape_in_raster_projection)
+
+ mask_crop <- raster %>%
+ terra::mask(shape_in_raster_projection) %>%
+ terra::crop(shape_in_raster_projection)
+
+ stopifnot(all.equal(crop_mask, mask_crop))
+
+ crop_mask
+}
diff --git a/inst/extdata/validate-berlin-mask.R b/inst/extdata/scripts/validate-berlin-mask.R
similarity index 91%
rename from inst/extdata/validate-berlin-mask.R
rename to inst/extdata/scripts/validate-berlin-mask.R
index 93501289..7d784828 100644
--- a/inst/extdata/validate-berlin-mask.R
+++ b/inst/extdata/scripts/validate-berlin-mask.R
@@ -5,8 +5,17 @@
# Open description file (how to interpret the data?) ---------------------------
if (FALSE)
{
- urls <- kwb.dwd:::list_grids_germany("monthly", ".asc.gz", "evapo_p", "202201")
+ urls <- kwb.dwd:::list_grids_germany(
+ resolution = "monthly",
+ extension = ".asc.gz",
+ variable = "evapo_p",
+ from = "202401"
+ )
+
kwb.dwd::open_description(urls[1L])
+
+ # Which coordinate reference system is used?
+ kwb.dwd::get_epsg_from_url(urls[1L])
}
# Compare two versions of reading data for Berlin ------------------------------
@@ -16,12 +25,16 @@ if (FALSE)
to <- "202107"
# Version 1: use Andreas Matzinger's Berlin mask matrix
- system.time(result_1 <- kwb.dwd::load_potential_evaporation_berlin(from, to))
+ system.time(
+ result_1 <- kwb.dwd::load_potential_evaporation_berlin(from, to)
+ )
# Version 2: use shape files of German districts to mask Berlin (or any other
# German city). TODO: Performance needs to be improved (by locally storing
# transformed shapes)
- system.time(result_2 <- kwb.dwd::load_potential_evaporation_berlin_2(from, to))
+ system.time(
+ result_2 <- kwb.dwd::load_potential_evaporation_berlin_2(from, to)
+ )
# Compare the results of the two versions
result_1
diff --git a/inst/extdata/validate_radolan-data.R b/inst/extdata/scripts/validate_radolan-data.R
similarity index 100%
rename from inst/extdata/validate_radolan-data.R
rename to inst/extdata/scripts/validate_radolan-data.R
diff --git a/man/dwd_files.Rd b/man/dwd_files.Rd
index 6b8a23be..7918f4fa 100644
--- a/man/dwd_files.Rd
+++ b/man/dwd_files.Rd
@@ -5,7 +5,7 @@
\alias{dwd_files}
\title{Files Available on DWD's FTP Server}
\format{
-A data frame with 838345 observations of 8 variables:
+A data frame with 902382 observations of 8 variables:
\describe{
\item{file}{path to the file below [base_ur]}
\item{isdir}{TRUE for a directory, FALSE for a file}
@@ -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 2023-04-26.
+information were last updated on 2024-04-19.
}
\keyword{datasets}
diff --git a/man/epsg_info.Rd b/man/epsg_info.Rd
new file mode 100644
index 00000000..c94d45ab
--- /dev/null
+++ b/man/epsg_info.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/datasets.R
+\docType{data}
+\name{epsg_info}
+\alias{epsg_info}
+\title{Information on EPSG codes}
+\format{
+A data frame with 902382 observations of 8 variables:
+\describe{
+\item{dir}{path to the file below \url{ftp://opendata.dwd.de/climate_environment/CDC/}}
+\item{file}{name of the file}
+\item{epsg}{EPSG code (integer)}
+}
+}
+\usage{
+epsg_info
+}
+\description{
+Information on EPSG codes
+}
+\keyword{datasets}
diff --git a/man/get_epsg_from_url.Rd b/man/get_epsg_from_url.Rd
new file mode 100644
index 00000000..25f70399
--- /dev/null
+++ b/man/get_epsg_from_url.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_epsg_from_url.R
+\name{get_epsg_from_url}
+\alias{get_epsg_from_url}
+\title{Get EPSG Code as Found in Description File for a Given URL}
+\usage{
+get_epsg_from_url(url)
+}
+\arguments{
+\item{url}{URL to the file below \code{kwb.dwd:::ftp_path_cdc()} for which to
+find out the EPSC code}
+}
+\value{
+In the case of success, an integer number is returned. The number
+represents the EPSG code of the projection that is to be applied for the data
+in the given URL.
+}
+\description{
+The URL is looked up in column \code{dir} of \code{\link{epsg_info}}. If the
+URL is found and results in a unique EPSG code (in column \code{epsg}),
+that EPSG code is returned. If the URL is not found or if the corresponding
+EPSG codes are not unique, an error is raised.
+}
+\examples{
+\dontrun{
+url <- kwb.dwd::get_radolan_urls()$daily_historical_urls[1L]
+kwb.dwd::get_epsg_from_url(url) # error: no unique EPSG code
+}
+}
diff --git a/man/get_radolan_projection_string.Rd b/man/get_radolan_projection_string.Rd
index 67b33cf8..1326510e 100644
--- a/man/get_radolan_projection_string.Rd
+++ b/man/get_radolan_projection_string.Rd
@@ -4,7 +4,15 @@
\alias{get_radolan_projection_string}
\title{Compose radolan projection string}
\usage{
-get_radolan_projection_string()
+get_radolan_projection_string(from_prj_file = FALSE, ...)
+}
+\arguments{
+\item{from_prj_file}{whether or not to return the string that is provided
+in "radolanproj.prj" on FTP server of Deutscher Wetterdienst. The default
+is \code{FALSE}, i.e. a constant string of the form \code{+proj=...}
+is returned.}
+
+\item{\dots}{further arguments passed to \code{kwb.dwd:::to_projection_string}}
}
\value{
default radolan projection string
@@ -14,7 +22,6 @@ Compose radolan projection string
}
\examples{
get_radolan_projection_string()
-
}
\seealso{
\itemize{
diff --git a/man/get_shapes_of_germany.Rd b/man/get_shapes_of_germany.Rd
index 7d2f0902..0b8d0fad 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, use_sf = FALSE)
+get_shapes_of_germany(recreate = FALSE)
}
\arguments{
\item{recreate}{logical. If \code{TRUE} the required shape files are freshly
@@ -12,8 +12,6 @@ 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
diff --git a/man/load_potential_evaporation_berlin.Rd b/man/load_potential_evaporation_berlin.Rd
index 236606f6..10e85b4b 100644
--- a/man/load_potential_evaporation_berlin.Rd
+++ b/man/load_potential_evaporation_berlin.Rd
@@ -4,7 +4,7 @@
\alias{load_potential_evaporation_berlin}
\title{Load monthly potential evaporation for Berlin from DWD}
\usage{
-load_potential_evaporation_berlin(from = NULL, to = NULL)
+load_potential_evaporation_berlin(from = to, to = last_month())
}
\arguments{
\item{from}{optional. First month to be considered, as yyyymm string}
diff --git a/man/load_precipitation_berlin.Rd b/man/load_precipitation_berlin.Rd
index abeac757..f05b111a 100644
--- a/man/load_precipitation_berlin.Rd
+++ b/man/load_precipitation_berlin.Rd
@@ -4,7 +4,7 @@
\alias{load_precipitation_berlin}
\title{Load monthly precipitation for Berlin from DWD}
\usage{
-load_precipitation_berlin(from = NULL, to = NULL)
+load_precipitation_berlin(from = to, to = last_month())
}
\arguments{
\item{from}{optional. First month to be considered, as yyyymm string}
diff --git a/man/read_asc_file.Rd b/man/read_asc_file.Rd
index 54deb16f..21ea9557 100644
--- a/man/read_asc_file.Rd
+++ b/man/read_asc_file.Rd
@@ -4,12 +4,13 @@
\alias{read_asc_file}
\title{Read Raster Data from .ASC File}
\usage{
-read_asc_file(file, projection = get_radolan_projection_string(), dbg = TRUE)
+read_asc_file(file, crs = NULL, dbg = TRUE)
}
\arguments{
\item{file}{path to .asc file}
-\item{projection}{projection string used in Radolan data}
+\item{crs}{coordinate reference system in which the data are given. String
+as expected by \code{\link[terra]{crs}}.}
\item{dbg}{logical indicating whether to show debug messages}
}
diff --git a/man/read_asc_gz_file.Rd b/man/read_asc_gz_file.Rd
index 82a70402..cd78c0f6 100644
--- a/man/read_asc_gz_file.Rd
+++ b/man/read_asc_gz_file.Rd
@@ -4,15 +4,18 @@
\alias{read_asc_gz_file}
\title{Read Zipped ESRI-Ascii-Grid File (from URL)}
\usage{
-read_asc_gz_file(file, url = NULL)
+read_asc_gz_file(file, url = NULL, crs = NULL)
}
\arguments{
\item{file}{path to zipped file in ESRI-ascii-grid format (.asc.gz)}
\item{url}{optional. URL to zipped file in ESRI-ascii-grid format (.asc.gz)}
+
+\item{crs}{optional. Coordinate reference system, passed to
+\code{\link{read_asc_file}}.}
}
\value{
-object of class "RasterLayer"
+object of class "SpatRaster"
}
\description{
Read Zipped ESRI-Ascii-Grid File (from URL)
diff --git a/man/read_daily_data_over_shape.Rd b/man/read_daily_data_over_shape.Rd
index fa951e14..e6e50506 100644
--- a/man/read_daily_data_over_shape.Rd
+++ b/man/read_daily_data_over_shape.Rd
@@ -4,7 +4,7 @@
\alias{read_daily_data_over_shape}
\title{Read daily data from DWD, mask region with given shape file}
\usage{
-read_daily_data_over_shape(file, variable, from, to, quiet = FALSE)
+read_daily_data_over_shape(file, variable, from, to, quiet = FALSE, ...)
}
\arguments{
\item{file}{path to shape file .shp}
@@ -18,6 +18,8 @@ read_daily_data_over_shape(file, variable, from, to, quiet = FALSE)
\item{to}{last month as "yyyymm" string}
\item{quiet}{passed to \link{download.file}}
+
+\item{\dots}{further arguments passed to \code{\link{read_data_over_shape}}}
}
\value{
data frame
diff --git a/man/read_data_over_shape.Rd b/man/read_data_over_shape.Rd
index 27332968..a5567f5d 100644
--- a/man/read_data_over_shape.Rd
+++ b/man/read_data_over_shape.Rd
@@ -6,13 +6,12 @@
\usage{
read_data_over_shape(
resolution,
- file,
+ file = NULL,
variable,
from,
to,
quiet = FALSE,
shape = NULL,
- use_sf = TRUE,
...
)
}
@@ -35,8 +34,6 @@ read_data_over_shape(
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}
}
diff --git a/man/read_monthly_data_over_shape.Rd b/man/read_monthly_data_over_shape.Rd
index 0d5d1c4e..77f33ed4 100644
--- a/man/read_monthly_data_over_shape.Rd
+++ b/man/read_monthly_data_over_shape.Rd
@@ -11,7 +11,6 @@ read_monthly_data_over_shape(
to,
quiet = FALSE,
shape = NULL,
- use_sf = TRUE,
...
)
}
@@ -32,10 +31,7 @@ read_monthly_data_over_shape(
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}
+\item{\dots}{further arguments passed to \code{\link{read_data_over_shape}}}
}
\value{
data frame
diff --git a/tests/testthat/test-function-check_binary_radolan_files.R b/tests/testthat/test-function-check_binary_radolan_files.R
new file mode 100644
index 00000000..c9f29a7b
--- /dev/null
+++ b/tests/testthat/test-function-check_binary_radolan_files.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("check_binary_radolan_files() works", {
+
+ f <- kwb.dwd:::check_binary_radolan_files
+
+ expect_error(
+ f()
+ # Argument "bin_files" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-configure_radolan.R b/tests/testthat/test-function-configure_radolan.R
new file mode 100644
index 00000000..3b02012e
--- /dev/null
+++ b/tests/testthat/test-function-configure_radolan.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 19:35:43.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("configure_radolan() works", {
+
+ f <- kwb.dwd:::configure_radolan
+
+ expect_error(
+ configure_radolan()
+ # konnte Funktion "configure_radolan" nicht finden
+ )
+
+})
diff --git a/tests/testthat/test-function-consider_flags.R b/tests/testthat/test-function-consider_flags.R
new file mode 100644
index 00000000..fa605fb3
--- /dev/null
+++ b/tests/testthat/test-function-consider_flags.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("consider_flags() works", {
+
+ f <- kwb.dwd:::consider_flags
+
+ expect_error(
+ f()
+ # Argument "x" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-contains_file.R b/tests/testthat/test-function-contains_file.R
new file mode 100644
index 00000000..e7f2e644
--- /dev/null
+++ b/tests/testthat/test-function-contains_file.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("contains_file() works", {
+
+ f <- kwb.dwd:::contains_file
+
+ expect_error(
+ f()
+ # Argument "path" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-copy_file.R b/tests/testthat/test-function-copy_file.R
new file mode 100644
index 00000000..12b88115
--- /dev/null
+++ b/tests/testthat/test-function-copy_file.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("copy_file() works", {
+
+ f <- kwb.dwd:::copy_file
+
+ expect_error(
+ f()
+ # Argument "from" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-download.R b/tests/testthat/test-function-download.R
index 88f42152..d98da7f0 100644
--- a/tests/testthat/test-function-download.R
+++ b/tests/testthat/test-function-download.R
@@ -7,8 +7,7 @@ test_that("download() works", {
expect_error(f())
expect_error(expect_output(suppressWarnings(f("no-such-url"))))
- url <- default_projection_file(download = FALSE)
-
+ url <- kwb.dwd:::ftp_path_cdc("Announce_log_CDC_ftp.txt")
target_dir <- tempdir()
expect_output(file <- f(url, target_dir = target_dir))
diff --git a/tests/testthat/test-function-download_and_extract.R b/tests/testthat/test-function-download_and_extract.R
index e74dd2b1..7d024af4 100644
--- a/tests/testthat/test-function-download_and_extract.R
+++ b/tests/testthat/test-function-download_and_extract.R
@@ -1,9 +1,15 @@
+#library(testthat)
+
test_that("download_and_extract() works", {
f <- kwb.dwd:::download_and_extract
- capture.output(url <- kwb.dwd:::list_grids_germany("daily", ".tgz", "evapo_p")[1L])
- capture.output(result <- f(url, quiet = TRUE))
+ url <- paste0(
+ "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/daily/",
+ "evapo_p/grids_germany_daily_evapo_p_199101.tgz"
+ )
+
+ result <- f(url, quiet = TRUE)
expect_type(result, "character")
expect_true(all(sapply(result, file.exists)))
diff --git a/tests/testthat/test-function-download_and_extract_radolan.R b/tests/testthat/test-function-download_and_extract_radolan.R
new file mode 100644
index 00000000..889ca753
--- /dev/null
+++ b/tests/testthat/test-function-download_and_extract_radolan.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 19:35:43.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("download_and_extract_radolan() works", {
+
+ f <- kwb.dwd:::download_and_extract_radolan
+
+ expect_error(
+ download_and_extract_radolan()
+ # konnte Funktion "download_and_extract_radolan" nicht finden
+ )
+
+})
diff --git a/tests/testthat/test-function-download_and_extract_radolan_url.R b/tests/testthat/test-function-download_and_extract_radolan_url.R
new file mode 100644
index 00000000..980f06fd
--- /dev/null
+++ b/tests/testthat/test-function-download_and_extract_radolan_url.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 19:35:43.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("download_and_extract_radolan_url() works", {
+
+ f <- kwb.dwd:::download_and_extract_radolan_url
+
+ expect_error(
+ download_and_extract_radolan_url()
+ # konnte Funktion "download_and_extract_radolan_url" nicht finden
+ )
+
+})
diff --git a/tests/testthat/test-function-download_daily_grids_germany.R b/tests/testthat/test-function-download_daily_grids_germany.R
index 69442582..da943d6c 100644
--- a/tests/testthat/test-function-download_daily_grids_germany.R
+++ b/tests/testthat/test-function-download_daily_grids_germany.R
@@ -7,7 +7,7 @@ test_that("download_daily_grids_germany() works", {
expect_error(f())
expect_error(f("x"), "must be one of 'evapo_p'")
- capture.output(result <- f(variable = "evapo_p", quiet = TRUE))
+ 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_dir.R b/tests/testthat/test-function-download_dir.R
new file mode 100644
index 00000000..8a7d71d8
--- /dev/null
+++ b/tests/testthat/test-function-download_dir.R
@@ -0,0 +1,9 @@
+#library(testthat)
+
+test_that("download_dir() works", {
+
+ f <- kwb.dwd:::download_dir
+
+ expect_true(file.exists(f()))
+
+})
diff --git a/tests/testthat/test-function-download_grids_germany.R b/tests/testthat/test-function-download_grids_germany.R
new file mode 100644
index 00000000..b21645c2
--- /dev/null
+++ b/tests/testthat/test-function-download_grids_germany.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 19:35:43.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("download_grids_germany() works", {
+
+ f <- kwb.dwd:::download_grids_germany
+
+ expect_error(
+ download_grids_germany()
+ # konnte Funktion "download_grids_germany" nicht finden
+ )
+
+})
diff --git a/tests/testthat/test-function-download_into_folder_structure.R b/tests/testthat/test-function-download_into_folder_structure.R
new file mode 100644
index 00000000..2167ed57
--- /dev/null
+++ b/tests/testthat/test-function-download_into_folder_structure.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 19:35:43.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("download_into_folder_structure() works", {
+
+ f <- kwb.dwd:::download_into_folder_structure
+
+ expect_error(
+ download_into_folder_structure()
+ # konnte Funktion "download_into_folder_structure" nicht finden
+ )
+
+})
diff --git a/tests/testthat/test-function-download_shapes_germany.R b/tests/testthat/test-function-download_shapes_germany.R
index f79b0d2f..706aeb23 100644
--- a/tests/testthat/test-function-download_shapes_germany.R
+++ b/tests/testthat/test-function-download_shapes_germany.R
@@ -4,7 +4,7 @@ test_that("download_shapes_germany() works", {
f <- kwb.dwd:::download_shapes_germany
- result <- try(f(quiet = FALSE, timeout = 1))
+ result <- try(f(quiet = TRUE, timeout = 1), silent = TRUE)
if (kwb.utils::isTryError(result)) {
diff --git a/tests/testthat/test-function-ftp_path_radolan.R b/tests/testthat/test-function-ftp_path_radolan.R
new file mode 100644
index 00000000..74aaba6a
--- /dev/null
+++ b/tests/testthat/test-function-ftp_path_radolan.R
@@ -0,0 +1,9 @@
+#library(testthat)
+
+test_that("ftp_path_radolan() works", {
+
+ f <- kwb.dwd:::ftp_path_radolan
+
+ expect_type(f(resolution = "daily"), "character")
+
+})
diff --git a/tests/testthat/test-function-ftp_path_radolan_all.R b/tests/testthat/test-function-ftp_path_radolan_all.R
new file mode 100644
index 00000000..54d03332
--- /dev/null
+++ b/tests/testthat/test-function-ftp_path_radolan_all.R
@@ -0,0 +1,9 @@
+#library(testthat)
+
+test_that("ftp_path_radolan_all() works", {
+
+ f <- kwb.dwd:::ftp_path_radolan_all
+
+ expect_true(all(startsWith(f(), "grids_germany")))
+
+})
diff --git a/tests/testthat/test-function-get_epsg_from_url.R b/tests/testthat/test-function-get_epsg_from_url.R
new file mode 100644
index 00000000..d3c51e48
--- /dev/null
+++ b/tests/testthat/test-function-get_epsg_from_url.R
@@ -0,0 +1,18 @@
+#library(testthat)
+
+test_that("get_epsg_from_url() works", {
+
+ f <- kwb.dwd:::get_epsg_from_url
+
+ expect_error(f())
+
+ start_url <- "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/"
+
+ url_1 <- paste0(start_url, "evapo_p/grids_germany_monthly_evapo_p_202201.asc.gz")
+ url_2 <- paste0(start_url, "precipitation/01_Jan/grids_germany_monthly_precipitation_188101.asc.gz")
+ url_3 <- kwb.dwd:::get_radolan_url("hourly", year_month = "202001")
+
+ capture.output(expect_error(f(url_1)))
+ expect_identical(f(url_2), 31467L)
+ expect_identical(f(url_3), 3034L)
+})
diff --git a/tests/testthat/test-function-get_example_grid_germany.R b/tests/testthat/test-function-get_example_grid_germany.R
index 4341ed5e..95b4ba52 100644
--- a/tests/testthat/test-function-get_example_grid_germany.R
+++ b/tests/testthat/test-function-get_example_grid_germany.R
@@ -1,8 +1,10 @@
+#library(testthat)
+
test_that("get_example_grid_germany() works", {
f <- kwb.dwd:::get_example_grid_germany
- capture.output(suppressWarnings(result <- f()))
+ expect_output(result <- f())
- expect_true(inherits(result, "RasterLayer"))
+ expect_true(inherits(result, "SpatRaster"))
})
diff --git a/tests/testthat/test-function-get_full_extension.R b/tests/testthat/test-function-get_full_extension.R
new file mode 100644
index 00000000..7a0809ca
--- /dev/null
+++ b/tests/testthat/test-function-get_full_extension.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_full_extension() works", {
+
+ f <- kwb.dwd:::get_full_extension
+
+ expect_error(
+ f()
+ # Argument "x" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_radolan_format_description.R b/tests/testthat/test-function-get_radolan_format_description.R
new file mode 100644
index 00000000..a445a16f
--- /dev/null
+++ b/tests/testthat/test-function-get_radolan_format_description.R
@@ -0,0 +1,15 @@
+#library(testthat)
+
+test_that("get_radolan_format_description() works", {
+
+ f <- kwb.dwd:::get_radolan_format_description
+
+ result <- f()
+
+ expect_s3_class(result, "data.frame")
+
+ expect_identical(names(result), c(
+ "FORTRAN.Bezeichner", "Produktkennung", "Dateiname", "Inhalt"
+ ))
+
+})
diff --git a/tests/testthat/test-function-get_radolan_header_patterns.R b/tests/testthat/test-function-get_radolan_header_patterns.R
new file mode 100644
index 00000000..96769ccd
--- /dev/null
+++ b/tests/testthat/test-function-get_radolan_header_patterns.R
@@ -0,0 +1,9 @@
+#library(testthat)
+
+test_that("get_radolan_header_patterns() works", {
+
+ f <- kwb.dwd:::get_radolan_header_patterns
+
+ expect_type(f(), "character")
+
+})
diff --git a/tests/testthat/test-function-get_radolan_metadata.R b/tests/testthat/test-function-get_radolan_metadata.R
new file mode 100644
index 00000000..efdf49ea
--- /dev/null
+++ b/tests/testthat/test-function-get_radolan_metadata.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:12:57.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_radolan_metadata() works", {
+
+ f <- kwb.dwd:::get_radolan_metadata
+
+ expect_error(
+ get_radolan_metadata()
+ # konnte Funktion "get_radolan_metadata" nicht finden
+ )
+
+})
diff --git a/tests/testthat/test-function-get_radolan_metadata_from_header.R b/tests/testthat/test-function-get_radolan_metadata_from_header.R
new file mode 100644
index 00000000..b52e86e1
--- /dev/null
+++ b/tests/testthat/test-function-get_radolan_metadata_from_header.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_radolan_metadata_from_header() works", {
+
+ f <- kwb.dwd:::get_radolan_metadata_from_header
+
+ expect_error(
+ f()
+ # Argument "bin_files" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_radolan_projection_string.R b/tests/testthat/test-function-get_radolan_projection_string.R
index 646a088c..a0ec914c 100644
--- a/tests/testthat/test-function-get_radolan_projection_string.R
+++ b/tests/testthat/test-function-get_radolan_projection_string.R
@@ -1,9 +1,21 @@
+#library(testthat)
+
test_that("get_radolan_projection_string() works", {
f <- kwb.dwd:::get_radolan_projection_string
- result <- f()
+ string_hard_coded <- f(from_prj_file = FALSE)
+ string_from_prj <- f(from_prj_file = TRUE)
+
+ expect_type(string_hard_coded, "character")
+ expect_type(string_from_prj, "character")
+
+ expect_true(startsWith(string_hard_coded, "+proj="))
+ expect_true(startsWith(string_from_prj, "PROJCS["))
+
+ expect_silent(objects <- lapply(FUN = sf::st_crs, X = c(
+ hard_coded = string_hard_coded,
+ from_prj = string_from_prj
+ )))
- expect_type(result, "character")
- expect_true(startsWith(result, "+proj="))
})
diff --git a/tests/testthat/test-function-get_radolan_timestamps.R b/tests/testthat/test-function-get_radolan_timestamps.R
new file mode 100644
index 00000000..a0a791bf
--- /dev/null
+++ b/tests/testthat/test-function-get_radolan_timestamps.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_radolan_timestamps() works", {
+
+ f <- kwb.dwd:::get_radolan_timestamps
+
+ expect_error(
+ f()
+ # Argument "bin_files" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_radolan_timestamps_from_filenames.R b/tests/testthat/test-function-get_radolan_timestamps_from_filenames.R
new file mode 100644
index 00000000..87304092
--- /dev/null
+++ b/tests/testthat/test-function-get_radolan_timestamps_from_filenames.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_radolan_timestamps_from_filenames() works", {
+
+ f <- kwb.dwd:::get_radolan_timestamps_from_filenames
+
+ expect_error(
+ f()
+ # Argument "files" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_radolan_timestamps_from_headers.R b/tests/testthat/test-function-get_radolan_timestamps_from_headers.R
new file mode 100644
index 00000000..993cf33e
--- /dev/null
+++ b/tests/testthat/test-function-get_radolan_timestamps_from_headers.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_radolan_timestamps_from_headers() works", {
+
+ f <- kwb.dwd:::get_radolan_timestamps_from_headers
+
+ expect_error(
+ f()
+ # Argument "bin_files" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_regional_stats_from_radolan_asc_files.R b/tests/testthat/test-function-get_regional_stats_from_radolan_asc_files.R
new file mode 100644
index 00000000..7ac64ca7
--- /dev/null
+++ b/tests/testthat/test-function-get_regional_stats_from_radolan_asc_files.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_regional_stats_from_radolan_asc_files() works", {
+
+ f <- kwb.dwd:::get_regional_stats_from_radolan_asc_files
+
+ expect_error(
+ f()
+ # Argument "shape" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_regional_stats_from_radolan_bin_files.R b/tests/testthat/test-function-get_regional_stats_from_radolan_bin_files.R
new file mode 100644
index 00000000..d96b9301
--- /dev/null
+++ b/tests/testthat/test-function-get_regional_stats_from_radolan_bin_files.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_regional_stats_from_radolan_bin_files() works", {
+
+ f <- kwb.dwd:::get_regional_stats_from_radolan_bin_files
+
+ expect_error(
+ f()
+ # Argument "shape" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_regional_stats_from_radolan_files.R b/tests/testthat/test-function-get_regional_stats_from_radolan_files.R
new file mode 100644
index 00000000..c872e3e9
--- /dev/null
+++ b/tests/testthat/test-function-get_regional_stats_from_radolan_files.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_regional_stats_from_radolan_files() works", {
+
+ f <- kwb.dwd:::get_regional_stats_from_radolan_files
+
+ expect_error(
+ f()
+ # Argument "shape" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-get_relative_path.R b/tests/testthat/test-function-get_relative_path.R
new file mode 100644
index 00000000..fed3f8c9
--- /dev/null
+++ b/tests/testthat/test-function-get_relative_path.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("get_relative_path() works", {
+
+ f <- kwb.dwd:::get_relative_path
+
+ expect_error(
+ f()
+ # Argument "file" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-list_extracted_radolan_files.R b/tests/testthat/test-function-list_extracted_radolan_files.R
new file mode 100644
index 00000000..2dc20c1d
--- /dev/null
+++ b/tests/testthat/test-function-list_extracted_radolan_files.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:12:57.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("list_extracted_radolan_files() works", {
+
+ f <- kwb.dwd::list_extracted_radolan_files
+
+ expect_error(
+ f()
+ # Argument "resolution" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-list_grids_germany.R b/tests/testthat/test-function-list_grids_germany.R
index 039eb905..602c94b3 100644
--- a/tests/testthat/test-function-list_grids_germany.R
+++ b/tests/testthat/test-function-list_grids_germany.R
@@ -16,9 +16,7 @@ test_that("list_grids_germany() works", {
"must be one of 'evapo_p'"
)
- expect_output(
- result <- f("monthly", ".tgz", "sunshine_duration", recursive = FALSE)
- )
+ result <- f("monthly", ".tgz", "sunshine_duration", recursive = FALSE)
expect_identical(result, character(0))
})
diff --git a/tests/testthat/test-function-list_url.R b/tests/testthat/test-function-list_url.R
index 6bd75a14..e474e42a 100644
--- a/tests/testthat/test-function-list_url.R
+++ b/tests/testthat/test-function-list_url.R
@@ -2,9 +2,16 @@ test_that("list_url() works", {
f <- kwb.dwd:::list_url
- capture.output(result <- f())
- capture.output(result2 <- f(full_info = TRUE))
+ capture.output(result_1 <- f())
+ capture.output(result_2 <- f(full_info = TRUE))
+
+ expect_type(result_1, "character")
+ expect_true("grids_germany/" %in% result_1)
+
+ expect_s3_class(result_2, "data.frame")
+ expect_identical(names(result_2), c(
+ "file", "isdir", "size", "permissions", "modification_time", "user",
+ "group", "links"
+ ))
- expect_type(result, "character")
- expect_true("grids_germany/" %in% result)
})
diff --git a/tests/testthat/test-function-list_zipped_files.R b/tests/testthat/test-function-list_zipped_files.R
new file mode 100644
index 00000000..365fc477
--- /dev/null
+++ b/tests/testthat/test-function-list_zipped_files.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("list_zipped_files() works", {
+
+ f <- kwb.dwd:::list_zipped_files
+
+ expect_error(
+ f()
+ # Argument "file" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-load_potential_evaporation_berlin.R b/tests/testthat/test-function-load_potential_evaporation_berlin.R
new file mode 100644
index 00000000..2d7417cd
--- /dev/null
+++ b/tests/testthat/test-function-load_potential_evaporation_berlin.R
@@ -0,0 +1,15 @@
+#library(testthat)
+
+test_that("load_potential_evaporation_berlin() works", {
+
+ f <- kwb.dwd::load_potential_evaporation_berlin
+
+ capture.output(result <- f())
+
+ expect_s3_class(result, "data.frame")
+
+ expect_identical(names(result), c(
+ "file", "year", "month", "mean", "sd", "min", "max", "n_values"
+ ))
+
+})
diff --git a/tests/testthat/test-function-load_potential_evaporation_berlin_2.R b/tests/testthat/test-function-load_potential_evaporation_berlin_2.R
new file mode 100644
index 00000000..5ef6e090
--- /dev/null
+++ b/tests/testthat/test-function-load_potential_evaporation_berlin_2.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:15.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("load_potential_evaporation_berlin_2() works", {
+
+ f <- kwb.dwd::load_potential_evaporation_berlin_2
+
+ expect_error(
+ f()
+ # Argument "from" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-load_precipitation_berlin.R b/tests/testthat/test-function-load_precipitation_berlin.R
new file mode 100644
index 00000000..d7c9468f
--- /dev/null
+++ b/tests/testthat/test-function-load_precipitation_berlin.R
@@ -0,0 +1,15 @@
+#library(testthat)
+
+test_that("load_precipitation_berlin() works", {
+
+ f <- kwb.dwd::load_precipitation_berlin
+
+ capture.output(result <- f())
+
+ expect_s3_class(result, "data.frame")
+
+ expect_identical(names(result), c(
+ "file", "year", "month", "mean", "sd", "min", "max", "n_values"
+ ))
+
+})
diff --git a/tests/testthat/test-function-month_range_pattern.R b/tests/testthat/test-function-month_range_pattern.R
new file mode 100644
index 00000000..bbe72adf
--- /dev/null
+++ b/tests/testthat/test-function-month_range_pattern.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("month_range_pattern() works", {
+
+ f <- kwb.dwd:::month_range_pattern
+
+ expect_error(
+ f()
+ # Argument "from" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-on_windows.R b/tests/testthat/test-function-on_windows.R
new file mode 100644
index 00000000..a58f9cbd
--- /dev/null
+++ b/tests/testthat/test-function-on_windows.R
@@ -0,0 +1,12 @@
+#library(testthat)
+
+test_that("on_windows() works", {
+
+ f <- kwb.dwd:::on_windows
+
+ result <- f()
+
+ expect_type(result, "logical")
+ expect_length(result, 1L)
+
+})
diff --git a/tests/testthat/test-function-open_for_reading_in_binary_mode.R b/tests/testthat/test-function-open_for_reading_in_binary_mode.R
new file mode 100644
index 00000000..60fb873d
--- /dev/null
+++ b/tests/testthat/test-function-open_for_reading_in_binary_mode.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("open_for_reading_in_binary_mode() works", {
+
+ f <- kwb.dwd:::open_for_reading_in_binary_mode
+
+ expect_error(
+ f()
+ # Argument "file" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-provide_projection_file.R b/tests/testthat/test-function-provide_projection_file.R
index 0de1a713..465e9bb3 100644
--- a/tests/testthat/test-function-provide_projection_file.R
+++ b/tests/testthat/test-function-provide_projection_file.R
@@ -1,17 +1,16 @@
-#
-# This test file has been generated by kwb.test::create_test_files()
-# launched by user hsonne on 2022-09-16 16:43:24.
-# 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("provide_projection_file() works", {
f <- kwb.dwd:::provide_projection_file
- expect_error(
- f()
- # argument "file" is missing, with no default
- )
+ expect_error(f())
+ file <- tempfile(pattern = "projection_", fileext = ".txt")
+
+ prj_file <- f(file)
+
+ expect_identical(prj_file, kwb.utils::replaceFileExtension(file, ".prj"))
+ expect_true(file.exists(prj_file))
+ expect_true(startsWith(readLines(prj_file, n = 1L), "PROJCS"))
})
diff --git a/tests/testthat/test-function-read_asc_file.R b/tests/testthat/test-function-read_asc_file.R
new file mode 100644
index 00000000..f3308ecf
--- /dev/null
+++ b/tests/testthat/test-function-read_asc_file.R
@@ -0,0 +1,9 @@
+#library(testthat)
+
+test_that("read_asc_file() works", {
+
+ f <- kwb.dwd:::read_asc_file
+
+ expect_error(f())
+ expect_error(expect_warning(f("no-such-file", dbg = FALSE)))
+})
diff --git a/tests/testthat/test-function-read_asc_gz_file.R b/tests/testthat/test-function-read_asc_gz_file.R
index 92a5f2c2..f5ef8fad 100644
--- a/tests/testthat/test-function-read_asc_gz_file.R
+++ b/tests/testthat/test-function-read_asc_gz_file.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:24.
-# 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() works", {
f <- kwb.dwd:::read_asc_gz_file
- expect_error(
- kwb.dwd:::read_asc_gz_file()
- # argument "file" is missing, with no default
- )
+ expect_error(f())
+ start_url <- "ftp://opendata.dwd.de/climate_environment/CDC/grids_germany/monthly/"
+
+ #head(grep("\\.asc.gz$", kwb.dwd::dwd_files$file, value = TRUE))
+
+ url_1 <- paste0(start_url, "evapo_p/grids_germany_monthly_evapo_p_202201.asc.gz")
+ url_2 <- paste0(start_url, "precipitation/01_Jan/grids_germany_monthly_precipitation_188101.asc.gz")
+
+ crs <- paste("EPSG", 31467L, sep = ":")
+
+ expect_output(result_1 <- f(url = url_1, crs = crs), "Reading")
+ expect_output(result_2 <- f(url = url_2, crs = crs), "Reading")
+
+ expect_s4_class(result_1, "SpatRaster")
+ expect_s4_class(result_2, "SpatRaster")
})
diff --git a/tests/testthat/test-function-read_data_over_shape.R b/tests/testthat/test-function-read_data_over_shape.R
new file mode 100644
index 00000000..81d44dcc
--- /dev/null
+++ b/tests/testthat/test-function-read_data_over_shape.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("read_data_over_shape() works", {
+
+ f <- kwb.dwd::read_data_over_shape
+
+ expect_error(
+ f()
+ # Argument "variable" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-read_hourly_radolan_historical_bin_for_region.R b/tests/testthat/test-function-read_hourly_radolan_historical_bin_for_region.R
new file mode 100644
index 00000000..f6b1f196
--- /dev/null
+++ b/tests/testthat/test-function-read_hourly_radolan_historical_bin_for_region.R
@@ -0,0 +1,9 @@
+#library(testthat)
+
+test_that("read_hourly_radolan_historical_bin_for_region() works", {
+
+ f <- kwb.dwd:::read_hourly_radolan_historical_bin_for_region
+
+ expect_error(expect_message(f(dbg = FALSE)))
+
+})
diff --git a/tests/testthat/test-function-read_monthly_data_over_shape.R b/tests/testthat/test-function-read_monthly_data_over_shape.R
index fd4fdcc0..dd049652 100644
--- a/tests/testthat/test-function-read_monthly_data_over_shape.R
+++ b/tests/testthat/test-function-read_monthly_data_over_shape.R
@@ -1,17 +1,20 @@
-#
-# 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.
-#
+#library(testthat)
test_that("read_monthly_data_over_shape() works", {
f <- kwb.dwd:::read_monthly_data_over_shape
- expect_error(
- kwb.dwd:::read_monthly_data_over_shape()
- # argument "variable" is missing, with no default
- )
+ expect_error(f())
+ variable <- "precipitation"
+ from <- "202101"
+ to <- "202101"
+
+ expect_output(result <- f(variable = variable, from = from, to = to))
+
+ expect_s3_class(result, "data.frame")
+ expect_true(nrow(result) == 1L)
+ expect_identical(names(result), c(
+ "file", "date", "year", "month", "mean", "sd", "min", "max", "n_values"
+ ))
})
diff --git a/tests/testthat/test-function-read_shape_with_dwd_projection.R b/tests/testthat/test-function-read_shape_with_dwd_projection.R
deleted file mode 100644
index 678e194b..00000000
--- a/tests/testthat/test-function-read_shape_with_dwd_projection.R
+++ /dev/null
@@ -1,7 +0,0 @@
-test_that("read_shape_with_dwd_projection() works", {
-
- f <- kwb.dwd:::read_shape_with_dwd_projection
-
- expect_error(capture.output(f()))
-
-})
diff --git a/tests/testthat/test-function-remove_left.R b/tests/testthat/test-function-remove_left.R
new file mode 100644
index 00000000..8814a59c
--- /dev/null
+++ b/tests/testthat/test-function-remove_left.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("remove_left() works", {
+
+ f <- kwb.dwd:::remove_left
+
+ expect_error(
+ f()
+ # Argument "x" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-remove_protocol.R b/tests/testthat/test-function-remove_protocol.R
new file mode 100644
index 00000000..57969d08
--- /dev/null
+++ b/tests/testthat/test-function-remove_protocol.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("remove_protocol() works", {
+
+ f <- kwb.dwd:::remove_protocol
+
+ expect_error(
+ f()
+ # Argument "x" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-remove_right.R b/tests/testthat/test-function-remove_right.R
new file mode 100644
index 00000000..b9a5ea86
--- /dev/null
+++ b/tests/testthat/test-function-remove_right.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("remove_right() works", {
+
+ f <- kwb.dwd:::remove_right
+
+ expect_error(
+ f()
+ # Argument "x" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-split_radolan_header.R b/tests/testthat/test-function-split_radolan_header.R
new file mode 100644
index 00000000..1fdba7af
--- /dev/null
+++ b/tests/testthat/test-function-split_radolan_header.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("split_radolan_header() works", {
+
+ f <- kwb.dwd:::split_radolan_header
+
+ expect_error(
+ f()
+ # Argument "x" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-summarise_over_all_grids.R b/tests/testthat/test-function-summarise_over_all_grids.R
new file mode 100644
index 00000000..66402f8c
--- /dev/null
+++ b/tests/testthat/test-function-summarise_over_all_grids.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("summarise_over_all_grids() works", {
+
+ f <- kwb.dwd:::summarise_over_all_grids
+
+ expect_error(
+ f()
+ # Argument "grids" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-transform_coords.R b/tests/testthat/test-function-transform_coords.R
new file mode 100644
index 00000000..47955221
--- /dev/null
+++ b/tests/testthat/test-function-transform_coords.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("transform_coords() works", {
+
+ f <- kwb.dwd:::transform_coords
+
+ expect_error(
+ f()
+ # Argument "x" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-unzip_tar_file.R b/tests/testthat/test-function-unzip_tar_file.R
new file mode 100644
index 00000000..2fb787d1
--- /dev/null
+++ b/tests/testthat/test-function-unzip_tar_file.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("unzip_tar_file() works", {
+
+ f <- kwb.dwd:::unzip_tar_file
+
+ expect_error(
+ f()
+ # Argument "file" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-unzip_tar_gz_file.R b/tests/testthat/test-function-unzip_tar_gz_file.R
new file mode 100644
index 00000000..6f45dc11
--- /dev/null
+++ b/tests/testthat/test-function-unzip_tar_gz_file.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("unzip_tar_gz_file() works", {
+
+ f <- kwb.dwd:::unzip_tar_gz_file
+
+ expect_error(
+ f()
+ # Argument "file" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-unzip_zip_file.R b/tests/testthat/test-function-unzip_zip_file.R
new file mode 100644
index 00000000..635e7e2f
--- /dev/null
+++ b/tests/testthat/test-function-unzip_zip_file.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 20:31:16.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("unzip_zip_file() works", {
+
+ f <- kwb.dwd:::unzip_zip_file
+
+ expect_error(
+ f()
+ # Argument "file" fehlt (ohne Standardwert)
+ )
+
+})
diff --git a/tests/testthat/test-function-url_to_relative_path.R b/tests/testthat/test-function-url_to_relative_path.R
new file mode 100644
index 00000000..3c70a5fe
--- /dev/null
+++ b/tests/testthat/test-function-url_to_relative_path.R
@@ -0,0 +1,17 @@
+#
+# This file was generated by kwb.test::create_test_files(),
+# launched by hsonne on 2024-04-18 19:35:43.
+# Please modify the dummy functions so that real cases are
+# tested. Then, delete this comment.
+#
+
+test_that("url_to_relative_path() works", {
+
+ f <- kwb.dwd:::url_to_relative_path
+
+ expect_error(
+ url_to_relative_path()
+ # konnte Funktion "url_to_relative_path" nicht finden
+ )
+
+})
diff --git a/vignettes/overview.Rmd b/vignettes/overview.Rmd
index a2ad960b..3d97cc33 100644
--- a/vignettes/overview.Rmd
+++ b/vignettes/overview.Rmd
@@ -4,7 +4,7 @@ output:
rmarkdown::html_vignette:
toc: true
vignette: >
- %\VignetteIndexEntry{Overview}
+ %\VignetteIndexEntry{Overview on Functions in R-package kwb.dwd}
%\VignetteEncoding{UTF-8}
%\VignetteEngine{knitr::rmarkdown}
editor_options:
@@ -171,7 +171,9 @@ Example:
```{r eval = FALSE}
# Take care, this takes time!
-kwb.dwd::download_radolan(resolution = "daily")
+kwb.dwd::download_radolan(
+ resolution = "daily", start_daily = "201808", end_daily = "201808"
+)
```
```{r}
@@ -283,7 +285,7 @@ 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}
+```{r eval = FALSE}
bin_file <- file.path(
kwb.dwd:::download_dir("radolan"),
"raa01-sf_10000-1808041150-dwd---bin"
@@ -295,7 +297,7 @@ 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}
+```{r fig.width = 6, eval = FALSE}
raster::plot(raster)
```