Merge branch 'encoding_fixes' into 'master'

fix encoding problems with stringi, fix test failures with file.copy/remove...

See merge request lpjml/lpjmlkit!80

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '2267568'
+ValidationKey: '2287233'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'

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

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", , "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9055-6904")),
     person("Sebastian","Ostberg", , "[email protected]", role = "aut", comment = c(ORCID = "0000-0002-2368-7015")),
@@ -41,16 +41,17 @@ Imports:
     rlang,
     withr,
     grDevices,
-    sf,
-    cli
+    cli,
+    stringi
 Suggests:
     rmarkdown,
     knitr,
     testthat (>= 3.0.0),
     terra,
     raster,
     reshape2,
-    maps
+    maps,
+    sf
 Config/testthat/edition: 3
 VignetteBuilder: knitr
-Date: 2023-07-10
+Date: 2023-07-11

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()

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,

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.

README.md

@@ -1,6 +1,6 @@
 # Toolkit for Basic LPJmL Handling <a href=''><img src='inst/img/logo.png' align='right' height='139' /></a>
 
-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 <jannesbr@pik-potsd
 
 To cite package **lpjmlkit** in publications use:
 
-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.6, <URL: https://github.com/PIK-LPJmL/lpjmlkit>.
+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, <URL: https://github.com/PIK-LPJmL/lpjmlkit>.
 
 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},
 }

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", {

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", {