From 6ffae5f7d9ef036adcd9f9d1d6dcbe6f5f641421 Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Fri, 3 Jul 2026 16:19:23 +0200 Subject: [PATCH 1/8] do historically consistent smoothing for common drivers --- R/calcCoGDP.R | 13 +- R/calcCoPopulation.R | 15 ++- R/toolHistoricallyConsistentSmoothing.R | 97 ++++++++++++++ ...test-toolHistoricallyConsistentSmoothing.R | 126 ++++++++++++++++++ 4 files changed, 246 insertions(+), 5 deletions(-) create mode 100644 R/toolHistoricallyConsistentSmoothing.R create mode 100644 tests/testthat/test-toolHistoricallyConsistentSmoothing.R diff --git a/R/calcCoGDP.R b/R/calcCoGDP.R index aa25af90..a507a55e 100644 --- a/R/calcCoGDP.R +++ b/R/calcCoGDP.R @@ -16,7 +16,9 @@ #' @param perCapita Logical. If TRUE, GDP is returned as per capita. #' @param scenarios Character vector or string specifying the scenarios to use for the future. #' @param collapse Logical. If TRUE, redundant dimensions (e.g. scenario if only one requested) are removed. -#' @param smooth Logical. If TRUE, data is smoothed using spline interpolation. +#' @param smooth Logical. If TRUE, data is smoothed using spline interpolation +#' (see \link{toolHistoricallyConsistentSmoothing}); smoothed historical values +#' are identical across scenarios. #' @param dof Integer. Degrees of freedom for spline interpolation. #' Higher values lead to a closer fit to the original data, while lower values result in smoother curves. #' @return List with Magpie object of GDP (given in 2005 USD) and metadata in calcOutput format. @@ -63,7 +65,14 @@ calcCoGDP <- function(perCapita = FALSE, scenarios = "SSP2", collapse = TRUE, sm if (smooth) { # smooth data and interpolate missing data years <- startyear:2100 - gdp[, years] <- toolTimeSpline(gdp[, years], dof = dof, peggedYears = c(1900, 2023, 2100)) + # near-term GDP projections are fixed (scenario-independent) until 2029 + lastHistYear <- 2029 + gdp[, years] <- toolHistoricallyConsistentSmoothing( + gdp[, years], + lastHistYear = lastHistYear, + refScenario = if ("SSP2" %in% getItems(gdp, dim = "scenario")) "SSP2" else getItems(gdp, dim = "scenario")[1], + dof = dof + ) } # finalize for calcOutput diff --git a/R/calcCoPopulation.R b/R/calcCoPopulation.R index 68875a29..23f83de5 100644 --- a/R/calcCoPopulation.R +++ b/R/calcCoPopulation.R @@ -12,7 +12,9 @@ #' @author Merlin Jo Hosak, Bennet Weiss #' @param scenarios Character vector or string specifying the scenarios to use for the future. #' @param collapse Logical. If TRUE, redundant dimensions (e.g. scenario if only one requested) are removed. -#' @param smooth Logical. If TRUE, data is smoothed using spline interpolation. +#' @param smooth Logical. If TRUE, data is smoothed using spline interpolation +#' (see \link{toolHistoricallyConsistentSmoothing}); smoothed historical values +#' are identical across scenarios. #' @param dof Integer. Degrees of freedom for spline interpolation. #' Higher values lead to a closer fit to the original data, while lower values result in smoother curves. #' @return List with Magpie object of population and metadata in calcOutput @@ -39,10 +41,17 @@ calcCoPopulation <- function(scenarios = "SSP2", collapse = TRUE, smooth = FALSE pop <- toolBackcastByReference(x = pop, ref = worldHist) if (smooth) { - # smooth data and interpolate missing data; ensure pegging of key years + # smooth data and interpolate missing data # remove data beyond 2100 from smoothing due to low data quality years <- min(getYears(pop, as.integer = TRUE)):2100 - pop[, years] <- toolTimeSpline(pop[, years], dof = dof, peggedYears = c(1900, 2023, 2100)) + # near-term population projections are fixed (scenario-independent) until 2029 + lastHistYear <- 2029 + pop[, years] <- toolHistoricallyConsistentSmoothing( + pop[, years], + lastHistYear = lastHistYear, + refScenario = if ("SSP2" %in% getItems(pop, dim = "scenario")) "SSP2" else getItems(pop, dim = "scenario")[1], + dof = dof + ) } # build description including scenario and smoothing note diff --git a/R/toolHistoricallyConsistentSmoothing.R b/R/toolHistoricallyConsistentSmoothing.R new file mode 100644 index 00000000..06285f37 --- /dev/null +++ b/R/toolHistoricallyConsistentSmoothing.R @@ -0,0 +1,97 @@ +#' Historically consistent time smoothing across scenarios +#' +#' @description +#' Smooths a magpie object over time using \link[madrat]{toolTimeSpline} while +#' ensuring that smoothed values in the historical period are identical across +#' all scenarios. Plain per-scenario spline smoothing lets scenario-specific +#' future data pull the fit inside the historical period, so smoothed +#' historical values would otherwise differ between scenarios. +#' After smoothing, all years up to \code{lastHistYear} are replaced in every +#' scenario by the smoothed values of \code{refScenario}. To avoid a +#' derivative discontinuity at the transition, each non-reference scenario is +#' faded from the reference trajectory to its own trajectory over +#' \code{fadeLength} years using the smootherstep polynomial +#' \eqn{w(t) = 6t^5 - 15t^4 + 10t^3}, whose first and second derivatives +#' vanish at both endpoints. The blended curve therefore matches the slope of +#' the shared history at the start of the fade window and the slope of the +#' scenario-specific spline at its end, yielding a (at least) C1-continuous, +#' in fact C2-continuous, transition. +#' +#' @param x A magpie object without NAs in the covered years +#' (\link[madrat]{toolTimeSpline} does not support NAs). +#' @param lastHistYear Integer. Last year considered historical. Required if +#' x contains multiple scenarios, ignored otherwise. +#' @param refScenario Character. Name of the scenario whose smoothed values +#' define the shared history (default "SSP2"). +#' @param scenarioDim Character. Name of the (sub)dimension holding the +#' scenarios (default "scenario"). If x has no such dimension, the object is +#' smoothed as a whole without any harmonization. +#' @param fadeLength Integer >= 0. Length of the transition window in years. +#' 0 produces a hard splice, which is generally discontinuous. +#' @param dof Degrees of freedom passed to \link[madrat]{toolTimeSpline}. +#' @param ... Further arguments (e.g. peggedYears, anchorFactor) passed to +#' \link[madrat]{toolTimeSpline}. +#' @return Smoothed magpie object with scenario-independent history. +#' @author Bennet Weiss +toolHistoricallyConsistentSmoothing <- function(x, + lastHistYear = NULL, + refScenario = "SSP2", + scenarioDim = "scenario", + fadeLength = 10, + dof = 8, + ...) { + if (!is.numeric(fadeLength) || length(fadeLength) != 1 || fadeLength < 0) { + stop("fadeLength must be a single non-negative number.") + } + + smoothed <- toolTimeSpline(x, dof = dof, ...) + + # without a scenario dimension or with a single scenario there is nothing to harmonize + if (!scenarioDim %in% getSets(x)) { + return(smoothed) + } + scens <- getItems(x, dim = scenarioDim) + if (length(scens) <= 1) { + return(smoothed) + } + + if (is.null(lastHistYear)) { + stop("lastHistYear must be provided when x contains multiple scenarios.") + } + if (!refScenario %in% scens) { + stop( + "refScenario '", refScenario, "' not found in dimension '", scenarioDim, + "'. Available: ", paste(scens, collapse = ", ") + ) + } + + years <- getYears(smoothed, as.integer = TRUE) + if (!any(years <= lastHistYear)) { + warning("No years <= lastHistYear (", lastHistYear, ") in data. Returning plainly smoothed object.") + return(smoothed) + } + if (lastHistYear >= max(years)) { + warning("lastHistYear >= last data year. All scenarios are replaced by refScenario values.") + } + + histYears <- years[years <= lastHistYear] + fadeYears <- years[years > lastHistYear & years <= lastHistYear + fadeLength] + + # note: arithmetic between magpie slices with differing dim-3 names silently + # Cartesian-expands instead of broadcasting, hence array math + positional assignment + selRef <- stats::setNames(list(refScenario), scenarioDim) + ref <- smoothed[, , selRef] + for (s in setdiff(scens, refScenario)) { + selS <- stats::setNames(list(s), scenarioDim) + # replace history by shared reference values + smoothed[, histYears, selS] <- ref[, histYears, ] + # fade from shared history to scenario-specific future (weights from year + # values, not indices, so irregular time steps stay correct) + for (y in fadeYears) { + tNorm <- (y - lastHistYear) / fadeLength + w <- 6 * tNorm^5 - 15 * tNorm^4 + 10 * tNorm^3 # smootherstep + smoothed[, y, selS] <- (1 - w) * as.array(ref[, y, ]) + w * as.array(smoothed[, y, selS]) + } + } + return(smoothed) +} diff --git a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R new file mode 100644 index 00000000..43833169 --- /dev/null +++ b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R @@ -0,0 +1,126 @@ +# synthetic data: identical noisy history up to divergeYear, scenario-specific growth after +makeTestData <- function(divergeYear = 2020, scenarios = c("SSP1", "SSP2", "SSP3")) { + set.seed(42) + years <- 1950:2050 + x <- magclass::new.magpie( + cells_and_regions = c("DEU", "FRA"), + years = years, + names = scenarios, + fill = 0, + sets = c("region", "year", "scenario") + ) + base <- 100 + (years - 1950)^1.3 + stats::rnorm(length(years), sd = 2) + growthRates <- c(SSP1 = 0.5, SSP2 = 1, SSP3 = 2) + for (r in magclass::getItems(x, dim = 1)) { + for (s in scenarios) { + v <- base + late <- years > divergeYear + v[late] <- v[late] + growthRates[[s]] * (years[late] - divergeYear)^1.5 + x[r, , s] <- v + } + } + x +} + +test_that("historical values are identical across scenarios", { + x <- makeTestData() + res <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020) + refHist <- as.vector(res[, 1950:2020, "SSP2"]) + for (s in c("SSP1", "SSP3")) { + expect_equal(as.vector(res[, 1950:2020, s]), refHist) + } +}) + +test_that("transition is smooth (no kink) and continuous compared to hard splice", { + x <- makeTestData() + res <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = 10) + hard <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = 0) + years <- magclass::getYears(res, as.integer = TRUE) + + # kink (second difference) at the transition is smaller for the faded version + transition <- which(years >= 2015 & years <= 2035) + kink <- function(obj) max(abs(diff(as.vector(obj["DEU", , "SSP3"]), differences = 2)[transition])) + expect_gt(kink(hard), kink(res)) + + # continuity: value step at the boundary (lastHistYear -> lastHistYear + 1) + # is much smaller for the faded version than the hard splice + d1_res <- diff(as.vector(res["DEU", , "SSP3"])) + d1_hard <- diff(as.vector(hard["DEU", , "SSP3"])) + trans_idx <- which(years == 2020) # d1[i] = step from years[i] to years[i+1] + expect_lt(abs(d1_res[trans_idx]), abs(d1_hard[trans_idx])) +}) + +test_that("single scenario and missing scenario dimension pass through", { + x <- makeTestData() + x1 <- x[, , "SSP1"] + expected <- toolTimeSpline(x1, dof = 8) + expect_equal( + as.vector(toolHistoricallyConsistentSmoothing(x1)), + as.vector(expected) + ) + # object without a "scenario" set + x2 <- x1 + magclass::getSets(x2)[3] <- "variable" + expect_equal( + as.vector(toolHistoricallyConsistentSmoothing(x2)), + as.vector(expected) + ) +}) + +test_that("reference scenario is unchanged by the harmonization", { + x <- makeTestData() + res <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020) + expected <- toolTimeSpline(x, dof = 8) + expect_equal(as.vector(res[, , "SSP2"]), as.vector(expected[, , "SSP2"])) +}) + +test_that("other third-dimension subdimensions are handled correctly", { + a <- makeTestData() + magclass::getSets(a)[3] <- "scenario" + b <- a * 2 + x <- magclass::mbind( + magclass::add_dimension(a, dim = 3.2, add = "variable", nm = "v1"), + magclass::add_dimension(b, dim = 3.2, add = "variable", nm = "v2") + ) + res <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020) + for (v in c("v1", "v2")) { + refHist <- as.vector(res[, 1950:2020, paste0("SSP2.", v)]) + for (s in c("SSP1", "SSP3")) { + expect_equal(as.vector(res[, 1950:2020, paste0(s, ".", v)]), refHist) + } + } + # variables are not mixed up: v2 history stays about twice v1 history + ratio <- as.vector(res[, 1950:2020, "SSP1.v2"]) / as.vector(res[, 1950:2020, "SSP1.v1"]) + expect_true(all(abs(ratio - 2) < 1e-10)) +}) + +test_that("invalid inputs raise errors and edge cases warn", { + x <- makeTestData() + expect_error( + toolHistoricallyConsistentSmoothing(x), + "lastHistYear must be provided" + ) + expect_error( + toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, refScenario = "SSPX"), + "not found" + ) + expect_error( + toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = -1), + "fadeLength" + ) + expect_warning( + toolHistoricallyConsistentSmoothing(x, lastHistYear = 2200), + "replaced by refScenario" + ) + expect_warning( + toolHistoricallyConsistentSmoothing(x, lastHistYear = 1900), + "No years" + ) +}) + +test_that("fade window truncated by end of data works", { + x <- makeTestData() + expect_no_error( + toolHistoricallyConsistentSmoothing(x, lastHistYear = 2045, fadeLength = 20) + ) +}) From 7624c0d31178ed257da83a85c90218fb636cfdab Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Sun, 5 Jul 2026 09:54:13 +0200 Subject: [PATCH 2/8] vectorize fading --- R/toolHistoricallyConsistentSmoothing.R | 21 +++++++++---------- tests/testthat/test-dummy.R | 1 - ...test-toolHistoricallyConsistentSmoothing.R | 11 ++++++---- 3 files changed, 17 insertions(+), 16 deletions(-) delete mode 100644 tests/testthat/test-dummy.R diff --git a/R/toolHistoricallyConsistentSmoothing.R b/R/toolHistoricallyConsistentSmoothing.R index 06285f37..faac1455 100644 --- a/R/toolHistoricallyConsistentSmoothing.R +++ b/R/toolHistoricallyConsistentSmoothing.R @@ -17,8 +17,7 @@ #' scenario-specific spline at its end, yielding a (at least) C1-continuous, #' in fact C2-continuous, transition. #' -#' @param x A magpie object without NAs in the covered years -#' (\link[madrat]{toolTimeSpline} does not support NAs). +#' @param x A magpie object. #' @param lastHistYear Integer. Last year considered historical. Required if #' x contains multiple scenarios, ignored otherwise. #' @param refScenario Character. Name of the scenario whose smoothed values @@ -48,6 +47,7 @@ toolHistoricallyConsistentSmoothing <- function(x, # without a scenario dimension or with a single scenario there is nothing to harmonize if (!scenarioDim %in% getSets(x)) { + warning("No dimension '", scenarioDim, "' found in x. Returning plainly smoothed object.") return(smoothed) } scens <- getItems(x, dim = scenarioDim) @@ -77,21 +77,20 @@ toolHistoricallyConsistentSmoothing <- function(x, histYears <- years[years <= lastHistYear] fadeYears <- years[years > lastHistYear & years <= lastHistYear + fadeLength] - # note: arithmetic between magpie slices with differing dim-3 names silently - # Cartesian-expands instead of broadcasting, hence array math + positional assignment selRef <- stats::setNames(list(refScenario), scenarioDim) ref <- smoothed[, , selRef] + # prepare the fade weights + tNorm <- (fadeYears - lastHistYear) / fadeLength + w <- 6 * tNorm^5 - 15 * tNorm^4 + 10 * tNorm^3 + refArr <- as.array(ref[, fadeYears, ]) for (s in setdiff(scens, refScenario)) { selS <- stats::setNames(list(s), scenarioDim) # replace history by shared reference values smoothed[, histYears, selS] <- ref[, histYears, ] - # fade from shared history to scenario-specific future (weights from year - # values, not indices, so irregular time steps stay correct) - for (y in fadeYears) { - tNorm <- (y - lastHistYear) / fadeLength - w <- 6 * tNorm^5 - 15 * tNorm^4 + 10 * tNorm^3 # smootherstep - smoothed[, y, selS] <- (1 - w) * as.array(ref[, y, ]) + w * as.array(smoothed[, y, selS]) - } + sArr <- as.array(smoothed[, fadeYears, selS]) + # broadcast w across regions and data dims + blended <- sweep(refArr, 2, 1 - w, `*`) + sweep(sArr, 2, w, `*`) + smoothed[, fadeYears, selS] <- blended } return(smoothed) } diff --git a/tests/testthat/test-dummy.R b/tests/testthat/test-dummy.R deleted file mode 100644 index 909f17c6..00000000 --- a/tests/testthat/test-dummy.R +++ /dev/null @@ -1 +0,0 @@ -skip("dummy test") diff --git a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R index 43833169..f7872e55 100644 --- a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R +++ b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R @@ -58,12 +58,15 @@ test_that("single scenario and missing scenario dimension pass through", { as.vector(toolHistoricallyConsistentSmoothing(x1)), as.vector(expected) ) - # object without a "scenario" set + # object without a "scenario" set: should warn and return plain smoothed result x2 <- x1 magclass::getSets(x2)[3] <- "variable" - expect_equal( - as.vector(toolHistoricallyConsistentSmoothing(x2)), - as.vector(expected) + expect_warning( + expect_equal( + as.vector(toolHistoricallyConsistentSmoothing(x2)), + as.vector(expected) + ), + "No dimension" ) }) From bd682bdf0164e97b212f0efae19b5e870dcd9ac0 Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Sun, 5 Jul 2026 10:21:43 +0200 Subject: [PATCH 3/8] dynamically detect last historical year. --- R/calcCoGDP.R | 4 +- R/calcCoPopulation.R | 5 +- R/toolHistoricallyConsistentSmoothing.R | 60 ++++++++++++++----- ...test-toolHistoricallyConsistentSmoothing.R | 30 ++++++++-- 4 files changed, 73 insertions(+), 26 deletions(-) diff --git a/R/calcCoGDP.R b/R/calcCoGDP.R index a507a55e..a53869fa 100644 --- a/R/calcCoGDP.R +++ b/R/calcCoGDP.R @@ -64,12 +64,10 @@ calcCoGDP <- function(perCapita = FALSE, scenarios = "SSP2", collapse = TRUE, sm if (smooth) { # smooth data and interpolate missing data + # exclude data beyond 2100 from smoothing due to low data quality years <- startyear:2100 - # near-term GDP projections are fixed (scenario-independent) until 2029 - lastHistYear <- 2029 gdp[, years] <- toolHistoricallyConsistentSmoothing( gdp[, years], - lastHistYear = lastHistYear, refScenario = if ("SSP2" %in% getItems(gdp, dim = "scenario")) "SSP2" else getItems(gdp, dim = "scenario")[1], dof = dof ) diff --git a/R/calcCoPopulation.R b/R/calcCoPopulation.R index 23f83de5..888e1173 100644 --- a/R/calcCoPopulation.R +++ b/R/calcCoPopulation.R @@ -42,13 +42,10 @@ calcCoPopulation <- function(scenarios = "SSP2", collapse = TRUE, smooth = FALSE if (smooth) { # smooth data and interpolate missing data - # remove data beyond 2100 from smoothing due to low data quality + # exclude data beyond 2100 from smoothing due to low data quality years <- min(getYears(pop, as.integer = TRUE)):2100 - # near-term population projections are fixed (scenario-independent) until 2029 - lastHistYear <- 2029 pop[, years] <- toolHistoricallyConsistentSmoothing( pop[, years], - lastHistYear = lastHistYear, refScenario = if ("SSP2" %in% getItems(pop, dim = "scenario")) "SSP2" else getItems(pop, dim = "scenario")[1], dof = dof ) diff --git a/R/toolHistoricallyConsistentSmoothing.R b/R/toolHistoricallyConsistentSmoothing.R index faac1455..601c3643 100644 --- a/R/toolHistoricallyConsistentSmoothing.R +++ b/R/toolHistoricallyConsistentSmoothing.R @@ -18,8 +18,12 @@ #' in fact C2-continuous, transition. #' #' @param x A magpie object. -#' @param lastHistYear Integer. Last year considered historical. Required if -#' x contains multiple scenarios, ignored otherwise. +#' @param lastHistYear Integer or NULL. Last year considered historical. If +#' NULL (default), it is detected automatically as the last year up to which +#' all scenarios in \code{x} share identical values. If given, the historical +#' period is forced up to this year and \code{refScenario} values are written +#' there even where scenarios originally differ. Ignored if x contains a +#' single scenario. #' @param refScenario Character. Name of the scenario whose smoothed values #' define the shared history (default "SSP2"). #' @param scenarioDim Character. Name of the (sub)dimension holding the @@ -28,6 +32,8 @@ #' @param fadeLength Integer >= 0. Length of the transition window in years. #' 0 produces a hard splice, which is generally discontinuous. #' @param dof Degrees of freedom passed to \link[madrat]{toolTimeSpline}. +#' @param verbose Logical. If TRUE, print informational messages (e.g. the +#' automatically detected last historical year). Default FALSE. #' @param ... Further arguments (e.g. peggedYears, anchorFactor) passed to #' \link[madrat]{toolTimeSpline}. #' @return Smoothed magpie object with scenario-independent history. @@ -38,6 +44,7 @@ toolHistoricallyConsistentSmoothing <- function(x, scenarioDim = "scenario", fadeLength = 10, dof = 8, + verbose = FALSE, ...) { if (!is.numeric(fadeLength) || length(fadeLength) != 1 || fadeLength < 0) { stop("fadeLength must be a single non-negative number.") @@ -55,9 +62,6 @@ toolHistoricallyConsistentSmoothing <- function(x, return(smoothed) } - if (is.null(lastHistYear)) { - stop("lastHistYear must be provided when x contains multiple scenarios.") - } if (!refScenario %in% scens) { stop( "refScenario '", refScenario, "' not found in dimension '", scenarioDim, @@ -65,7 +69,34 @@ toolHistoricallyConsistentSmoothing <- function(x, ) } + # selector for a single scenario in the scenario (sub)dimension + selScen <- function(s) stats::setNames(list(s), scenarioDim) + selRef <- selScen(refScenario) + otherScens <- setdiff(scens, refScenario) years <- getYears(smoothed, as.integer = TRUE) + + if (is.null(lastHistYear)) { + # detect the historical period as the leading run of years for which all + # scenarios in the (unsmoothed) input share identical values + refArr <- as.array(x[, , selRef]) + otherArrs <- lapply(otherScens, function(s) as.array(x[, , selScen(s)])) + for (i in seq_along(years)) { + sameThisYear <- all(vapply(otherArrs, function(a) { + isTRUE(all.equal(a[, i, ], refArr[, i, ], check.attributes = FALSE)) + }, logical(1))) + if (!sameThisYear) break + lastHistYear <- years[i] + } + if (is.null(lastHistYear)) { + warning( + "Scenarios already differ in the first year; no common historical ", + "period could be detected. Returning plainly smoothed object." + ) + return(smoothed) + } + if (verbose) message("Detected last historical year: ", lastHistYear) + } + if (!any(years <= lastHistYear)) { warning("No years <= lastHistYear (", lastHistYear, ") in data. Returning plainly smoothed object.") return(smoothed) @@ -77,20 +108,19 @@ toolHistoricallyConsistentSmoothing <- function(x, histYears <- years[years <= lastHistYear] fadeYears <- years[years > lastHistYear & years <= lastHistYear + fadeLength] - selRef <- stats::setNames(list(refScenario), scenarioDim) ref <- smoothed[, , selRef] + refFade <- as.array(ref[, fadeYears, ]) # prepare the fade weights tNorm <- (fadeYears - lastHistYear) / fadeLength w <- 6 * tNorm^5 - 15 * tNorm^4 + 10 * tNorm^3 - refArr <- as.array(ref[, fadeYears, ]) - for (s in setdiff(scens, refScenario)) { - selS <- stats::setNames(list(s), scenarioDim) - # replace history by shared reference values - smoothed[, histYears, selS] <- ref[, histYears, ] - sArr <- as.array(smoothed[, fadeYears, selS]) - # broadcast w across regions and data dims - blended <- sweep(refArr, 2, 1 - w, `*`) + sweep(sArr, 2, w, `*`) - smoothed[, fadeYears, selS] <- blended + + for (s in otherScens) { + sel <- selScen(s) + # overwrite history with the shared reference trajectory + smoothed[, histYears, sel] <- ref[, histYears, ] + # fade from reference to scenario-specific spline (w broadcast over region/data dims) + sFade <- as.array(smoothed[, fadeYears, sel]) + smoothed[, fadeYears, sel] <- sweep(refFade, 2, 1 - w, `*`) + sweep(sFade, 2, w, `*`) } return(smoothed) } diff --git a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R index f7872e55..81b98b42 100644 --- a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R +++ b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R @@ -99,10 +99,6 @@ test_that("other third-dimension subdimensions are handled correctly", { test_that("invalid inputs raise errors and edge cases warn", { x <- makeTestData() - expect_error( - toolHistoricallyConsistentSmoothing(x), - "lastHistYear must be provided" - ) expect_error( toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, refScenario = "SSPX"), "not found" @@ -121,6 +117,32 @@ test_that("invalid inputs raise errors and edge cases warn", { ) }) +test_that("lastHistYear is detected automatically when not provided", { + x <- makeTestData(divergeYear = 2020) + auto <- toolHistoricallyConsistentSmoothing(x) + explicit <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020) + expect_equal(as.vector(auto), as.vector(explicit)) +}) + +test_that("verbose reports the detected last historical year", { + x <- makeTestData(divergeYear = 2020) + expect_message( + toolHistoricallyConsistentSmoothing(x, verbose = TRUE), + "Detected last historical year: 2020" + ) +}) + +test_that("no common historical period warns and returns plain smoothing", { + # scenarios already diverge in the first year, so no shared history exists + x <- makeTestData(divergeYear = 1949) + expected <- toolTimeSpline(x, dof = 8) + expect_warning( + res <- toolHistoricallyConsistentSmoothing(x), + "no common historical" + ) + expect_equal(as.vector(res), as.vector(expected)) +}) + test_that("fade window truncated by end of data works", { x <- makeTestData() expect_no_error( From 0d34a3ee0c421263b616233cca9624f09270f98f Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Sun, 5 Jul 2026 10:46:46 +0200 Subject: [PATCH 4/8] use toolHistoricallyConsistentSmoothing for edge-b floorspace smoothing --- R/calcCeFloorspaceEDGEB.R | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/R/calcCeFloorspaceEDGEB.R b/R/calcCeFloorspaceEDGEB.R index 98201aba..8d38dd4f 100644 --- a/R/calcCeFloorspaceEDGEB.R +++ b/R/calcCeFloorspaceEDGEB.R @@ -12,11 +12,6 @@ calcCeFloorspaceEDGEB <- function(scenarios = "SSP2", collapse = TRUE, smooth = # Unit conversion from million m2 to m2 floorspace <- floorspace * 1e6 - # Remove redundant dimensions (e.g. Scenario, if only one is given) - if (collapse) { - floorspace <- collapseDim(floorspace) - } - # Remove buildings total floorspace <- floorspace[, , (Variable <- "buildings"), invert = TRUE] @@ -27,10 +22,19 @@ calcCeFloorspaceEDGEB <- function(scenarios = "SSP2", collapse = TRUE, smooth = floorspace_years <- getYears(floorspace, as.integer = TRUE) # smooth if requested if (smooth) { - # smooth data and interpolate missing data; ensure pegging of key years - # remove data beyond 2100 from smoothing due to low data quality - years <- floorspace_years[floorspace_years<=2100] - floorspace[, years] <- toolTimeSpline(floorspace[, years], dof = dof) + # smooth data while keeping the historical period identical across scenarios + # exclude data beyond 2100 from smoothing due to low data quality + years <- floorspace_years[floorspace_years <= 2100] + floorspace[, years] <- toolHistoricallyConsistentSmoothing( + floorspace[, years], + refScenario = if ("SSP2" %in% getItems(floorspace, dim = "scenario")) "SSP2" else getItems(floorspace, dim = "scenario")[1], + dof = dof + ) + } + + # Remove redundant dimensions (e.g. scenario, if only one is given) + if (collapse) { + floorspace <- collapseDim(floorspace) } # interpolate to yearly data From cd6f35b0ec0b6b6f24450455b783568ea155e124 Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Sun, 5 Jul 2026 10:56:38 +0200 Subject: [PATCH 5/8] build library --- .buildlibrary | 2 +- CITATION.cff | 4 +- DESCRIPTION | 4 +- R/calcCeFloorspaceEDGEB.R | 6 +- README.md | 8 +-- man/calcCoGDP.Rd | 4 +- man/calcCoPopulation.Rd | 4 +- man/toolHistoricallyConsistentSmoothing.Rd | 68 +++++++++++++++++++ ...test-toolHistoricallyConsistentSmoothing.R | 8 +-- 9 files changed, 91 insertions(+), 17 deletions(-) create mode 100644 man/toolHistoricallyConsistentSmoothing.Rd diff --git a/.buildlibrary b/.buildlibrary index fb0a5e25..55d765f2 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '22925485' +ValidationKey: '23115680' AutocreateReadme: yes AutocreateCITATION: yes AcceptedWarnings: diff --git a/CITATION.cff b/CITATION.cff index 6f860741..c2009acc 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: 'mrmfa: Input data generation for the REMIND MFA' -version: 1.11.1 -date-released: '2026-07-01' +version: 1.12.0 +date-released: '2026-07-05' abstract: The mrmfa packages contains data preprocessing for the REMIND MFA. authors: - family-names: Dürrwächter diff --git a/DESCRIPTION b/DESCRIPTION index 2cd039b3..d5f288b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mrmfa Title: Input data generation for the REMIND MFA -Version: 1.11.1 -Date: 2026-07-01 +Version: 1.12.0 +Date: 2026-07-05 Authors@R: c( person("Jakob", "Dürrwächter", , "jakobdu@pik-potsdam.de", role = c("aut", "cre")), person("Bennet", "Weiss", , "bennet.weiss@pik-potsdam.de", role = "aut"), diff --git a/R/calcCeFloorspaceEDGEB.R b/R/calcCeFloorspaceEDGEB.R index 8d38dd4f..92a791f2 100644 --- a/R/calcCeFloorspaceEDGEB.R +++ b/R/calcCeFloorspaceEDGEB.R @@ -13,7 +13,7 @@ calcCeFloorspaceEDGEB <- function(scenarios = "SSP2", collapse = TRUE, smooth = floorspace <- floorspace * 1e6 # Remove buildings total - floorspace <- floorspace[, , (Variable <- "buildings"), invert = TRUE] + floorspace <- floorspace[, , "buildings", invert = TRUE] # enforce MFA naming convention getNames(floorspace) <- gsub("commercial", "Com", getNames(floorspace)) @@ -25,9 +25,11 @@ calcCeFloorspaceEDGEB <- function(scenarios = "SSP2", collapse = TRUE, smooth = # smooth data while keeping the historical period identical across scenarios # exclude data beyond 2100 from smoothing due to low data quality years <- floorspace_years[floorspace_years <= 2100] + scens <- getItems(floorspace, dim = "scenario") + refScenario <- if ("SSP2" %in% scens) "SSP2" else scens[1] floorspace[, years] <- toolHistoricallyConsistentSmoothing( floorspace[, years], - refScenario = if ("SSP2" %in% getItems(floorspace, dim = "scenario")) "SSP2" else getItems(floorspace, dim = "scenario")[1], + refScenario = refScenario, dof = dof ) } diff --git a/README.md b/README.md index 01629edc..4c585144 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Input data generation for the REMIND MFA -R package **mrmfa**, version **1.11.1** +R package **mrmfa**, version **1.12.0** [![R build status](https://github.com/pik-piam/mrmfa/workflows/check/badge.svg)](https://github.com/pik-piam/mrmfa/actions) [![codecov](https://codecov.io/gh/pik-piam/mrmfa/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrmfa) @@ -38,7 +38,7 @@ In case of questions / problems please contact Jakob Dürrwächter . +Dürrwächter J, Weiss B, Schweiger L, Benke F, Hosak M, Zhang Q (2026). "mrmfa: Input data generation for the REMIND MFA." Version: 1.12.0, . A BibTeX entry for LaTeX users is @@ -46,9 +46,9 @@ A BibTeX entry for LaTeX users is @Misc{, title = {mrmfa: Input data generation for the REMIND MFA}, author = {Jakob Dürrwächter and Bennet Weiss and Leonie Schweiger and Falk Benke and Merlin Jo Hosak and Qianzhi Zhang}, - date = {2026-07-01}, + date = {2026-07-05}, year = {2026}, url = {https://github.com/pik-piam/mrmfa}, - note = {Version: 1.11.1}, + note = {Version: 1.12.0}, } ``` diff --git a/man/calcCoGDP.Rd b/man/calcCoGDP.Rd index 3bccbc3d..c323f3ac 100644 --- a/man/calcCoGDP.Rd +++ b/man/calcCoGDP.Rd @@ -19,7 +19,9 @@ calcCoGDP( \item{collapse}{Logical. If TRUE, redundant dimensions (e.g. scenario if only one requested) are removed.} -\item{smooth}{Logical. If TRUE, data is smoothed using spline interpolation.} +\item{smooth}{Logical. If TRUE, data is smoothed using spline interpolation +(see \link{toolHistoricallyConsistentSmoothing}); smoothed historical values +are identical across scenarios.} \item{dof}{Integer. Degrees of freedom for spline interpolation. Higher values lead to a closer fit to the original data, while lower values result in smoother curves.} diff --git a/man/calcCoPopulation.Rd b/man/calcCoPopulation.Rd index 605d6054..4797f429 100644 --- a/man/calcCoPopulation.Rd +++ b/man/calcCoPopulation.Rd @@ -11,7 +11,9 @@ calcCoPopulation(scenarios = "SSP2", collapse = TRUE, smooth = FALSE, dof = 8) \item{collapse}{Logical. If TRUE, redundant dimensions (e.g. scenario if only one requested) are removed.} -\item{smooth}{Logical. If TRUE, data is smoothed using spline interpolation.} +\item{smooth}{Logical. If TRUE, data is smoothed using spline interpolation +(see \link{toolHistoricallyConsistentSmoothing}); smoothed historical values +are identical across scenarios.} \item{dof}{Integer. Degrees of freedom for spline interpolation. Higher values lead to a closer fit to the original data, while lower values result in smoother curves.} diff --git a/man/toolHistoricallyConsistentSmoothing.Rd b/man/toolHistoricallyConsistentSmoothing.Rd new file mode 100644 index 00000000..560ec5e2 --- /dev/null +++ b/man/toolHistoricallyConsistentSmoothing.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/toolHistoricallyConsistentSmoothing.R +\name{toolHistoricallyConsistentSmoothing} +\alias{toolHistoricallyConsistentSmoothing} +\title{Historically consistent time smoothing across scenarios} +\usage{ +toolHistoricallyConsistentSmoothing( + x, + lastHistYear = NULL, + refScenario = "SSP2", + scenarioDim = "scenario", + fadeLength = 10, + dof = 8, + verbose = FALSE, + ... +) +} +\arguments{ +\item{x}{A magpie object.} + +\item{lastHistYear}{Integer or NULL. Last year considered historical. If +NULL (default), it is detected automatically as the last year up to which +all scenarios in \code{x} share identical values. If given, the historical +period is forced up to this year and \code{refScenario} values are written +there even where scenarios originally differ. Ignored if x contains a +single scenario.} + +\item{refScenario}{Character. Name of the scenario whose smoothed values +define the shared history (default "SSP2").} + +\item{scenarioDim}{Character. Name of the (sub)dimension holding the +scenarios (default "scenario"). If x has no such dimension, the object is +smoothed as a whole without any harmonization.} + +\item{fadeLength}{Integer >= 0. Length of the transition window in years. +0 produces a hard splice, which is generally discontinuous.} + +\item{dof}{Degrees of freedom passed to \link[madrat]{toolTimeSpline}.} + +\item{verbose}{Logical. If TRUE, print informational messages (e.g. the +automatically detected last historical year). Default FALSE.} + +\item{...}{Further arguments (e.g. peggedYears, anchorFactor) passed to +\link[madrat]{toolTimeSpline}.} +} +\value{ +Smoothed magpie object with scenario-independent history. +} +\description{ +Smooths a magpie object over time using \link[madrat]{toolTimeSpline} while +ensuring that smoothed values in the historical period are identical across +all scenarios. Plain per-scenario spline smoothing lets scenario-specific +future data pull the fit inside the historical period, so smoothed +historical values would otherwise differ between scenarios. +After smoothing, all years up to \code{lastHistYear} are replaced in every +scenario by the smoothed values of \code{refScenario}. To avoid a +derivative discontinuity at the transition, each non-reference scenario is +faded from the reference trajectory to its own trajectory over +\code{fadeLength} years using the smootherstep polynomial +\eqn{w(t) = 6t^5 - 15t^4 + 10t^3}, whose first and second derivatives +vanish at both endpoints. The blended curve therefore matches the slope of +the shared history at the start of the fade window and the slope of the +scenario-specific spline at its end, yielding a (at least) C1-continuous, +in fact C2-continuous, transition. +} +\author{ +Bennet Weiss +} diff --git a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R index 81b98b42..e9521587 100644 --- a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R +++ b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R @@ -44,10 +44,10 @@ test_that("transition is smooth (no kink) and continuous compared to hard splice # continuity: value step at the boundary (lastHistYear -> lastHistYear + 1) # is much smaller for the faded version than the hard splice - d1_res <- diff(as.vector(res["DEU", , "SSP3"])) - d1_hard <- diff(as.vector(hard["DEU", , "SSP3"])) - trans_idx <- which(years == 2020) # d1[i] = step from years[i] to years[i+1] - expect_lt(abs(d1_res[trans_idx]), abs(d1_hard[trans_idx])) + d1Res <- diff(as.vector(res["DEU", , "SSP3"])) + d1Hard <- diff(as.vector(hard["DEU", , "SSP3"])) + transIdx <- which(years == 2020) # d1[i] = step from years[i] to years[i+1] + expect_lt(abs(d1Res[transIdx]), abs(d1Hard[transIdx])) }) test_that("single scenario and missing scenario dimension pass through", { From 0623b99a94e8995424c8b094b2f43ea62f5e3da6 Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Fri, 10 Jul 2026 17:02:42 +0200 Subject: [PATCH 6/8] simplify code --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- R/toolHistoricallyConsistentSmoothing.R | 79 ++++++++----------- README.md | 2 +- man/toolHistoricallyConsistentSmoothing.Rd | 17 ++-- ...test-toolHistoricallyConsistentSmoothing.R | 4 +- 7 files changed, 44 insertions(+), 64 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 55d765f2..e780c60f 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '23115680' +ValidationKey: '23121280' AutocreateReadme: yes AutocreateCITATION: yes AcceptedWarnings: diff --git a/CITATION.cff b/CITATION.cff index c2009acc..fa51542a 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -3,7 +3,7 @@ message: If you use this software, please cite it using the metadata from this f type: software title: 'mrmfa: Input data generation for the REMIND MFA' version: 1.12.0 -date-released: '2026-07-05' +date-released: '2026-07-10' abstract: The mrmfa packages contains data preprocessing for the REMIND MFA. authors: - family-names: Dürrwächter diff --git a/DESCRIPTION b/DESCRIPTION index d5f288b8..e50a1149 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: mrmfa Title: Input data generation for the REMIND MFA Version: 1.12.0 -Date: 2026-07-05 +Date: 2026-07-10 Authors@R: c( person("Jakob", "Dürrwächter", , "jakobdu@pik-potsdam.de", role = c("aut", "cre")), person("Bennet", "Weiss", , "bennet.weiss@pik-potsdam.de", role = "aut"), diff --git a/R/toolHistoricallyConsistentSmoothing.R b/R/toolHistoricallyConsistentSmoothing.R index 601c3643..62661751 100644 --- a/R/toolHistoricallyConsistentSmoothing.R +++ b/R/toolHistoricallyConsistentSmoothing.R @@ -14,10 +14,9 @@ #' \eqn{w(t) = 6t^5 - 15t^4 + 10t^3}, whose first and second derivatives #' vanish at both endpoints. The blended curve therefore matches the slope of #' the shared history at the start of the fade window and the slope of the -#' scenario-specific spline at its end, yielding a (at least) C1-continuous, -#' in fact C2-continuous, transition. +#' scenario-specific spline at its end, yielding a C2-continuous transition. #' -#' @param x A magpie object. +#' @param x A magpie object with a 'scenario' dimension. #' @param lastHistYear Integer or NULL. Last year considered historical. If #' NULL (default), it is detected automatically as the last year up to which #' all scenarios in \code{x} share identical values. If given, the historical @@ -25,12 +24,10 @@ #' there even where scenarios originally differ. Ignored if x contains a #' single scenario. #' @param refScenario Character. Name of the scenario whose smoothed values -#' define the shared history (default "SSP2"). -#' @param scenarioDim Character. Name of the (sub)dimension holding the -#' scenarios (default "scenario"). If x has no such dimension, the object is -#' smoothed as a whole without any harmonization. -#' @param fadeLength Integer >= 0. Length of the transition window in years. -#' 0 produces a hard splice, which is generally discontinuous. +#' define the shared history (default "SSP2"). Must be located in 'scenario' +#' dimension of \code{x}. Ignored if x contains a single scenario. +#' @param fadeLength Integer > 0. Length of the transition window in years. +#' 1 produces a hard splice, which is generally discontinuous. #' @param dof Degrees of freedom passed to \link[madrat]{toolTimeSpline}. #' @param verbose Logical. If TRUE, print informational messages (e.g. the #' automatically detected last historical year). Default FALSE. @@ -38,52 +35,49 @@ #' \link[madrat]{toolTimeSpline}. #' @return Smoothed magpie object with scenario-independent history. #' @author Bennet Weiss -toolHistoricallyConsistentSmoothing <- function(x, - lastHistYear = NULL, - refScenario = "SSP2", - scenarioDim = "scenario", - fadeLength = 10, - dof = 8, - verbose = FALSE, - ...) { - if (!is.numeric(fadeLength) || length(fadeLength) != 1 || fadeLength < 0) { - stop("fadeLength must be a single non-negative number.") +toolHistoricallyConsistentSmoothing <- function( + x, + lastHistYear = NULL, + refScenario = "SSP2", + fadeLength = 10, + dof = 8, + verbose = FALSE, + ... +) { + if (!is.numeric(fadeLength) || length(fadeLength) != 1 || fadeLength <= 0) { + stop("fadeLength must be a single positive number (larger than 0).") } smoothed <- toolTimeSpline(x, dof = dof, ...) - # without a scenario dimension or with a single scenario there is nothing to harmonize - if (!scenarioDim %in% getSets(x)) { - warning("No dimension '", scenarioDim, "' found in x. Returning plainly smoothed object.") + # without the scenario dimension or with a single scenario there is nothing to harmonize + if (!"scenario" %in% getSets(x)) { + warning("No dimension 'scenario' found in x. Returning plainly smoothed object.") return(smoothed) } - scens <- getItems(x, dim = scenarioDim) + scens <- getItems(x, dim = "scenario") if (length(scens) <= 1) { return(smoothed) } if (!refScenario %in% scens) { stop( - "refScenario '", refScenario, "' not found in dimension '", scenarioDim, - "'. Available: ", paste(scens, collapse = ", ") + "refScenario '", refScenario, "' not found in dimension 'scenario'. Available: ", paste(scens, collapse = ", ") ) } # selector for a single scenario in the scenario (sub)dimension - selScen <- function(s) stats::setNames(list(s), scenarioDim) - selRef <- selScen(refScenario) + sel_refScen <- list(scenario = refScenario) otherScens <- setdiff(scens, refScenario) years <- getYears(smoothed, as.integer = TRUE) if (is.null(lastHistYear)) { # detect the historical period as the leading run of years for which all # scenarios in the (unsmoothed) input share identical values - refArr <- as.array(x[, , selRef]) - otherArrs <- lapply(otherScens, function(s) as.array(x[, , selScen(s)])) + refArr <- x[, , sel_refScen] + otherArrs <- x[, , list(scenario = otherScens)] for (i in seq_along(years)) { - sameThisYear <- all(vapply(otherArrs, function(a) { - isTRUE(all.equal(a[, i, ], refArr[, i, ], check.attributes = FALSE)) - }, logical(1))) + sameThisYear <- all(refArr[, i, ] == otherArrs[, i, ]) if (!sameThisYear) break lastHistYear <- years[i] } @@ -97,7 +91,7 @@ toolHistoricallyConsistentSmoothing <- function(x, if (verbose) message("Detected last historical year: ", lastHistYear) } - if (!any(years <= lastHistYear)) { + if(min(years) > lastHistYear) { warning("No years <= lastHistYear (", lastHistYear, ") in data. Returning plainly smoothed object.") return(smoothed) } @@ -105,22 +99,13 @@ toolHistoricallyConsistentSmoothing <- function(x, warning("lastHistYear >= last data year. All scenarios are replaced by refScenario values.") } - histYears <- years[years <= lastHistYear] - fadeYears <- years[years > lastHistYear & years <= lastHistYear + fadeLength] - - ref <- smoothed[, , selRef] - refFade <- as.array(ref[, fadeYears, ]) - # prepare the fade weights - tNorm <- (fadeYears - lastHistYear) / fadeLength - w <- 6 * tNorm^5 - 15 * tNorm^4 + 10 * tNorm^3 + # prepare the fade weights: use C2-continuous smootherstep polynomial (see description) to transition from 0 to 1 + tNorm <- pmax(0, pmin(1, (years - lastHistYear) / fadeLength)) + w <- new.magpie(years = years, fill = (6 * tNorm^5 - 15 * tNorm^4 + 10 * tNorm^3)) for (s in otherScens) { - sel <- selScen(s) - # overwrite history with the shared reference trajectory - smoothed[, histYears, sel] <- ref[, histYears, ] - # fade from reference to scenario-specific spline (w broadcast over region/data dims) - sFade <- as.array(smoothed[, fadeYears, sel]) - smoothed[, fadeYears, sel] <- sweep(refFade, 2, 1 - w, `*`) + sweep(sFade, 2, w, `*`) + # overwrite hist period with refScen, then fade from reference to scenario-specific spline + smoothed[, , s] <- (1 - w) * smoothed[, , sel_refScen] + w * smoothed[, , s] } return(smoothed) } diff --git a/README.md b/README.md index 4c585144..051ed3f5 100644 --- a/README.md +++ b/README.md @@ -46,7 +46,7 @@ A BibTeX entry for LaTeX users is @Misc{, title = {mrmfa: Input data generation for the REMIND MFA}, author = {Jakob Dürrwächter and Bennet Weiss and Leonie Schweiger and Falk Benke and Merlin Jo Hosak and Qianzhi Zhang}, - date = {2026-07-05}, + date = {2026-07-10}, year = {2026}, url = {https://github.com/pik-piam/mrmfa}, note = {Version: 1.12.0}, diff --git a/man/toolHistoricallyConsistentSmoothing.Rd b/man/toolHistoricallyConsistentSmoothing.Rd index 560ec5e2..3f6c2b61 100644 --- a/man/toolHistoricallyConsistentSmoothing.Rd +++ b/man/toolHistoricallyConsistentSmoothing.Rd @@ -8,7 +8,6 @@ toolHistoricallyConsistentSmoothing( x, lastHistYear = NULL, refScenario = "SSP2", - scenarioDim = "scenario", fadeLength = 10, dof = 8, verbose = FALSE, @@ -16,7 +15,7 @@ toolHistoricallyConsistentSmoothing( ) } \arguments{ -\item{x}{A magpie object.} +\item{x}{A magpie object with a 'scenario' dimension.} \item{lastHistYear}{Integer or NULL. Last year considered historical. If NULL (default), it is detected automatically as the last year up to which @@ -26,14 +25,11 @@ there even where scenarios originally differ. Ignored if x contains a single scenario.} \item{refScenario}{Character. Name of the scenario whose smoothed values -define the shared history (default "SSP2").} +define the shared history (default "SSP2"). Must be located in 'scenario' +dimension of \code{x}. Ignored if x contains a single scenario.} -\item{scenarioDim}{Character. Name of the (sub)dimension holding the -scenarios (default "scenario"). If x has no such dimension, the object is -smoothed as a whole without any harmonization.} - -\item{fadeLength}{Integer >= 0. Length of the transition window in years. -0 produces a hard splice, which is generally discontinuous.} +\item{fadeLength}{Integer > 0. Length of the transition window in years. +1 produces a hard splice, which is generally discontinuous.} \item{dof}{Degrees of freedom passed to \link[madrat]{toolTimeSpline}.} @@ -60,8 +56,7 @@ faded from the reference trajectory to its own trajectory over \eqn{w(t) = 6t^5 - 15t^4 + 10t^3}, whose first and second derivatives vanish at both endpoints. The blended curve therefore matches the slope of the shared history at the start of the fade window and the slope of the -scenario-specific spline at its end, yielding a (at least) C1-continuous, -in fact C2-continuous, transition. +scenario-specific spline at its end, yielding a C2-continuous transition. } \author{ Bennet Weiss diff --git a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R index e9521587..003580d8 100644 --- a/tests/testthat/test-toolHistoricallyConsistentSmoothing.R +++ b/tests/testthat/test-toolHistoricallyConsistentSmoothing.R @@ -34,7 +34,7 @@ test_that("historical values are identical across scenarios", { test_that("transition is smooth (no kink) and continuous compared to hard splice", { x <- makeTestData() res <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = 10) - hard <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = 0) + hard <- toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = 1) years <- magclass::getYears(res, as.integer = TRUE) # kink (second difference) at the transition is smaller for the faded version @@ -104,7 +104,7 @@ test_that("invalid inputs raise errors and edge cases warn", { "not found" ) expect_error( - toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = -1), + toolHistoricallyConsistentSmoothing(x, lastHistYear = 2020, fadeLength = 0), "fadeLength" ) expect_warning( From 899cc92ee520e428294309c399b4a3965764daf9 Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Fri, 10 Jul 2026 17:15:00 +0200 Subject: [PATCH 7/8] update documentation --- R/calcCeFloorspaceEDGEB.R | 3 ++- man/calcCeFloorspaceEDGEB.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/calcCeFloorspaceEDGEB.R b/R/calcCeFloorspaceEDGEB.R index 92a791f2..b3c32ba8 100644 --- a/R/calcCeFloorspaceEDGEB.R +++ b/R/calcCeFloorspaceEDGEB.R @@ -2,7 +2,8 @@ #' #' @param scenarios EDGE-B scenarios (character vector or string). Available: "SSP1", "SSP2", "SSP3", "SSP4", "SSP5". #' @param collapse Logical. If TRUE, redundant dimensions (e.g. scenario if only one requested) are removed. -#' @param smooth Logical. If TRUE, data is smoothed using spline interpolation. +#' @param smooth Logical. If TRUE, data is smoothed using spline interpolation +#' (see \link{toolHistoricallyConsistentSmoothing}); smoothed historical values are identical across scenarios. #' @param dof Integer. Degrees of freedom for spline interpolation. #' @author Bennet Weiss calcCeFloorspaceEDGEB <- function(scenarios = "SSP2", collapse = TRUE, smooth = FALSE, dof = 8) { diff --git a/man/calcCeFloorspaceEDGEB.Rd b/man/calcCeFloorspaceEDGEB.Rd index a29d4ce8..7bac9b61 100644 --- a/man/calcCeFloorspaceEDGEB.Rd +++ b/man/calcCeFloorspaceEDGEB.Rd @@ -16,7 +16,8 @@ calcCeFloorspaceEDGEB( \item{collapse}{Logical. If TRUE, redundant dimensions (e.g. scenario if only one requested) are removed.} -\item{smooth}{Logical. If TRUE, data is smoothed using spline interpolation.} +\item{smooth}{Logical. If TRUE, data is smoothed using spline interpolation +(see \link{toolHistoricallyConsistentSmoothing}); smoothed historical values are identical across scenarios.} \item{dof}{Integer. Degrees of freedom for spline interpolation.} } From ca1fc4534295affac83bb00f88ee05621d18d585 Mon Sep 17 00:00:00 2001 From: Bennet Weiss Date: Fri, 10 Jul 2026 17:21:47 +0200 Subject: [PATCH 8/8] fix indentation --- R/toolHistoricallyConsistentSmoothing.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/toolHistoricallyConsistentSmoothing.R b/R/toolHistoricallyConsistentSmoothing.R index 62661751..3dd48a68 100644 --- a/R/toolHistoricallyConsistentSmoothing.R +++ b/R/toolHistoricallyConsistentSmoothing.R @@ -91,7 +91,7 @@ toolHistoricallyConsistentSmoothing <- function( if (verbose) message("Detected last historical year: ", lastHistYear) } - if(min(years) > lastHistYear) { + if(min(years) > lastHistYear) { warning("No years <= lastHistYear (", lastHistYear, ") in data. Returning plainly smoothed object.") return(smoothed) }