Merge branch 'master' of github.com:pik-piam/mip

pik-piam · Jan 16, 2024 · 039d309 · 039d309
2 parents 535936e + 59ecac7
commit 039d309
Show file tree

Hide file tree

Showing 19 changed files with 401 additions and 220 deletions.
diff --git a/.buildlibrary b/.buildlibrary
@@ -1,4 +1,4 @@
-ValidationKey: '28140672'
+ValidationKey: '28951650'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'
@@ -8,5 +8,6 @@ AcceptedNotes:
 - unable to verify current time
 - File .mip/R/onLoad\.R.:\W+\.onLoad calls:\W+packageStartupMessage
 - no visible binding for global variable ‘.’
+- checking installed package size
 AutocreateReadme: yes
 allowLinterWarnings: yes
diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml
@@ -1,5 +1,3 @@
-# Run CI for R using https://eddelbuettel.github.io/r-ci/
-
 name: check
 
 on:
@@ -8,92 +6,45 @@ on:
   pull_request:
     branches: [main, master]
 
-env:
-  USE_BSPM: "true"
-  _R_CHECK_FORCE_SUGGESTS_: "false"
-  NO_BINARY_INSTALL_R_PACKAGES: 'c("madrat", "magclass", "citation", "gms", "goxygen", "GDPuc", "roxygen2")'
-
 jobs:
   check:
     runs-on: ubuntu-latest
 
     steps:
       - uses: actions/checkout@v3
 
-      - name: Bootstrap
-        run: |
-          sudo chown runner -R .
-          sudo locale-gen en_US.UTF-8
-          sudo add-apt-repository -y ppa:ubuntugis/ppa
-          curl -OLs https://eddelbuettel.github.io/r-ci/run.sh
-          chmod 0755 run.sh
-          ./run.sh bootstrap
-          rm -f bspm_*.tar.gz
-
-      - name: Enable r-universe repo, modify bspm integration
-        run: |
-          # install packages from https://pik-piam.r-universe.dev and CRAN
-          echo '
-          options(repos = c(universe = "https://pik-piam.r-universe.dev",
-                            CRAN = "https://cloud.r-project.org"))
-          ' >> .Rprofile
-          cat .Rprofile
-          # modify bspm integration to never install binary builds of PIK CRAN packages
-          sudo sed -i '/bspm::enable()/d' /etc/R/Rprofile.site
-          # need double % because of printf, %s is replaced with "$NO_BINARY_INSTALL_R_PACKAGES" (see "env:" above)
-          printf '
-          local({
-            expr <- quote({
-              if (!is.null(repos)) {
-                noBinaryInstallRPackages <- %s
-                pkgs <- c(bspm::install_sys(pkgs[!pkgs %%in%% noBinaryInstallRPackages]),
-                          pkgs[pkgs %%in%% noBinaryInstallRPackages])
-              }
-              type <- "source"
-            })
-            trace(utils::install.packages, expr, print = FALSE)
-          })
-          ' "$NO_BINARY_INSTALL_R_PACKAGES" | sudo tee --append /etc/R/Rprofile.site >/dev/null
-          cat /etc/R/Rprofile.site
-
-      - name: Set up Pandoc
-        uses: r-lib/actions/setup-pandoc@v2
+      - uses: r-lib/actions/setup-pandoc@v2
 
-      - name: Set up Python 3.9
-        uses: actions/setup-python@v4
+      - uses: r-lib/actions/setup-r@v2
         with:
-          python-version: 3.9
+          use-public-rspm: true
+          extra-repositories: "https://rse.pik-potsdam.de/r/packages"
 
-      - name: Cache R libraries
-        if: ${{ !env.ACT }} # skip when running locally via nektos/act
-        uses: pat-s/always-upload-cache@v3
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          path: /usr/local/lib/R/
-          key: 3-${{ runner.os }}-usr-local-lib-R-${{ hashFiles('DESCRIPTION') }}
-          restore-keys: |
-            3-${{ runner.os }}-usr-local-lib-R-
-
-      - name: Restore R library permissions
-        run: |
-          sudo chmod 2777 /usr/local/lib/R /usr/local/lib/R/site-library
-
-      - name: Install dependencies
-        run: |
-          ./run.sh install_aptget libhdf5-dev libharfbuzz-dev libfribidi-dev
-          ./run.sh install_all
-          ./run.sh install_r_binary covr rstudioapi
-          ./run.sh install_r lucode2
+          extra-packages: |
+            gamstransfer=?ignore
+            any::lucode2
+            any::covr
+            any::madrat
+            any::magclass
+            any::citation
+            any::gms
+            any::goxygen
+            any::GDPuc
+          # piam packages also available on CRAN (madrat, magclass, citation,
+          # 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
+        with:
+          python-version: 3.9
 
       - name: Install python dependencies if applicable
         run: |
           [ -f requirements.txt ] && python -m pip install --upgrade pip wheel || true
           [ -f requirements.txt ] && pip install -r requirements.txt || true
 
-      - name: Remove bspm integration # to get rid of error when running install.packages
-        run: |
-          sudo sed -i '/  trace(utils::install.packages, expr, print = FALSE)/d' /etc/R/Rprofile.site
-          cat /etc/R/Rprofile.site
-
       - name: Verify validation key
         shell: Rscript {0}
         run: lucode2:::validkey(stopIfInvalid = TRUE)
@@ -106,6 +57,8 @@ jobs:
 
       - name: Test coverage
         shell: Rscript {0}
-        run: covr::codecov(quiet = FALSE)
+        run: |
+          nonDummyTests <- setdiff(list.files("./tests/testthat/"), c("test-dummy.R", "_snaps"))
+          if(length(nonDummyTests) > 0) covr::codecov(quiet = FALSE)
         env:
           NOT_CRAN: "true"
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -3,7 +3,7 @@
 exclude: '^tests/testthat/_snaps/.*$'
 repos:
 -   repo: https://github.com/pre-commit/pre-commit-hooks
-    rev: v4.4.0
+    rev: v4.5.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.9007
+    rev: v0.3.2.9025
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

diff --git 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: 'mip: Comparison of multi-model runs'
-version: 0.144.4
-date-released: '2023-05-11'
+version: 0.147.0
+date-released: '2023-12-04'
 abstract: Package contains generic functions to produce comparison plots of multi-model
   runs.
 authors:

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: mip
 Title: Comparison of multi-model runs
-Version: 0.144.4
-Date: 2023-05-11
+Version: 0.147.0
+Date: 2023-12-04
 Authors@R: c(
     person("David", "Klein", , "[email protected]", role = c("aut", "cre")),
     person("Jan Philipp", "Dietrich", , "[email protected]", role = "aut"),

diff --git a/Makefile b/Makefile
@@ -11,8 +11,9 @@ HELP_PARSING = 'm <- readLines("Makefile");\
 help:           ## Show this help.
 	@Rscript -e $(HELP_PARSING)
 
-build:          ## Build the package using lucode2::buildLibrary().
-	Rscript -e 'lucode2::buildLibrary()'
+build:          ## Build the package using lucode2::buildLibrary(). You can pass the
+                ## updateType with 'make build u=3'
+	Rscript -e 'lucode2::buildLibrary(updateType = "$(u)")'
 
 check:          ## Build documentation and vignettes, run testthat tests,
                 ## and check if code etiquette is followed using lucode2::check().

diff --git a/NAMESPACE b/NAMESPACE
@@ -15,6 +15,7 @@ export(plotstyle)
 export(plotstyle.add)
 export(scenTool)
 export(scenToolMAgPIE)
+export(scratchBar)
 export(shorten_legend)
 export(showAreaAndBarPlots)
 export(showAreaAndBarPlotsPlus)

diff --git a/R/harmonize.R b/R/harmonize.R
@@ -1,6 +1,6 @@
 #' Harmonization of model data to historical data, using harmonization methods
 #' of aneris, ported to R.
-#' See: https://github.com/iiasa/aneris/blob/master/aneris/methods.py
+#' See: https://github.com/iiasa/aneris/blob/ad6301eb42155c968f20b2c7e071cbec039acc03/aneris/methods.py
 
 #' @author Falk Benke
 #' @param df data frame with model data to be harmonized, must have the following columns:
@@ -19,6 +19,11 @@ harmonize <- function(df, hist, finalYear = "2050", harmonizeYear = "2015", meth
     stop("Invalid method. Options are 'offset' and 'ratio'.")
   }
 
+  if (!all(c("region", "period", "variable", "value", "model", "scenario", "unit") %in% colnames(df)) ||
+    length(colnames(df)) != 7) {
+    stop("df must contain columns: region, period, variable, value, model, scenario, unit")
+  }
+
   .reduceRatio <- function(df, hist, finalYear = "2050", harmonizeYear = "2015") {
     # harmonize factors
     c <- hist[, harmonizeYear]
@@ -77,8 +82,17 @@ harmonize <- function(df, hist, finalYear = "2050", harmonizeYear = "2015", meth
   # iterate over models and variables
 
   vars <- intersect(unique(df$variable), unique(hist$variable))
+
+  if (length(vars) == 0) {
+    stop("No matching variables in model data and historical data found.")
+  }
+
   regions <- intersect(unique(df$region), unique(hist$region))
 
+  if (length(regions) == 0) {
+    stop("No matching regions in model data and historical data found.")
+  }
+
   hist <- hist %>%
     filter(!is.na(!!sym("value")), !!sym("variable") %in% vars, !!sym("region") %in% regions) %>%
     reshape2::dcast(formula = ... ~ period)

diff --git a/R/mip-package.R b/R/mip-package.R
@@ -1,5 +1,3 @@
-
-
 #' The MIP R package
 #' 
 #' Contains the routines for plotting multi model and multi scenario comparisons
@@ -10,8 +8,7 @@
 #' 
 #' @name mip-package
 #' @aliases mip-package mip
-#' @docType package
 #' @author David Klein
 #' 
 #' Maintainer: Anastasis Giannousakis <giannou@@pik-potsdam.de>
-NULL
+"_PACKAGE"
diff --git a/R/mipIterations.R b/R/mipIterations.R
@@ -17,6 +17,8 @@
 #'                      plotly. If NULL no slider is used.
 #' @param facets        A string from names(x), defining which column is used for grouping. A small plot (facet) is
 #'                      shown for each group. If NULL facets are not used.
+#' @param facetScales   The 'scales' argument for facets (if used), defaults to 'fixed'. See help(facet_wrap) for more info.
+#'
 #' @return A list of plotly plots, if returnGgplots is TRUE a list of ggplots instead
 #' @author Pascal Führlich
 #' @seealso \code{\link{getPlotData}}
@@ -27,7 +29,8 @@
 #' @importFrom utils tail
 #' @export
 mipIterations <- function(plotData, returnGgplots = FALSE,
-                          xAxis = "year", color = NULL, slider = "iteration", facets = "region") {
+                          xAxis = "year", color = NULL, slider = "iteration", facets = "region",
+                          facetScales = "fixed") {
   nonNullArgs <- Filter(Negate(is.null), c(xAxis, color, slider, facets))
   if (any(!(nonNullArgs %in% c(names(plotData), "year", "region")))) {
     stop(
@@ -88,11 +91,12 @@ mipIterations <- function(plotData, returnGgplots = FALSE,
 
   # all combinations of values of columns not plotted (not mapped to x/y/color etc.)
   plottedColumns <- c(xAxis, color, slider, facets, valueColumnName)
-  unplottedCombinations <- unique(plotData[!(names(plotData) %in% plottedColumns)])
-  unplottedCombinations <- lapply(split(unplottedCombinations, seq_len(nrow(unplottedCombinations))), as.list)
 
-  if (identical(length(unplottedCombinations), 0L)) {
+  if (length(plottedColumns) == ncol(plotData)) {
     unplottedCombinations <- list(list())
+  } else {
+    unplottedCombinations <- unique(plotData[!(names(plotData) %in% plottedColumns)])
+    unplottedCombinations <- lapply(split(unplottedCombinations, seq_len(nrow(unplottedCombinations))), as.list)
   }
 
   # create a plot for each combination of unplotted values (not mapped to an aesthetic)
@@ -114,9 +118,9 @@ mipIterations <- function(plotData, returnGgplots = FALSE,
       theme(strip.background = element_blank())
     if (!is.null(facets)) {
       # by default create a small plot for each region; always show all facets, even if empty
-      plot <- plot + facet_wrap(facets, drop = FALSE)
+      plot <- plot + facet_wrap(facets, drop = FALSE, scales = facetScales)
     }
-    if (!is.null(color) & is.numeric(plotData[[color]])) {
+    if (!is.null(color) && is.numeric(plotData[[color]])) {
       plot <- plot + scale_color_gradientn(colours = rainbow(5, v = 0.8))
     }
     return(plot)

diff --git a/R/mipLineHistorical.R b/R/mipLineHistorical.R
@@ -255,11 +255,11 @@ mipLineHistorical <- function(x,x_hist=NULL,color.dim="identifier",linetype.dim=
     #color: show only model_output
     #fill: add colors for historical and keep shape symbol
     #alpha: add colors for projection depending on leg.proj
-    p <- p + scale_color_manual(color.dim.name,values = color_set, breaks=model_output,labels=sub("\\."," ",model_output),guide=guide_legend(order=1,title.position = "top", ncol=legend.ncol))
+    p <- p + scale_color_manual(color.dim.name,values = color_set, breaks=model_output,labels=model_output,guide=guide_legend(order=1,title.position = "top", ncol=legend.ncol))
     p <- p + scale_fill_manual("Historical data",values = color_set[historical],breaks=historical,
-                               guide=guide_legend(override.aes = list(colour=color_set[historical],shape="+",linetype=0,linewidth=5),order=2,title.position = "top", ncol=legend.ncol))
-    if(leg.proj) p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=sub("\\."," ",projection),guide=guide_legend(override.aes = list(colour=color_set[projection],shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol))
-    else p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=sub("\\."," ",projection),guide=guide_legend(override.aes = list(colour="#A1A194",shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol))
+                               guide=guide_legend(override.aes = list(colour=color_set[historical],shape="+",linetype=0,size=5),order=2,title.position = "top", ncol=legend.ncol))
+    if(leg.proj) p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=projection,guide=guide_legend(override.aes = list(colour=color_set[projection],shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol))
+    else p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=projection,guide=guide_legend(override.aes = list(colour="#A1A194",shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol))
     p <- p + guides(linetype=guide_legend(order=4,title.position="top",ncol=legend.ncol))
 
     return(p)