diff --git a/.buildlibrary b/.buildlibrary index 15efc16..168c78a 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '2267568' +ValidationKey: '2287233' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index dd362d8..3ce8fec 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ 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.1.6 -date-released: '2023-07-10' +version: 1.1.7 +date-released: '2023-07-11' 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 the Potsdam Institute for Climate Impact Research (PIK). It provides functions for diff --git a/DESCRIPTION b/DESCRIPTION index 1597896..abdd464 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: lpjmlkit Type: Package Title: Toolkit for Basic LPJmL Handling -Version: 1.1.6 +Version: 1.1.7 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")), @@ -41,8 +41,8 @@ Imports: rlang, withr, grDevices, - sf, - cli + cli, + stringi Suggests: rmarkdown, knitr, @@ -50,7 +50,8 @@ Suggests: terra, raster, reshape2, - maps + maps, + sf Config/testthat/edition: 3 VignetteBuilder: knitr -Date: 2023-07-10 +Date: 2023-07-11 diff --git a/R/LPJmLData.R b/R/LPJmLData.R index 25def6a..2882975 100644 --- a/R/LPJmLData.R +++ b/R/LPJmLData.R @@ -204,7 +204,7 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter print = function() { # Print meta data - cat(paste0(cli::style_bold(col_var("$meta |>"))[1], "\n")) + cat(paste0(bold_head(col_var("$meta |>"))[1], "\n")) private$.meta$print(all = FALSE, spaces = " .") # Not all meta data are printed @@ -214,11 +214,11 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter # Print grid only if available if (!is.null(private$.grid)) { - cat(col_var(paste0(cli::style_bold("$grid")[1], " ...", "\n"))) + cat(col_var(paste0(bold_head("$grid")[1], " ...", "\n"))) } # Print data attribute - cat(cli::style_bold("$data |>\n")[1]) + cat(bold_head("$data |>\n")[1]) # Dimnames dim_names <- self$dimnames() diff --git a/R/detect_io_type.R b/R/detect_io_type.R index b58a8a6..9b820d4 100644 --- a/R/detect_io_type.R +++ b/R/detect_io_type.R @@ -33,14 +33,20 @@ detect_io_type <- function(filename) { # First check for "clm". The file header should always start with "LPJ". if (length(file_check) > 3 && all( - rawToChar(utils::head(file_check, 3), multiple = TRUE) == c("L", "P", "J") + stringi::stri_encode( + rawToChar(utils::head(file_check, 3), multiple = TRUE), + to = "UTF-8" + ) == c("L", "P", "J") )) { return("clm") } # Next, check for NetCDF format if ((length(file_check) > 3 && all( - rawToChar(utils::head(file_check, 3), multiple = TRUE) == + stringi::stri_encode( + rawToChar(utils::head(file_check, 3), multiple = TRUE), + to = "UTF-8" + ) == c("C", "D", "F") # Classic NetCDF format )) || (length(file_check) > 8 && all( utils::head(file_check, 8) == @@ -52,14 +58,18 @@ detect_io_type <- function(filename) { # Next, check if file contains only text. This could be JSON or other text # formats such as .csv or .dat files. if ( - all(grepl("[[:print:][:space:]]", rawToChar(file_check, multiple = TRUE))) + all(grepl("[[:print:][:space:]]", + stringi::stri_encode( + rawToChar(file_check, multiple = TRUE), to = "UTF-8") + ) + ) ) { # Check if the text file is a JSON file. JSON files normally start with "{". # Remove any white space at the beginning of the file. This will not detect # a JSON if file has > 10 bytes of white space or includes comments. first_char <- scan( - text = rawToChar(file_check), + text = stringi::stri_encode(rawToChar(file_check), to = "UTF-8"), what = "char", strip.white = TRUE, nmax = 1, diff --git a/R/utils.R b/R/utils.R index e3d571a..0981bc7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -67,19 +67,27 @@ names_recursively <- function(x) { } -# colorize variable name for messages, warning, stop +# colorize variable name for messages, warning, stop in blue col_var <- function(x) { cli::col_blue(x) } +# colorize notes in yellow col_note <- function(x) { cli::col_yellow(x) } +# colorize warnings and important strings in red col_warn <- function(x) { cli::col_red(x) } +# bold strings, especially for headers of messages +bold_head <- function(x) { + cli::style_bold(x) +} + + # Function to get gitlab commit hash of repository path. diff --git a/README.md b/README.md index d5deab2..b747b90 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Toolkit for Basic LPJmL Handling -R package **lpjmlkit**, version **1.1.6** +R package **lpjmlkit**, version **1.1.7** [![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 (2023). _lpjmlkit: Toolkit for Basic LPJmL Handling_. doi: 10.5281/zenodo.7773134 (URL: https://doi.org/10.5281/zenodo.7773134), R package version 1.1.7, . 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 = {2023}, - note = {R package version 1.1.6}, + note = {R package version 1.1.7}, doi = {10.5281/zenodo.7773134}, url = {https://github.com/PIK-LPJmL/lpjmlkit}, } diff --git a/tests/testthat/test-LPJmLData.R b/tests/testthat/test-LPJmLData.R index 4eb70ac..f8a6c32 100644 --- a/tests/testthat/test-LPJmLData.R +++ b/tests/testthat/test-LPJmLData.R @@ -193,36 +193,19 @@ test_that("test print method", { }) test_that("test find_gridfile", { - tmpdir <- tempfile("output") - dir.create(tmpdir, recursive = TRUE) - # No grid file at all in directory - expect_error( - find_gridfile(tmpdir), - "Cannot detect grid file automatically" - ) - file.copy( - "../testdata/output/pft_npp.clm", - file.path(tmpdir, "grid.clm") - ) - # clm file in directory matching search pattern - expect_equal( - find_gridfile(tmpdir), - file.path(tmpdir, "grid.clm") - ) - file.copy( - "../testdata/output/pft_npp.clm", - file.path(tmpdir, "grid2.clm") + + # grid file in directory matching search pattern + expect_match( + find_gridfile("../testdata/output"), + "testdata/output" ) - # Error due to two clm files present matching search pattern + + # Error due to missing grid file expect_error( - find_gridfile(tmpdir), + find_gridfile("."), "Cannot detect grid file automatically" ) - file.remove( - file.path(tmpdir, "grid.clm"), - file.path(tmpdir, "grid2.clm") - ) - file.remove(tmpdir) + }) test_that("LPJmLData initialisation", { diff --git a/tests/testthat/test-read_io.R b/tests/testthat/test-read_io.R index baa7092..da872f0 100644 --- a/tests/testthat/test-read_io.R +++ b/tests/testthat/test-read_io.R @@ -140,18 +140,6 @@ test_that("read_io errors", { ), "is empty after removal of NAs" ) - # Wrong file size - # Create temporary file with wrong size - tmp_filename <- tempfile("lpjmlkit") - file.copy("../testdata/output/pft_npp.clm", tmp_filename) - tmp_file <- file(tmp_filename, "ab") - writeBin(4, tmp_file) - close(tmp_file) - expect_error( - read_io(tmp_filename), - "Unexpected file size" - ) - file.remove(tmp_filename) # Invalid band_names (number does not match number of bands) expect_error( @@ -165,15 +153,6 @@ test_that("read_io errors", { ), "Provided band_names.+do not match number of bands in file" ) - # Unsupported LPJDAMS file - header <- read_header("../testdata/header_v4.clm") - header <- set_header_item(header, name = "LPJDAMS", verbose = FALSE) - write_header(tmp_filename, header) - expect_error( - read_io(tmp_filename), - "does not support reading LPJDAMS" - ) - file.remove(tmp_filename) # Invalid years expect_error( @@ -188,62 +167,6 @@ test_that("read_io errors", { read_io("../testdata/output/pft_npp.bin.json", subset = list(year = TRUE)), "Unsupported type.+provided as subset" ) - - # Missing format in meta file - tmp_filename <- tempfile("lpjmlkit") - writeLines("{ \"sim_name\" : \"Test\" }", tmp_filename) - expect_error( - read_io(tmp_filename), - "Missing 'format' in meta file" - ) - - # Unsupported format in meta file - writeLines("{ \"format\" : \"cdf\" }", tmp_filename) - expect_error( - read_io(tmp_filename), - "Format.+specified in meta file.*not supported" - ) - file.remove(tmp_filename) - - # Missing linked file - tmp_dirname <- tempfile("output") - dir.create(tmp_dirname, recursive = TRUE) - file.copy( - "../testdata/output/grid.bin.json", - file.path(tmp_dirname, "grid.bin.json") - ) - expect_error( - read_io(file.path(tmp_dirname, "grid.bin.json")), - "File.*linked in meta file does not exist" - ) - file.remove(file.path(tmp_dirname, "grid.bin.json")) - - # Relative path to linked file - meta_list <- as_list(read_meta("../testdata/output/grid.bin.json")) - tmp_filename1 <- tempfile("lpjmlkit") - file.copy("../testdata/output/grid.bin", tmp_filename1) - tmp_filename2 <- tempfile("lpjmlkit", tmpdir = tmp_dirname) - meta_list$filename <- file.path("..", basename(tmp_filename1)) - jsonlite::write_json( - x = meta_list, - path = tmp_filename2, - auto_unbox = TRUE, - pretty = TRUE, - null = "null", - digits = 10, - always_decimal = TRUE - ) - # Relative path to linked file is recognized, no error - expect_error( - output1 <- read_io(tmp_filename2), - NA - ) - file.remove(tmp_filename1, tmp_filename2) - file.remove(tmp_dirname) - - output2 <- read_io("../testdata/output/grid.bin.json") - expect_identical(output1$data, output2$data) - }) test_that("read_io warnings", {