Merge pull request #3 from deleip/hardcore

move of technical tool functions from mrcommons

.buildlibrary

@@ -1,7 +1,8 @@
-ValidationKey: '789480'
+ValidationKey: '1191000'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'
 AcceptedNotes: ~
 allowLinterWarnings: yes
+enforceVersionUpdate: no

.github/workflows/check.yaml

@@ -11,7 +11,7 @@ jobs:
     runs-on: ubuntu-latest
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -23,7 +23,6 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: |
-            gamstransfer=?ignore
             any::lucode2
             any::covr
             any::madrat
@@ -36,7 +35,7 @@ jobs:
           # gms, goxygen, GDPuc) will usually have an outdated binary version
           # available; by using extra-packages we get the newest version
 
-      - uses: actions/setup-python@v4
+      - uses: actions/setup-python@v5
         with:
           python-version: 3.9
 
@@ -49,6 +48,11 @@ jobs:
         shell: Rscript {0}
         run: lucode2:::validkey(stopIfInvalid = TRUE)
 
+      - name: Verify that lucode2::buildLibrary was successful
+        if: github.event_name == 'pull_request'
+        shell: Rscript {0}
+        run: lucode2:::isVersionUpdated()
+
       - name: Checks
         shell: Rscript {0}
         run: |

.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.3.2.9025
+    rev: 7910e0323d7213f34275a7a562b9ef0fde8ce1b9  # frozen: v0.4.2
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

CITATION.cff

@@ -1,16 +1,21 @@
 cff-version: 1.2.0
 message: If you use this software, please cite it using the metadata from this file.
 type: software
-title: 'mstools: Tool functions that can be used by several madrat-dependent or magpie4
-  output functions'
-version: 0.4.0
-date-released: '2024-01-15'
+title: |-
+  mstools: Tool functions that can be used by several madrat-dependent or
+      magpie4 output functions
+version: 0.6.0
+date-released: '2024-05-07'
 abstract: Tool functions that can be used by several madrat-dependent or magpie4 output
   functions.
 authors:
 - family-names: Bodirsky
   given-names: Benjamin Leon
   email: [email protected]
+- family-names: Karstens
+  given-names: Kristine
+- family-names: Beier
+  given-names: Felicitas
 - family-names: Dietrich
   given-names: Jan Philipp
   email: [email protected]

DESCRIPTION

@@ -1,20 +1,29 @@
-Package: mstools
 Type: Package
-Title: Tool functions that can be used by several madrat-dependent or magpie4 output functions
-Version: 0.4.0
-Date: 2024-01-15
-Authors@R: c(person("Benjamin Leon", "Bodirsky", email = "[email protected]", role = c("aut","cre")),
-		          person("Jan Philipp", "Dietrich", email = "[email protected]", role = "aut"))
-Description: Tool functions that can be used by several madrat-dependent or magpie4 output functions.
+Package: mstools
+Title: Tool functions that can be used by several madrat-dependent or
+    magpie4 output functions
+Version: 0.6.0
+Date: 2024-05-07
+Authors@R: c(
+    person("Benjamin Leon", "Bodirsky", , "[email protected]", role = c("aut", "cre")),
+    person("Kristine", "Karstens", role = "aut"),
+    person("Felicitas", "Beier", role = "aut"),
+    person("Jan Philipp", "Dietrich", , "[email protected]", role = "aut")
+  )
+Description: Tool functions that can be used by several madrat-dependent
+    or magpie4 output functions.
+License: LGPL-3 | file LICENSE
+URL: https://github.com/pik-piam/magpie4,
+    https://doi.org/10.5281/zenodo.1158582
+BugReports: https://github.com/pik-piam/magpie4/issues
 Depends:
-    magclass(>= 2.40),
-    madrat
+    madrat,
+    magclass (>= 2.40)
 Imports:
-URL: https://github.com/pik-piam/magpie4, https://doi.org/10.5281/zenodo.1158582
-BugReports: https://github.com/pik-piam/magpie4/issues
-Encoding: UTF-8
-License: LGPL-3 | file LICENSE
-RoxygenNote: 7.2.3
+    magpiesets,
+    stringr
 Suggests: 
-    testthat,
-    covr
+    covr,
+    testthat
+Encoding: UTF-8
+RoxygenNote: 7.3.1

NAMESPACE

@@ -1,16 +1,39 @@
 # Generated by roxygen2: do not edit by hand
 
+export(toolAggregateCell2Country)
+export(toolCell2isoCell)
+export(toolConv2CountryByCelltype)
+export(toolCoord2Isocell)
+export(toolCoord2Isocoord)
+export(toolCountryFillBilateral)
 export(toolExpectLessDiff)
 export(toolExpectTrue)
 export(toolFertilizerDistribution)
+export(toolFreezeEffect)
+export(toolGetMappingCoord2Country)
+export(toolHarmonize2Baseline)
 export(toolHoldConstant)
+export(toolHoldConstantBeyondEnd)
+export(toolIso2CellCountries)
 export(toolIsocode2Country)
+export(toolSmooth)
 export(toolStatusMessage)
+export(toolSum2Country)
 import(madrat)
 import(magclass)
 importFrom(madrat,toolAggregate)
+importFrom(madrat,toolOrderCells)
+importFrom(madrat,toolTimeAverage)
+importFrom(madrat,toolTimeSpline)
 importFrom(madrat,vcat)
 importFrom(magclass,"getYears<-")
+importFrom(magclass,collapseDim)
+importFrom(magclass,getItems)
 importFrom(magclass,getRegions)
 importFrom(magclass,getYears)
+importFrom(magpiesets,addLocation)
+importFrom(magpiesets,findset)
+importFrom(stringr,str_split)
+importFrom(utils,packageVersion)
+importFrom(utils,read.csv)
 importFrom(utils,read.csv2)

R/imports.R

@@ -1,4 +1,4 @@
 # Generated by lucode2: do not edit by hand
 
-#' @import magclass madrat
+#' @import madrat magclass
 NULL

R/toolAggregateCell2Country.R

@@ -0,0 +1,28 @@
+#' toolAggregateCell2Country
+#'
+#' Aggregate cellular data (with coordinate information) to countries and perform consistency checks
+#' @param x cellular magpie object with coordinates
+#' @param weight aggregation weight
+#' @param ... additional options forwarded to `toolCountryFill`
+#' @return return country ISO level data
+#' @author Jan Philipp Dietrich
+#' @importFrom magclass getItems
+#' @export
+
+toolAggregateCell2Country <- function(x, weight = NULL, ...) {
+
+  map <- toolGetMappingCoord2Country(extended = TRUE)
+
+  unknown <- which(!(getItems(x, dim = 1) %in% map$coords))
+  if (length(unknown) > 0) {
+    warning(length(unknown), " entries of x could not be mapped to a country and will be ignored!")
+    x <- x[-unknown, , ]
+  }
+
+  out <- toolAggregate(x, map, from = 2, partrel = TRUE, weight = weight[getItems(x, dim = 1), , ])
+
+  # island states are NAs: will be set to 0
+  out <- toolCountryFill(out, ...)
+
+  return(out)
+}

R/toolCell2isoCell.R

@@ -0,0 +1,20 @@
+#' toolCell2isoCell
+#'
+#' Sets cell names to "iso country code"."cell number"
+#' @param x magpie object on cellular level
+#' @param cells switch between magpie cells (59199) and lpj cells (67420)
+#' @return return changed input data
+#' @author Kristine Karstens
+#'
+#' @importFrom utils read.csv
+#' @export
+
+toolCell2isoCell <- function(x, cells = "magpiecell") {
+
+  if (cells == "magpiecell") {
+    cellToCellIso <- toolGetMapping(name = "CountryToCellMapping.rds", where = "mrcommons")
+    getCells(x)   <- cellToCellIso$celliso
+  }
+
+   return(x)
+}

R/toolConv2CountryByCelltype.R

@@ -0,0 +1,16 @@
+#' toolConv2CountryByCelltype
+#'
+#' Aggregates cellular data to ISO country level after conversion of cellular
+#' data to a specific cell setup (this type is relevant as some settings,
+#' such as "magpiecell" remove some cells and therby affect country sums)
+#' @param x magpie object on cellular level
+#' @param cells switch between 59199 ("magpiecell") and 67420 ("lpjcell") cells
+#' @return return selected input data on ISO country level
+#' @author Jan Philipp Dietrich
+#' @export
+
+toolConv2CountryByCelltype <- function(x, cells) {
+  getSets(x, fulldim = FALSE)[1] <- "x.y.iso"
+  out   <- toolCoord2Isocell(x, cells = cells)
+  return(toolSum2Country(out))
+}

R/toolCoord2Isocell.R

@@ -0,0 +1,37 @@
+#' @title       toolCoord2Isocell
+#' @description Transforms an object with coordinate spatial data (on half-degree)
+#'              to isocell (59199) standard
+#'
+#' @param x     Object to be transformed from coordinates to (old) magpie isocell standard
+#' @param cells Switch between "magpiecell" (59199) and "lpjcell" (67420)
+#'
+#' @return magpie object with 59199 cells in isocell naming
+#' @author Kristine Karstens, Felicitas Beier, Jan Philipp Dietrich
+#'
+#' @param cells Switch between "magpiecell" (59199) and "lpjcell" (67420)
+#' @param fillMissing if NULL cells missing from the total 59199 are just being ignore. If set to a value
+#' missing cells will be added with this value (e.g. all set to 0 if fillMissing is 0)
+#' @param warnMissing Switch which controls whether missing cells should trigger a warning or not
+#' @importFrom magpiesets addLocation
+#' @importFrom madrat toolOrderCells
+#' @importFrom magclass collapseDim
+#' @importFrom utils packageVersion
+#'
+#' @export
+
+toolCoord2Isocell <- function(x, cells = "magpiecell", fillMissing = NULL, warnMissing = TRUE) {
+  if (cells == "magpiecell") {
+    removedim <- setdiff(unlist(strsplit(names(getItems(x))[1], "\\.")), c("x", "y"))
+    x <- collapseDim(x, dim = removedim)
+    x <- addLocation(x, fillMissing = fillMissing, naCellNumber = "NA")
+    x <- collapseDim(x, dim = c("x", "y"))
+    x <- toolOrderCells(x, na.rm = TRUE)
+    if (warnMissing && length(getCells(x)) != 59199) warning("Some cells out of the 59199 standard cells are missing.")
+  } else if (cells == "lpjcell") {
+    getItems(x, dim = "cell",   maindim = 1) <- 1:67420
+    x <- collapseDim(x, dim = c("x", "y"))
+  } else {
+    stop("Unknown cells argument.")
+  }
+  return(x)
+}

R/toolCoord2Isocoord.R

@@ -0,0 +1,31 @@
+#' @title       toolCoord2Isocoord
+#' @description Transforms an object with coordinate spatial data (on half-degree)
+#'              to object with 67420 cells and coordinate and iso country information
+#'
+#' @param x     object to be transformed from coordinates to iso-coordinate object
+#'
+#' @return magpie object with 67420 cells in x.y.iso naming
+#' @author Felicitas Beier
+#'
+#'
+#' @export
+
+toolCoord2Isocoord <- function(x) {
+
+    # coordinate to country mapping for 67420 cells
+    mapping <- toolGetMappingCoord2Country()
+    mapping$coordiso <- paste(mapping$coords,
+                              mapping$iso,
+                              sep = ".")
+
+    # sort first dimension as provided by mapping
+    x <- x[mapping$coords, , ]
+    # rename first dimension
+    getItems(x, dim = 1, raw = TRUE) <- mapping$coordiso
+    # set names
+    getSets(x)["d1.1"] <- "x"
+    getSets(x)["d1.2"] <- "y"
+    getSets(x)["d1.3"] <- "iso"
+
+  return(x)
+}

R/toolCountryFillBilateral.R

@@ -0,0 +1,19 @@
+#' @title toolCountryFillBilateral
+#' @description Fills bilateral iso-level magpie objects to 249 x 249 countries
+#' @param x input variable, a bilateral magclass object
+#' @param fill fill value, default NA
+#' @export
+
+toolCountryFillBilateral <- function(x, fill = NA) {
+  isoCountry <- read.csv2(system.file("extdata", "iso_country.csv", package = "madrat"), row.names = NULL)
+  countrylist <- as.vector(isoCountry[, "x"])
+  names(countrylist) <- isoCountry[, "X"]
+  full <- expand.grid(countrylist, countrylist)
+  full <- paste0(as.character(full[[1]]), ".", as.character(full[[2]]))
+  missing <- setdiff(full, getItems(x, dim = 1))
+  if (length(missing) > 0) {
+    x <- mbind(x, new.magpie(cells_and_regions = missing,
+                             years = getYears(x), names = getNames(x), fill = fill))
+  }
+  return(x)
+}

R/toolFreezeEffect.R

@@ -0,0 +1,44 @@
+#' @title toolFreezeEffect
+#' @description This function freeze values given a specific year and optionally additionally at the first
+#'              non-zero value
+#'
+#' @param x data set to freeze
+#' @param year year to hold constant (onwards)
+#' @param constrain if FALSE, no constrain. Other options: 'first_use' (freeze from 'first use' ( <=> !=0 ))
+#'
+#' @return magpie object with global parameters
+#' @author Kristine Karstens
+#'
+#' @export
+
+toolFreezeEffect <- function(x, year, constrain = FALSE) {
+
+  out                 <- x
+  resetYears          <- getYears(x, as.integer = TRUE) >= year
+  out[, resetYears, ] <- setYears(x[, rep(year, sum(resetYears)), ], getYears(x[, resetYears, ]))
+
+  if (constrain == "first_use") {
+    # determine year of first use (as index in year dim (1 <=> first year))
+    firstValue <- firstUse <- toolConditionalReplace(
+      magpply(x[, resetYears, ],
+              function(x) {
+                return(which(x != 0)[1])
+              },
+              c(1, 3)),
+      "is.na()",
+      1)
+    firstUse   <- firstUse + length(which(getYears(x, as.integer = TRUE) < year))
+
+    # determine value of first use
+    ncells <- length(getCells(x))
+    ndata  <- length(getNames(x))
+    nyears <- length(getYears(x))
+    firstValue[] <- x[as.array((ncells * nyears) * (rep(1:ndata, each = ncells) - 1)
+                               + ncells * (firstUse - 1) + rep(1:ncells, times = ndata))]
+
+    # set value of first usage for all later appearing later non-zero values
+    out[as.array(out == 0 & x != 0)] <- firstValue[, rep(1, nyears(x)), ][as.array(out == 0 & x != 0)]
+  }
+
+  return(out)
+}