From 2cda40b9a226e4fc5437ea507fe1577426032fc3 Mon Sep 17 00:00:00 2001 From: Sebastian Ostberg Date: Fri, 17 May 2024 11:36:49 +0200 Subject: [PATCH] Replace find_gridfile() with more generic find_varfile() function --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- NAMESPACE | 1 + R/LPJmLData.R | 54 +------------------- R/find_varfile.R | 82 ++++++++++++++++++++++++++++++ README.md | 6 +-- man/find_varfile.Rd | 33 ++++++++++++ tests/testthat/test-LPJmLData.R | 16 ------ tests/testthat/test-find_varfile.R | 16 ++++++ 10 files changed, 139 insertions(+), 75 deletions(-) create mode 100644 R/find_varfile.R create mode 100644 man/find_varfile.Rd create mode 100644 tests/testthat/test-find_varfile.R diff --git a/.buildlibrary b/.buildlibrary index 4ca1923..dc1c4d6 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '2978850' +ValidationKey: '3177440' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index 6d0af6c..3f11812 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,7 +2,7 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'lpjmlkit: Toolkit for Basic LPJmL Handling' -version: 1.5.0 +version: 1.6.0 date-released: '2024-05-16' abstract: A collection of basic functions to facilitate the work with the Dynamic Global Vegetation Model (DGVM) Lund-Potsdam-Jena managed Land (LPJmL) hosted at diff --git a/DESCRIPTION b/DESCRIPTION index 9c97943..7bee223 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: lpjmlkit Type: Package Title: Toolkit for Basic LPJmL Handling -Version: 1.5.0 +Version: 1.6.0 Authors@R: c( person("Jannes", "Breier", , "jannesbr@pik-potsdam.de", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9055-6904")), person("Sebastian","Ostberg", , "ostberg@pik-potsdam.de", role = "aut", comment = c(ORCID = "0000-0002-2368-7015")), diff --git a/NAMESPACE b/NAMESPACE index f99800e..f39c8e2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(calc_cellarea) export(check_config) export(create_header) export(detect_io_type) +export(find_varfile) export(get_cellindex) export(get_datatype) export(get_header_item) diff --git a/R/LPJmLData.R b/R/LPJmLData.R index 4e7c197..8ad5d2c 100644 --- a/R/LPJmLData.R +++ b/R/LPJmLData.R @@ -39,7 +39,7 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter # If user has not supplied any parameters try to find a grid file in the # same directory as data. This throws an error if no suitable file is # found. - filename <- find_gridfile(private$.meta$._data_dir_) + filename <- find_varfile(private$.meta$._data_dir_, "grid") message( paste0( @@ -447,55 +447,3 @@ aggregate_array <- function(x, } data } - - -#' Search for a grid file in a directory -#' -#' Function to search for a grid file in a specific directory. -#' -#' @param searchdir Directory where to look for a grid file. -#' @return Character string with the file name of a grid file upon success. -#' Function fails if no matching grid file can be detected. -#' -#' @details This function looks for file names in `searchdir` that match the -#' `pattern` parameter in its [`list.files()`] call. Files of type "meta" are -#' preferred. Files of type "clm" are also accepted. The function returns an -#' error if no suitable file or multiple files are found. Otherwise, the file -#' name of the grid file including the full path is returned. -#' @noRd -find_gridfile <- function(searchdir) { - # The pattern will match any file name that starts with "grid*". - # Alternative stricter pattern: pattern = "^grid(\\.[[:alpha:]]{3,4})+$" - # This will only match file names "grid.*", where * is one or two file - # extensions with 3 or 4 characters, e.g. "grid.bin" or "grid.bin.json". - grid_files <- list.files( - path = searchdir, - pattern = "^grid", - full.names = TRUE - ) - if (length(grid_files) > 0) { - grid_types <- sapply(grid_files, detect_io_type) # nolint:undesirable_function_linter. - # Prefer "meta" file_type if present - if (length(which(grid_types == "meta")) == 1) { - filename <- grid_files[match("meta", grid_types)] - } else if (length(which(grid_types == "clm")) == 1) { - # Second priority "clm" file_type - filename <- grid_files[match("clm", grid_types)] - } else { - # Stop if either multiple files per file type or not the right type have - # been detected - stop( - "Cannot detect grid file automatically.\n", - "$add_grid has to be called supplying parameters as for read_io." - ) - } - } else { - # Stop if no file name matching pattern detected - stop( - "Cannot detect grid file automatically.\n", - "$add_grid has to be called supplying parameters as for read_io." - ) - } - - filename -} diff --git a/R/find_varfile.R b/R/find_varfile.R new file mode 100644 index 0000000..89671e6 --- /dev/null +++ b/R/find_varfile.R @@ -0,0 +1,82 @@ +#' Search for a variable file in a directory +#' +#' Function to search for a file containing a specific variable in a specific +#' directory. +#' +#' @param searchdir Directory where to look for the variable file. +#' @param variable Single character string containing the variable to search for +#' @param strict Boolean. If set to `TRUE`, file must be named "variable.**", +#' where "**" is one or two file extensions with 3 or 4 characters, e.g. +#' "grid.bin.json" if `variable = "grid"`. If set to `FALSE`, the function +#' will first try to match the strict pattern. If unsuccessful, any filename +#' that starts with "variable" will be matched. +#' @return Character string with the file name of a matched file, including the +#' full path. +#' +#' @details This function looks for file names in `searchdir` that match the +#' `pattern` parameter in its [`list.files()`] call. Files of type "meta" are +#' preferred. Files of type "clm" are also accepted. The function returns an +#' error if no suitable file or multiple files are found. +#' @export +find_varfile <- function(searchdir, variable = "grid", strict = FALSE) { + if (length(variable) != 1 || !is.character(variable)) { + stop(col_var("variable"), " must be a single character string") + } + # This will only match file names "variable.*", where * is one or two file + # extensions with 3 or 4 characters, e.g. "grid.bin" or "grid.bin.json". + var_files <- list.files( + path = searchdir, + pattern = paste0("^", variable, "(\\.[[:alpha:]]{3,4})+$"), + full.names = TRUE + ) + if (length(var_files) > 0) { + var_types <- sapply(var_files, detect_io_type) # nolint:undesirable_function_linter. + # Prefer "meta" file_type if present + if (length(which(var_types == "meta")) == 1) { + filename <- var_files[match("meta", var_types)] + } else if (length(which(var_types == "clm")) == 1) { + # Second priority "clm" file_type + filename <- var_files[match("clm", var_types)] + } else if (strict) { + # Stop if either multiple files per file type or not the right type have + # been detected + stop( + "Cannot detect ", col_var(variable), " file automatically." + ) + } + } else if (strict) { + # Stop if no file name matching pattern detected + stop( + "Cannot detect ", col_var(variable), " file automatically." + ) + } else { + # Less strict pattern matching any file name that starts with "grid*". + var_files <- list.files( + path = searchdir, + pattern = paste0("^", variable), + full.names = TRUE + ) + if (length(var_files) > 0) { + var_types <- sapply(var_files, detect_io_type) # nolint:undesirable_function_linter. + # Prefer "meta" file_type if present + if (length(which(var_types == "meta")) == 1) { + filename <- var_files[match("meta", var_types)] + } else if (length(which(var_types == "clm")) == 1) { + # Second priority "clm" file_type + filename <- var_files[match("clm", var_types)] + } else { + # Stop if either multiple files per file type or not the right type have + # been detected + stop( + "Cannot detect ", col_var(variable), " file automatically." + ) + } + } else { + # Stop if no file name matching pattern detected + stop( + "Cannot detect ", col_var(variable), " file automatically." + ) + } + } + filename +} diff --git a/README.md b/README.md index a2ce345..3360bc7 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Toolkit for Basic LPJmL Handling -R package **lpjmlkit**, version **1.5.0** +R package **lpjmlkit**, version **1.6.0** [![CRAN status](https://www.r-pkg.org/badges/version/lpjmlkit)](https://cran.r-project.org/package=lpjmlkit) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.7773134.svg)](https://doi.org/10.5281/zenodo.7773134) [![R build status](https://github.com/PIK-LPJmL/lpjmlkit/workflows/check/badge.svg)](https://github.com/PIK-LPJmL/lpjmlkit/actions) [![codecov](https://codecov.io/gh/PIK-LPJmL/lpjmlkit/branch/master/graph/badge.svg)](https://app.codecov.io/gh/PIK-LPJmL/lpjmlkit) [![r-universe](https://pik-piam.r-universe.dev/badges/lpjmlkit)](https://pik-piam.r-universe.dev/builds) @@ -76,7 +76,7 @@ In case of questions / problems please contact Jannes Breier . +Breier J, Ostberg S, Wirth S, Minoli S, Stenzel F, Müller C (2024). _lpjmlkit: Toolkit for Basic LPJmL Handling_. doi: 10.5281/zenodo.7773134 (URL: https://doi.org/10.5281/zenodo.7773134), R package version 1.6.0, . A BibTeX entry for LaTeX users is @@ -85,7 +85,7 @@ A BibTeX entry for LaTeX users is title = {lpjmlkit: Toolkit for Basic LPJmL Handling}, author = {Jannes Breier and Sebastian Ostberg and Stephen Björn Wirth and Sara Minoli and Fabian Stenzel and Christoph Müller}, year = {2024}, - note = {R package version 1.5.0}, + note = {R package version 1.6.0}, doi = {10.5281/zenodo.7773134}, url = {https://github.com/PIK-LPJmL/lpjmlkit}, } diff --git a/man/find_varfile.Rd b/man/find_varfile.Rd new file mode 100644 index 0000000..0b96aa0 --- /dev/null +++ b/man/find_varfile.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/find_varfile.R +\name{find_varfile} +\alias{find_varfile} +\title{Search for a variable file in a directory} +\usage{ +find_varfile(searchdir, variable = "grid", strict = FALSE) +} +\arguments{ +\item{searchdir}{Directory where to look for the variable file.} + +\item{variable}{Single character string containing the variable to search for} + +\item{strict}{Boolean. If set to \code{TRUE}, file must be named "variable.\strong{", +where "}" is one or two file extensions with 3 or 4 characters, e.g. +"grid.bin.json" if \code{variable = "grid"}. If set to \code{FALSE}, the function +will first try to match the strict pattern. If unsuccessful, any filename +that starts with "variable" will be matched.} +} +\value{ +Character string with the file name of a matched file, including the +full path. +} +\description{ +Function to search for a file containing a specific variable in a specific +directory. +} +\details{ +This function looks for file names in \code{searchdir} that match the +\code{pattern} parameter in its \code{\link[=list.files]{list.files()}} call. Files of type "meta" are +preferred. Files of type "clm" are also accepted. The function returns an +error if no suitable file or multiple files are found. +} diff --git a/tests/testthat/test-LPJmLData.R b/tests/testthat/test-LPJmLData.R index f8a6c32..b7cb83a 100644 --- a/tests/testthat/test-LPJmLData.R +++ b/tests/testthat/test-LPJmLData.R @@ -192,22 +192,6 @@ test_that("test print method", { ) }) -test_that("test find_gridfile", { - - # grid file in directory matching search pattern - expect_match( - find_gridfile("../testdata/output"), - "testdata/output" - ) - - # Error due to missing grid file - expect_error( - find_gridfile("."), - "Cannot detect grid file automatically" - ) - -}) - test_that("LPJmLData initialisation", { # Meta data must be LPJmLMetaData object expect_error( diff --git a/tests/testthat/test-find_varfile.R b/tests/testthat/test-find_varfile.R new file mode 100644 index 0000000..79b6b64 --- /dev/null +++ b/tests/testthat/test-find_varfile.R @@ -0,0 +1,16 @@ +test_that("test find_varfile", { + + # grid file in directory matching search pattern + expect_match( + find_varfile("../testdata/output", "grid"), + "testdata/output/grid.bin.json" + ) + + # Error due to missing grid file + expect_error( + find_varfile(".", "grid"), + "Cannot detect grid file automatically" + ) + +}) +