diff --git a/.buildlibrary b/.buildlibrary index 70284d86..3fea746e 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '68453300' +ValidationKey: '68661600' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index d3b672ac..91aea41d 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: 'madrat: May All Data be Reproducible and Transparent (MADRaT) *' -version: 3.34.0 -date-released: '2026-02-11' +version: 3.35.0 +date-released: '2026-02-12' abstract: Provides a framework which should improve reproducibility and transparency in data processing. It provides functionality such as automatic meta data creation and management, rudimentary quality management, data caching, work-flow management diff --git a/DESCRIPTION b/DESCRIPTION index 0ed1559c..d2279d8f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: madrat Title: May All Data be Reproducible and Transparent (MADRaT) * -Version: 3.34.0 -Date: 2026-02-11 +Version: 3.35.0 +Date: 2026-02-12 Authors@R: c( person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = c("aut", "cre"), comment = c(affiliation = "Potsdam Institute for Climate Impact Research", ORCID = "0000-0002-4309-6431")), diff --git a/R/toolTimeSpline.R b/R/toolTimeSpline.R index 967d589f..3960c06f 100644 --- a/R/toolTimeSpline.R +++ b/R/toolTimeSpline.R @@ -3,7 +3,8 @@ #' Smooths a magclass time series using spline approximation with the given degrees #' of freedom. Optionally, specific years can be "pegged" (anchored) to stay close #' to their original values during smoothing. Anchoring is enforced by applying -#' high weights to those years. +#' high weights to those years. If a higher time resolution is desired, +#' the fitted spline can be evaluated at additional target years. #' #' @param x A magclass object. #' @param dof Degrees-of-freedom per 100 years (higher -> more degrees of freedom, @@ -12,23 +13,32 @@ #' anchor during smoothing; NULL for none (default). #' @param anchorFactor Numeric multiplier for anchor weights (default 10); #' larger values more strongly enforce pegging. +#' @param targetYears Integer vector of additional years at which the fitted spline +#' should be evaluated, enabling higher time resolution (default NULL, i.e. output +#' years equal input years). Output years are the sorted union of input and target years. +#' @param fillNA Logical. If TRUE, NA values are excluded from the spline fit and +#' then filled by predicting at those positions (default FALSE). +#' Otherwise, an error is thrown if NA values are present in the input. #' -#' @return A magclass object of the same shape, with each time series spline-smoothed. -#' @author Kristine Karstens, Felicitas Beier, Michael Crawford +#' @return A magclass object with each time series spline-smoothed. +#' If targetYears is not specified (NULL), the time dimension is unchanged. If targetYears is +#' given, the time dimension covers the sorted union of the original and target years. +#' @author Kristine Karstens, Felicitas Beier, Michael Crawford, Bennet Weiss #' @importFrom stats smooth.spline #' @export toolTimeSpline <- function(x, dof = 5, peggedYears = NULL, - anchorFactor = 10) { - + anchorFactor = 10, + targetYears = NULL, + fillNA = FALSE) { ## 1) Input checks if (!is.magpie(x)) { stop("Input is not a MAgPIE object, x has to be a MAgPIE object!") } - negative <- any(x < 0) + negative <- any(x < 0, na.rm = fillNA) ## 2) Time axis & df calculation years <- getYears(x, as.integer = TRUE) @@ -47,6 +57,14 @@ toolTimeSpline <- function(x, } dfValue <- timespan * dof / 100 + ## 2b) Determine output years + if (!is.null(targetYears)) { + targetYears <- as.integer(sub("^y", "", as.character(targetYears), ignore.case = TRUE)) + outputYears <- sort(union(years, targetYears)) + } else { + outputYears <- years + } + ## 3) Build weight vector if (is.null(peggedYears)) { # no anchors @@ -65,16 +83,18 @@ toolTimeSpline <- function(x, wts[years %in% peggedYearsAll] <- nyr * anchorFactor } - ## 4) Per-series spline (uses fit$y so no predict() call) + ## 4) Per-series spline tmpspline <- function(ts, df) { + # NA values are removed for fitting if fillNA = TRUE + ok <- if (fillNA) !is.na(ts) else rep(TRUE, nyr) fit <- stats::smooth.spline( - x = years, - y = ts, - w = wts, + x = years[ok], + y = ts[ok], + w = wts[ok], df = df, control.spar = list(high = 2) ) - fit$y + return(stats::predict(fit, x = outputYears)$y) } ## 5) Apply over time-series (dim 2 inner) @@ -82,7 +102,7 @@ toolTimeSpline <- function(x, arrOut <- apply(arrIn, c(1, 3), tmpspline, df = dfValue) ## 6) Reconstruct magpie object - dimnames(arrOut)[[1]] <- getYears(x) + dimnames(arrOut)[[1]] <- paste0("y", outputYears) names(dimnames(arrOut))[1] <- getSets(x, fulldim = FALSE)[2] out <- as.magpie(arrOut, spatial = 2, temporal = 1) diff --git a/README.md b/README.md index ff0d4420..5ff6755c 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # May All Data be Reproducible and Transparent (MADRaT) * -R package **madrat**, version **3.34.0** +R package **madrat**, version **3.35.0** [![CRAN status](https://www.r-pkg.org/badges/version/madrat)](https://cran.r-project.org/package=madrat) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1115490.svg)](https://doi.org/10.5281/zenodo.1115490) [![R build status](https://github.com/pik-piam/madrat/workflows/check/badge.svg)](https://github.com/pik-piam/madrat/actions) [![codecov](https://codecov.io/gh/pik-piam/madrat/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/madrat) [![r-universe](https://pik-piam.r-universe.dev/badges/madrat)](https://pik-piam.r-universe.dev/builds) @@ -55,7 +55,7 @@ In case of questions / problems please contact Jan Philipp Dietrich , Version: 3.34.0, . +Dietrich J, Sauer P, Baumstark L, Wirth S, Giannousakis A, Rodrigues R, Bodirsky B, Leip D, Crawford M, Kreidenweis U, Klein D, Rein P (2026). "madrat: May All Data be Reproducible and Transparent (MADRaT) *." doi:10.5281/zenodo.1115490 , Version: 3.35.0, . A BibTeX entry for LaTeX users is @@ -64,9 +64,9 @@ A BibTeX entry for LaTeX users is title = {madrat: May All Data be Reproducible and Transparent (MADRaT) *}, author = {Jan Philipp Dietrich and Pascal Sauer and Lavinia Baumstark and Stephen Wirth and Anastasis Giannousakis and Renato Rodrigues and Benjamin Leon Bodirsky and Debbora Leip and Michael Crawford and Ulrich Kreidenweis and David Klein and Patrick Rein}, doi = {10.5281/zenodo.1115490}, - date = {2026-02-11}, + date = {2026-02-12}, year = {2026}, url = {https://github.com/pik-piam/madrat}, - note = {Version: 3.34.0}, + note = {Version: 3.35.0}, } ``` diff --git a/man/toolTimeSpline.Rd b/man/toolTimeSpline.Rd index ccea2e9c..1a5cd3cf 100644 --- a/man/toolTimeSpline.Rd +++ b/man/toolTimeSpline.Rd @@ -4,7 +4,14 @@ \alias{toolTimeSpline} \title{Smooth a magclass time series with optional anchor years} \usage{ -toolTimeSpline(x, dof = 5, peggedYears = NULL, anchorFactor = 10) +toolTimeSpline( + x, + dof = 5, + peggedYears = NULL, + anchorFactor = 10, + targetYears = NULL, + fillNA = FALSE +) } \arguments{ \item{x}{A magclass object.} @@ -17,16 +24,27 @@ anchor during smoothing; NULL for none (default).} \item{anchorFactor}{Numeric multiplier for anchor weights (default 10); larger values more strongly enforce pegging.} + +\item{targetYears}{Integer vector of additional years at which the fitted spline +should be evaluated, enabling higher time resolution (default NULL, i.e. output +years equal input years). Output years are the sorted union of input and target years.} + +\item{fillNA}{Logical. If TRUE, NA values are excluded from the spline fit and +then filled by predicting at those positions (default FALSE). +Otherwise, an error is thrown if NA values are present in the input.} } \value{ -A magclass object of the same shape, with each time series spline-smoothed. +A magclass object with each time series spline-smoothed. + If targetYears is not specified (NULL), the time dimension is unchanged. If targetYears is + given, the time dimension covers the sorted union of the original and target years. } \description{ Smooths a magclass time series using spline approximation with the given degrees of freedom. Optionally, specific years can be "pegged" (anchored) to stay close to their original values during smoothing. Anchoring is enforced by applying -high weights to those years. +high weights to those years. If a higher time resolution is desired, +the fitted spline can be evaluated at additional target years. } \author{ -Kristine Karstens, Felicitas Beier, Michael Crawford +Kristine Karstens, Felicitas Beier, Michael Crawford, Bennet Weiss } diff --git a/tests/testthat/test-variousTools.R b/tests/testthat/test-variousTools.R index 0df4edbb..6cf438c4 100644 --- a/tests/testthat/test-variousTools.R +++ b/tests/testthat/test-variousTools.R @@ -109,6 +109,93 @@ test_that("toolTimeSpline with peggedYears works as expected", { expect_equal(resultArr[, anchorIdx, ], originalArr[, anchorIdx, ], tolerance = 0.05) }) +test_that("toolTimeSpline with targetYears works as expected", { + p <- magclass::maxample("pop")[1:2, 1:6, 1] + attr(p, "Metadata") <- NULL + + ncr <- function(x) { + getComment(x) <- NULL + return(round(x, 1)) + } + + # without targetYears as baseline + baseline <- ncr(toolTimeSpline(p, dof = 5)) + + # with targetYears that include only the original years -> same result + origYears <- getYears(p, as.integer = TRUE) + sameResult <- ncr(toolTimeSpline(p, dof = 5, targetYears = origYears)) + expect_identical(as.array(sameResult), as.array(baseline)) + + # with targetYears adding intermediate years + extraYears <- c(2000, 2010, 2020, 2030, 2040) + result <- toolTimeSpline(p, dof = 5, targetYears = extraYears) + resultYears <- getYears(result, as.integer = TRUE) + + # output should contain all original AND extra years + expect_true(all(origYears %in% resultYears)) + expect_true(all(extraYears %in% resultYears)) + expect_equal(resultYears, sort(union(origYears, extraYears))) + + # values at original years should match the baseline (without targetYears) + origIdx <- getYears(result) %in% getYears(p) + expect_equal(as.array(ncr(result[, origIdx, ])), as.array(baseline), tolerance = 0.01) + + # interpolated years should have reasonable values (between min and max of data) + expect_true(all(result >= 0)) + expect_true(all(result <= max(p) * 1.5)) + + # also works with "yYYYY" format for targetYears + resultY <- toolTimeSpline(p, dof = 5, targetYears = c("y2000", "y2010")) + expect_true(all(c(2000, 2010) %in% getYears(resultY, as.integer = TRUE))) + + # spatial and data dimensions are preserved + expect_identical(getItems(result, dim = 1), getItems(p, dim = 1)) + expect_identical(getItems(result, dim = 3), getItems(p, dim = 3)) +}) + +test_that("toolTimeSpline with fillNA works as expected", { + p <- magclass::maxample("pop")[1:2, 1:6, 1] + attr(p, "Metadata") <- NULL + + ncr <- function(x) { + getComment(x) <- NULL + return(round(x, 1)) + } + + # baseline without NAs + baseline <- ncr(toolTimeSpline(p, dof = 5)) + + # fillNA = FALSE (default) should be identical to baseline + expect_identical(as.array(ncr(toolTimeSpline(p, dof = 5, fillNA = FALSE))), as.array(baseline)) + + # on data without NAs, fillNA = TRUE should give the same result + expect_equal(as.array(ncr(toolTimeSpline(p, dof = 5, fillNA = TRUE))), as.array(baseline), tolerance = 0.1) + + # introduce NAs and verify they are filled + pNA <- p + pNA[1, 3, ] <- NA # set one time step to NA for first region + pNA[2, 5, ] <- NA # set another for second region + + result <- toolTimeSpline(pNA, dof = 5, fillNA = TRUE) + + # output should have no NAs + expect_false(any(is.na(result))) + + # filled values should be reasonable (positive, within data range) + expect_true(all(result >= 0)) + expect_true(all(result <= max(p, na.rm = TRUE) * 1.5)) + + # dimensions should be preserved + expect_identical(getYears(result), getYears(p)) + expect_identical(getItems(result, dim = 1), getItems(p, dim = 1)) + expect_identical(getItems(result, dim = 3), getItems(p, dim = 3)) + + # fillNA also works together with targetYears + resultBoth <- toolTimeSpline(pNA, dof = 5, fillNA = TRUE, targetYears = c(2000, 2010)) + expect_false(any(is.na(resultBoth))) + expect_true(all(c(2000, 2010) %in% getYears(resultBoth, as.integer = TRUE))) +}) + test_that("toolConvertMapping works as expected", { localConfig(mappingfolder = withr::local_tempdir(), .verbose = FALSE) file.copy(toolGetMapping("regionmappingH12.csv", returnPathOnly = TRUE), getConfig("mappingfolder"))