diff --git a/.buildlibrary b/.buildlibrary index de5c8c0..4ca1923 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '2814724' +ValidationKey: '2978850' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 243f46a..62f13da 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -3,7 +3,7 @@ exclude: '^tests/testthat/_snaps/.*$' repos: - repo: https://github.com/pre-commit/pre-commit-hooks - rev: v4.5.0 + rev: 2c9f875913ee60ca25ce70243dc24d5b6415598c # frozen: v4.6.0 hooks: - id: check-case-conflict - id: check-json @@ -15,7 +15,7 @@ repos: - id: mixed-line-ending - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.0 + rev: 7910e0323d7213f34275a7a562b9ef0fde8ce1b9 # frozen: v0.4.2 hooks: - id: parsable-R - id: deps-in-desc diff --git a/CITATION.cff b/CITATION.cff index a7cbb39..6d0af6c 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.4.2 -date-released: '2024-04-09' +version: 1.5.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 the Potsdam Institute for Climate Impact Research (PIK). It provides functions for diff --git a/DESCRIPTION b/DESCRIPTION index 13e69b1..9c97943 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: lpjmlkit Type: Package Title: Toolkit for Basic LPJmL Handling -Version: 1.4.2 +Version: 1.5.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")), @@ -54,4 +54,4 @@ Suggests: sf Config/testthat/edition: 3 VignetteBuilder: knitr -Date: 2024-04-09 +Date: 2024-05-16 diff --git a/R/read_io.R b/R/read_io.R index 57293d9..26c7529 100644 --- a/R/read_io.R +++ b/R/read_io.R @@ -318,23 +318,26 @@ read_io <- function( # nolint:cyclocomp_linter. # warnings should have been triggered in read_io_metadata already. file_header <- meta_data$as_header(silent = TRUE) - # Check if file is an LPJDAMS input file, which has a different format that is - # not supported by this function. TODO: Implement drop-in function for LPJDAMS - # input. + # Check file size + # Check if file is an LPJDAMS input file, which has a different format. if (get_header_item(file_header, "name") == "LPJDAMS") { - stop( - "This function currently does not support reading LPJDAMS input files." + # Hardcoded size of 4 and number of bands + expected_filesize <- unname( + get_header_item(file_header, "ncell") * + length(band_names_reservoir) * + get_header_item(file_header, "nstep") * + get_header_item(file_header, "nyear") * + 4 + start_offset + ) + } else { + expected_filesize <- unname( + get_header_item(file_header, "ncell") * + get_header_item(file_header, "nbands") * + get_header_item(file_header, "nstep") * + get_header_item(file_header, "nyear") * + get_datatype(file_header)$size + start_offset ) } - - # Check file size - expected_filesize <- unname( - get_header_item(file_header, "ncell") * - get_header_item(file_header, "nbands") * - get_header_item(file_header, "nstep") * - get_header_item(file_header, "nyear") * - get_datatype(file_header)$size + start_offset - ) if (file.size(filename) != expected_filesize) { stop( "Unexpected file size (", file.size(filename), " bytes) of ", filename, @@ -360,7 +363,11 @@ read_io <- function( # nolint:cyclocomp_linter. } # Read data from binary file - file_data <- read_io_data(filename, meta_data, subset, silent) + if (get_header_item(file_header, "name") == "LPJDAMS") { + file_data <- read_io_reservoir(filename, meta_data, subset, silent) + } else { + file_data <- read_io_data(filename, meta_data, subset, silent) + } # Update meta_data based on subset if (!is.null(subset$year) && is.numeric(subset$year)) { @@ -717,7 +724,10 @@ read_io_data <- function( meta_data$band_names, seq_len(default(meta_data$nbands, 1)) ) - cell_dimnames <- seq(default(meta_data$firstcell, 0), length.out = meta_data$ncell) + cell_dimnames <- seq( + default(meta_data$firstcell, 0), + length.out = meta_data$ncell + ) dimnames(year_data) <- switch( default(meta_data$order, "cellyear"), @@ -736,11 +746,10 @@ read_io_data <- function( ) # Convert to read_band_order and apply subsetting along bands or cells - index <- which(!names(subset) %in% c("day", "month", "year", "time")) - year_data <- aperm(year_data, perm = read_band_order) # Apply any subsetting along bands or cells + index <- which(!names(subset) %in% c("day", "month", "year", "time")) year_data <- subset_array( year_data, subset[index], diff --git a/R/read_io_reservoir.R b/R/read_io_reservoir.R new file mode 100644 index 0000000..1620429 --- /dev/null +++ b/R/read_io_reservoir.R @@ -0,0 +1,150 @@ +# Internal function to read reservoir input file. Called by read_io(). +read_io_reservoir <- function(filename, meta_data, subset, silent) { + if (is.null(meta_data$nbands) || meta_data$nbands != length(band_names_reservoir)) { + stop( + "Invalid number of bands ", default(meta_data$nbands, 1), + " in reservoir file ", filename, ". Expected ", + length(band_names_reservoir), "." + ) + } + if (!is.null(meta_data$nyear) && meta_data$nyear != 1) { + stop( + "Invalid number of years ", meta_data$nyear, + " in reservoir file ", filename, ". Expected 1." + ) + } + if (!is.null(meta_data$nstep) && meta_data$nstep != 1) { + stop( + "Invalid number of time steps per year ", meta_data$nstep, + " in reservoir file ", filename, ". Expected 1." + ) + } + if (!silent) { + message( + "Note: Reservoir file detected, which uses a special file structure. ", + "Time axis in returned LPJmLData object is not meaningful." + ) + } + if (!silent && !is.null(meta_data$band_names) && + !all(tolower(meta_data$band_names) == tolower(band_names_reservoir)) + ) { + warning( + "Supplied band_names attribute c(", + toString(dQuote(meta_data$band_names, q = FALSE)), + ") does not seem to match implemented reservoir file structure. ", + "Implemented band order: c(", + toString(dQuote(band_names_reservoir, q = FALSE)), ").", + immediate. = TRUE, call. = FALSE + ) + } + # Determine all years in the file + years <- seq( + from = default(meta_data$firstyear, 1901), + by = default(meta_data$timestep, 1), + length.out = default(meta_data$nyear, 1) + ) + # Subsetting by year does not work for restart files + if ("year" %in% names(subset)) { + warning( + "Subsetting by year not possible for reservoir files", + immediate. = TRUE, call. = FALSE + ) + } + + # Open binary file connection + file_connection <- file(filename, "rb") + # Ensure that file connection is closed even if function is terminated with an + # error + on.exit(if (exists("file_connection")) close(file_connection)) # nolint:undesirable_function_linter. + + # Dimension order during reading. Note: Must be 3 dimensions in total, with + # "time" being last dimension for code below to work. + read_band_order <- c("cell", "band", "time") + + # Seek to start position of data + seek(file_connection, default(meta_data$offset, 0)) + + year_data <- array( + dim = switch( + default(meta_data$order, "cellyear"), + cellyear = c( + band = unname(default(meta_data$nbands, 1)), + time = unname(default(meta_data$nstep, 1)), + cell = unname(meta_data$ncell) + ), + yearcell = stop("Order yearcell not supported"), + cellindex = stop("Order cellindex not supported"), + cellseq = stop("Order cellindex not supported") + ) + ) + + # Assign dimension names to array. + band_names <- default( + meta_data$band_names, + band_names_reservoir + ) + cell_dimnames <- seq( + default(meta_data$firstcell, 0), + length.out = meta_data$ncell + ) + dimnames(year_data) <- switch( + default(meta_data$order, "cellyear"), + cellyear = list( # order 1 + band = band_names, + time = NULL, # Assign dates later + cell = cell_dimnames + ), + yearcell = stop("Order yearcell not supported"), # order 2 + cellindex = stop("Order cellindex not supported"), # order 3 + cellseq = stop("Order cellindex not supported") # order 4 + ) + # Read data + for (cell in seq_len(meta_data$ncell)) { + year_data[1, 1, cell] <- readBin( + file_connection, + n = 1, + what = integer(), + size = 4, + endian = ifelse(meta_data$bigendian, "big", "little") + ) + year_data[c(2, 3), 1, cell] <- readBin( + file_connection, + n = 2, + what = double(), + size = 4, + endian = ifelse(meta_data$bigendian, "big", "little") + ) + year_data[seq(4, 10), 1, cell] <- readBin( + file_connection, + n = 7, + what = integer(), + size = 4, + endian = ifelse(meta_data$bigendian, "big", "little") + ) + } + # Close binary file connection + close(file_connection) + # Delete file_connection to prevent triggering on.exit expression + rm(file_connection) + + # Convert to read_band_order and apply subsetting along bands or cells + year_data <- aperm(year_data, perm = read_band_order) + + # Apply any subsetting along bands or cells + index <- which(!names(subset) %in% c("day", "month", "year", "time")) + year_data <- subset_array( + year_data, + subset[index], + drop = FALSE, + silent = silent + ) + + # Create and assign time dimension names + time_dimnames <- create_time_names( + nstep = default(meta_data$nstep, 1), + years = years + ) + dimnames(year_data)$time <- time_dimnames + + year_data +} diff --git a/R/utils.R b/R/utils.R index 6294616..3f201c7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -180,6 +180,12 @@ is_os_windows <- function() { # file_type options supported by read_io supported_types <- c("raw", "clm", "meta") +# band_names in reservoir files (special LPJmL file type) +band_names_reservoir <- c( + "year", "capacity", "area", "inst_cap", "height", + paste0("purpose", seq_len(5)) +) + # Avoid note for "."... utils::globalVariables(".") # nolint:undesirable_function_linter diff --git a/README.md b/README.md index 2480449..a2ce345 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Toolkit for Basic LPJmL Handling -R package **lpjmlkit**, version **1.4.2** +R package **lpjmlkit**, version **1.5.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.5.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.4.2}, + note = {R package version 1.5.0}, doi = {10.5281/zenodo.7773134}, url = {https://github.com/PIK-LPJmL/lpjmlkit}, } diff --git a/tests/testdata/input/reservoir.bin b/tests/testdata/input/reservoir.bin new file mode 100644 index 0000000..b3b7235 Binary files /dev/null and b/tests/testdata/input/reservoir.bin differ diff --git a/tests/testthat/test-read_io.R b/tests/testthat/test-read_io.R index da872f0..ce5f653 100644 --- a/tests/testthat/test-read_io.R +++ b/tests/testthat/test-read_io.R @@ -253,3 +253,17 @@ test_that("read_io messages", { ) file.remove(tmp_filename) }) + +test_that("read_io for reservoir file", { + # Read in dummy reservoir file should be successful + expect_message( + testres <- read_io("../testdata/input/reservoir.bin"), + "Reservoir file detected" + ) + + # Grid file cannot be read as reservoir + expect_error( + read_io("../testdata/output/grid.bin.json", name = "LPJDAMS"), + "Expected size" + ) +})