Skip to content

Commit 1c65fcc

Browse files
jnnsbrrjnnsbrr
committed
Merge branch 'implement_reservoir' into 'master'
implement support for LPJmL reservoir input files in read_io See merge request lpjml/lpjmlkit!95
2 parents c42a8f8 + d447a5c commit 1c65fcc

File tree

10 files changed

+207
-28
lines changed

10 files changed

+207
-28
lines changed

‎.buildlibrary

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
ValidationKey: '2814724'
1+
ValidationKey: '2978850'
22
AutocreateReadme: yes
33
AcceptedWarnings:
44
- 'Warning: package ''.*'' was built under R version'

‎.pre-commit-config.yaml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
exclude: '^tests/testthat/_snaps/.*$'
44
repos:
55
- repo: https://github.com/pre-commit/pre-commit-hooks
6-
rev: v4.5.0
6+
rev: 2c9f875913ee60ca25ce70243dc24d5b6415598c # frozen: v4.6.0
77
hooks:
88
- id: check-case-conflict
99
- id: check-json
@@ -15,7 +15,7 @@ repos:
1515
- id: mixed-line-ending
1616

1717
- repo: https://github.com/lorenzwalthert/precommit
18-
rev: v0.4.0
18+
rev: 7910e0323d7213f34275a7a562b9ef0fde8ce1b9 # frozen: v0.4.2
1919
hooks:
2020
- id: parsable-R
2121
- id: deps-in-desc

‎CITATION.cff

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@ cff-version: 1.2.0
22
message: If you use this software, please cite it using the metadata from this file.
33
type: software
44
title: 'lpjmlkit: Toolkit for Basic LPJmL Handling'
5-
version: 1.4.2
6-
date-released: '2024-04-09'
5+
version: 1.5.0
6+
date-released: '2024-05-16'
77
abstract: A collection of basic functions to facilitate the work with the Dynamic
88
Global Vegetation Model (DGVM) Lund-Potsdam-Jena managed Land (LPJmL) hosted at
99
the Potsdam Institute for Climate Impact Research (PIK). It provides functions for

‎DESCRIPTION

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: lpjmlkit
22
Type: Package
33
Title: Toolkit for Basic LPJmL Handling
4-
Version: 1.4.2
4+
Version: 1.5.0
55
Authors@R: c(
66
person("Jannes", "Breier", , "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9055-6904")),
77
person("Sebastian","Ostberg", , "[email protected]", role = "aut", comment = c(ORCID = "0000-0002-2368-7015")),
@@ -54,4 +54,4 @@ Suggests:
5454
sf
5555
Config/testthat/edition: 3
5656
VignetteBuilder: knitr
57-
Date: 2024-04-09
57+
Date: 2024-05-16

‎R/read_io.R

Lines changed: 27 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -318,23 +318,26 @@ read_io <- function( # nolint:cyclocomp_linter.
318318
# warnings should have been triggered in read_io_metadata already.
319319
file_header <- meta_data$as_header(silent = TRUE)
320320

321-
# Check if file is an LPJDAMS input file, which has a different format that is
322-
# not supported by this function. TODO: Implement drop-in function for LPJDAMS
323-
# input.
321+
# Check file size
322+
# Check if file is an LPJDAMS input file, which has a different format.
324323
if (get_header_item(file_header, "name") == "LPJDAMS") {
325-
stop(
326-
"This function currently does not support reading LPJDAMS input files."
324+
# Hardcoded size of 4 and number of bands
325+
expected_filesize <- unname(
326+
get_header_item(file_header, "ncell") *
327+
length(band_names_reservoir) *
328+
get_header_item(file_header, "nstep") *
329+
get_header_item(file_header, "nyear") *
330+
4 + start_offset
331+
)
332+
} else {
333+
expected_filesize <- unname(
334+
get_header_item(file_header, "ncell") *
335+
get_header_item(file_header, "nbands") *
336+
get_header_item(file_header, "nstep") *
337+
get_header_item(file_header, "nyear") *
338+
get_datatype(file_header)$size + start_offset
327339
)
328340
}
329-
330-
# Check file size
331-
expected_filesize <- unname(
332-
get_header_item(file_header, "ncell") *
333-
get_header_item(file_header, "nbands") *
334-
get_header_item(file_header, "nstep") *
335-
get_header_item(file_header, "nyear") *
336-
get_datatype(file_header)$size + start_offset
337-
)
338341
if (file.size(filename) != expected_filesize) {
339342
stop(
340343
"Unexpected file size (", file.size(filename), " bytes) of ", filename,
@@ -360,7 +363,11 @@ read_io <- function( # nolint:cyclocomp_linter.
360363
}
361364

362365
# Read data from binary file
363-
file_data <- read_io_data(filename, meta_data, subset, silent)
366+
if (get_header_item(file_header, "name") == "LPJDAMS") {
367+
file_data <- read_io_reservoir(filename, meta_data, subset, silent)
368+
} else {
369+
file_data <- read_io_data(filename, meta_data, subset, silent)
370+
}
364371

365372
# Update meta_data based on subset
366373
if (!is.null(subset$year) && is.numeric(subset$year)) {
@@ -717,7 +724,10 @@ read_io_data <- function(
717724
meta_data$band_names, seq_len(default(meta_data$nbands, 1))
718725
)
719726

720-
cell_dimnames <- seq(default(meta_data$firstcell, 0), length.out = meta_data$ncell)
727+
cell_dimnames <- seq(
728+
default(meta_data$firstcell, 0),
729+
length.out = meta_data$ncell
730+
)
721731

722732
dimnames(year_data) <- switch(
723733
default(meta_data$order, "cellyear"),
@@ -736,11 +746,10 @@ read_io_data <- function(
736746
)
737747

738748
# Convert to read_band_order and apply subsetting along bands or cells
739-
index <- which(!names(subset) %in% c("day", "month", "year", "time"))
740-
741749
year_data <- aperm(year_data, perm = read_band_order)
742750

743751
# Apply any subsetting along bands or cells
752+
index <- which(!names(subset) %in% c("day", "month", "year", "time"))
744753
year_data <- subset_array(
745754
year_data,
746755
subset[index],

‎R/read_io_reservoir.R

Lines changed: 150 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,150 @@
1+
# Internal function to read reservoir input file. Called by read_io().
2+
read_io_reservoir <- function(filename, meta_data, subset, silent) {
3+
if (is.null(meta_data$nbands) || meta_data$nbands != length(band_names_reservoir)) {
4+
stop(
5+
"Invalid number of bands ", default(meta_data$nbands, 1),
6+
" in reservoir file ", filename, ". Expected ",
7+
length(band_names_reservoir), "."
8+
)
9+
}
10+
if (!is.null(meta_data$nyear) && meta_data$nyear != 1) {
11+
stop(
12+
"Invalid number of years ", meta_data$nyear,
13+
" in reservoir file ", filename, ". Expected 1."
14+
)
15+
}
16+
if (!is.null(meta_data$nstep) && meta_data$nstep != 1) {
17+
stop(
18+
"Invalid number of time steps per year ", meta_data$nstep,
19+
" in reservoir file ", filename, ". Expected 1."
20+
)
21+
}
22+
if (!silent) {
23+
message(
24+
"Note: Reservoir file detected, which uses a special file structure. ",
25+
"Time axis in returned LPJmLData object is not meaningful."
26+
)
27+
}
28+
if (!silent && !is.null(meta_data$band_names) &&
29+
!all(tolower(meta_data$band_names) == tolower(band_names_reservoir))
30+
) {
31+
warning(
32+
"Supplied band_names attribute c(",
33+
toString(dQuote(meta_data$band_names, q = FALSE)),
34+
") does not seem to match implemented reservoir file structure. ",
35+
"Implemented band order: c(",
36+
toString(dQuote(band_names_reservoir, q = FALSE)), ").",
37+
immediate. = TRUE, call. = FALSE
38+
)
39+
}
40+
# Determine all years in the file
41+
years <- seq(
42+
from = default(meta_data$firstyear, 1901),
43+
by = default(meta_data$timestep, 1),
44+
length.out = default(meta_data$nyear, 1)
45+
)
46+
# Subsetting by year does not work for restart files
47+
if ("year" %in% names(subset)) {
48+
warning(
49+
"Subsetting by year not possible for reservoir files",
50+
immediate. = TRUE, call. = FALSE
51+
)
52+
}
53+
54+
# Open binary file connection
55+
file_connection <- file(filename, "rb")
56+
# Ensure that file connection is closed even if function is terminated with an
57+
# error
58+
on.exit(if (exists("file_connection")) close(file_connection)) # nolint:undesirable_function_linter.
59+
60+
# Dimension order during reading. Note: Must be 3 dimensions in total, with
61+
# "time" being last dimension for code below to work.
62+
read_band_order <- c("cell", "band", "time")
63+
64+
# Seek to start position of data
65+
seek(file_connection, default(meta_data$offset, 0))
66+
67+
year_data <- array(
68+
dim = switch(
69+
default(meta_data$order, "cellyear"),
70+
cellyear = c(
71+
band = unname(default(meta_data$nbands, 1)),
72+
time = unname(default(meta_data$nstep, 1)),
73+
cell = unname(meta_data$ncell)
74+
),
75+
yearcell = stop("Order yearcell not supported"),
76+
cellindex = stop("Order cellindex not supported"),
77+
cellseq = stop("Order cellindex not supported")
78+
)
79+
)
80+
81+
# Assign dimension names to array.
82+
band_names <- default(
83+
meta_data$band_names,
84+
band_names_reservoir
85+
)
86+
cell_dimnames <- seq(
87+
default(meta_data$firstcell, 0),
88+
length.out = meta_data$ncell
89+
)
90+
dimnames(year_data) <- switch(
91+
default(meta_data$order, "cellyear"),
92+
cellyear = list( # order 1
93+
band = band_names,
94+
time = NULL, # Assign dates later
95+
cell = cell_dimnames
96+
),
97+
yearcell = stop("Order yearcell not supported"), # order 2
98+
cellindex = stop("Order cellindex not supported"), # order 3
99+
cellseq = stop("Order cellindex not supported") # order 4
100+
)
101+
# Read data
102+
for (cell in seq_len(meta_data$ncell)) {
103+
year_data[1, 1, cell] <- readBin(
104+
file_connection,
105+
n = 1,
106+
what = integer(),
107+
size = 4,
108+
endian = ifelse(meta_data$bigendian, "big", "little")
109+
)
110+
year_data[c(2, 3), 1, cell] <- readBin(
111+
file_connection,
112+
n = 2,
113+
what = double(),
114+
size = 4,
115+
endian = ifelse(meta_data$bigendian, "big", "little")
116+
)
117+
year_data[seq(4, 10), 1, cell] <- readBin(
118+
file_connection,
119+
n = 7,
120+
what = integer(),
121+
size = 4,
122+
endian = ifelse(meta_data$bigendian, "big", "little")
123+
)
124+
}
125+
# Close binary file connection
126+
close(file_connection)
127+
# Delete file_connection to prevent triggering on.exit expression
128+
rm(file_connection)
129+
130+
# Convert to read_band_order and apply subsetting along bands or cells
131+
year_data <- aperm(year_data, perm = read_band_order)
132+
133+
# Apply any subsetting along bands or cells
134+
index <- which(!names(subset) %in% c("day", "month", "year", "time"))
135+
year_data <- subset_array(
136+
year_data,
137+
subset[index],
138+
drop = FALSE,
139+
silent = silent
140+
)
141+
142+
# Create and assign time dimension names
143+
time_dimnames <- create_time_names(
144+
nstep = default(meta_data$nstep, 1),
145+
years = years
146+
)
147+
dimnames(year_data)$time <- time_dimnames
148+
149+
year_data
150+
}

‎R/utils.R

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -180,6 +180,12 @@ is_os_windows <- function() {
180180
# file_type options supported by read_io
181181
supported_types <- c("raw", "clm", "meta")
182182

183+
# band_names in reservoir files (special LPJmL file type)
184+
band_names_reservoir <- c(
185+
"year", "capacity", "area", "inst_cap", "height",
186+
paste0("purpose", seq_len(5))
187+
)
188+
183189

184190
# Avoid note for "."...
185191
utils::globalVariables(".") # nolint:undesirable_function_linter

‎README.md

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
# Toolkit for Basic LPJmL Handling <a href=''><img src='inst/img/logo.png' align='right' height='139' /></a>
22

3-
R package **lpjmlkit**, version **1.4.2**
3+
R package **lpjmlkit**, version **1.5.0**
44

55
[![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)
66

@@ -76,7 +76,7 @@ In case of questions / problems please contact Jannes Breier <jannesbr@pik-potsd
7676

7777
To cite package **lpjmlkit** in publications use:
7878

79-
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.4.2, <URL: https://github.com/PIK-LPJmL/lpjmlkit>.
79+
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, <URL: https://github.com/PIK-LPJmL/lpjmlkit>.
8080

8181
A BibTeX entry for LaTeX users is
8282

@@ -85,7 +85,7 @@ A BibTeX entry for LaTeX users is
8585
title = {lpjmlkit: Toolkit for Basic LPJmL Handling},
8686
author = {Jannes Breier and Sebastian Ostberg and Stephen Björn Wirth and Sara Minoli and Fabian Stenzel and Christoph Müller},
8787
year = {2024},
88-
note = {R package version 1.4.2},
88+
note = {R package version 1.5.0},
8989
doi = {10.5281/zenodo.7773134},
9090
url = {https://github.com/PIK-LPJmL/lpjmlkit},
9191
}

‎tests/testdata/input/reservoir.bin

163 Bytes
Binary file not shown.

‎tests/testthat/test-read_io.R

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -253,3 +253,17 @@ test_that("read_io messages", {
253253
)
254254
file.remove(tmp_filename)
255255
})
256+
257+
test_that("read_io for reservoir file", {
258+
# Read in dummy reservoir file should be successful
259+
expect_message(
260+
testres <- read_io("../testdata/input/reservoir.bin"),
261+
"Reservoir file detected"
262+
)
263+
264+
# Grid file cannot be read as reservoir
265+
expect_error(
266+
read_io("../testdata/output/grid.bin.json", name = "LPJDAMS"),
267+
"Expected size"
268+
)
269+
})

0 commit comments

Comments
 (0)