Skip to content

Commit

Permalink
weight warnings
Browse files Browse the repository at this point in the history
  • Loading branch information
caviddhen committed Aug 5, 2024
1 parent ac7876e commit 922f740
Show file tree
Hide file tree
Showing 7 changed files with 89 additions and 83 deletions.
2 changes: 1 addition & 1 deletion .buildlibrary
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
ValidationKey: '51601536'
ValidationKey: '51704420'
AutocreateReadme: yes
AcceptedWarnings:
- 'Warning: package .* was built under R version'
Expand Down
4 changes: 2 additions & 2 deletions CITATION.cff
Original file line number Diff line number Diff line change
Expand Up @@ -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: 'mrvalidation: madrat data preparation for validation purposes'
version: 2.59.2
date-released: '2024-07-04'
version: 2.59.3
date-released: '2024-08-05'
abstract: Package contains routines to prepare data for validation exercises.
authors:
- family-names: Bodirsky
Expand Down
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Type: Package
Package: mrvalidation
Title: madrat data preparation for validation purposes
Version: 2.59.2
Date: 2024-07-04
Version: 2.59.3
Date: 2024-08-05
Authors@R: c(
person("Benjamin Leon", "Bodirsky", , "[email protected]", role = c("aut", "cre")),
person("Stephen", "Wirth", role = "aut"),
Expand Down
30 changes: 15 additions & 15 deletions R/calcValidGini.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,27 +7,27 @@

calcValidGini <- function() {

out <- readSource("WBPoverty", subtype = "Gini", convert = FALSE)
getSets(out)[3] <- "scenario"
getItems(out, dim = 3) <- "historical"
out <- readSource("WBPoverty", subtype = "Gini", convert = FALSE)
getSets(out)[3] <- "scenario"
getItems(out, dim = 3) <- "historical"

weight <- calcOutput("Population", aggregate = FALSE)[, , "pop_SSP2"]
weight <- time_interpolate(weight, interpolated_year = getYears(out),
integrate_interpolated_years = TRUE)
weight <- calcOutput("Population", aggregate = FALSE)[, , "pop_SSP2"]
weight <- time_interpolate(weight, interpolated_year = getYears(out),
integrate_interpolated_years = TRUE)

weight <- weight[getItems(out, dim = 1), getItems(out, dim = 2), ]
weight[which(out == 9999)] <- 0 # make missing data 0 weight
weight <- weight[getItems(out, dim = 1), getItems(out, dim = 2), ]
weight[which(out == 9999)] <- 0 # make missing data 0 weight

out <- add_dimension(out, dim = 3.2, add = "model", nm = "World Bank WDI")
getNames(out, dim = 1) <- "Income|Gini Coefficient (0-1)"
out <- add_dimension(out, dim = 3.2, add = "model", nm = "World Bank WDI")
getNames(out, dim = 1) <- "Income|Gini Coefficient (0-1)"

getSets(weight)[3] <- "scenario"
getItems(weight, dim = 3) <- "historical"
weight <- add_dimension(weight, dim = 3.2, add = "model", nm = "World Bank WDI")
getNames(weight, dim = 1) <- "Income|Gini Coefficient (0-1)"
getSets(weight)[3] <- "scenario"
getItems(weight, dim = 3) <- "historical"
weight <- add_dimension(weight, dim = 3.2, add = "model", nm = "World Bank WDI")
getNames(weight, dim = 1) <- "Income|Gini Coefficient (0-1)"

return(list(x = out,
weight = weight,
weight = weight + 10^-10,
unit = "(0-1) Gini Coefficient between 0 and 1",
description = "Gini Coefficient")
)
Expand Down
120 changes: 63 additions & 57 deletions R/calcValidPriceIndex.R
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
#' @title calcValidPriceIndex
#'
#' @description provides global producer price index from FAO
#'
#' @param datasource Options of the source of data: \code{FAO}.
#' @description provides global producer price index from FAO
#'
#' @param datasource Options of the source of data: \code{FAO}.
#' @param value \code{real} and \code{nominal}
#' @param baseyear Baseyear for normalizing of price index.
#' @param round Rounding of price index to intiger numbers. Default \code{TRUE}.
Expand All @@ -12,80 +12,86 @@
#' @seealso
#' \code{\link{readProdPrIndex}}
#' @examples
#'
#' \dontrun{ a <- calcOutput("ValidPriceIndex", value="real", aggregate=FALSE)
#' \dontrun{
#' a <- calcOutput("ValidPriceIndex", value = "real", aggregate = FALSE)
#' }
#'
#'
#' @importFrom magpiesets findset reporthelper
#' @importFrom magclass wrap setNames
#' @importFrom madrat toolAggregate toolGetMapping

calcValidPriceIndex <- function(datasource="FAO", value="real", baseyear="y2005", round=TRUE){
if(datasource=="FAO"){
calcValidPriceIndex <- function(datasource = "FAO", value = "real", baseyear = "y2005", round = TRUE) {
if (datasource == "FAO") {
# FAO prices (already in dm values)
p_t <- calcOutput("PriceAgriculture", datasource=datasource, aggregate=FALSE)
pT <- calcOutput("PriceAgriculture", datasource = datasource, aggregate = FALSE)
## set prices p_t back to magpie names
p_t <- collapseNames(p_t)
pT <- collapseNames(pT)

# FAO production
q_t <- calcOutput("FAOharmonized", aggregate=FALSE)
aggregation <- toolGetMapping("FAOitems.rda","sectoral",where="mrvalidation")
q_t <- toolAggregate(q_t[,,"production"], rel=aggregation, from="FoodBalanceItem",
to="k", dim=3.1, partrel = TRUE, verbosity=2)
q_t <- collapseNames(q_t)
qT <- calcOutput("FAOharmonized", aggregate = FALSE)
aggregation <- toolGetMapping("FAOitems.rda", "sectoral", where = "mrvalidation")
qT <- toolAggregate(qT[, , "production"], rel = aggregation, from = "FoodBalanceItem",
to = "k", dim = 3.1, partrel = TRUE, verbosity = 2)
qT <- collapseNames(qT)
## convert FAO production to DM tonnes
dm <- 1/readSource("ProductAttributes","Products")[,,"wm"]
dm <- 1 / readSource("ProductAttributes", "Products")[, , "wm"]
dm <- collapseNames(dm)
### common years and names dm factors, quantities and prices
comms <- intersect(intersect(getNames(dm),getNames(q_t)), getNames(p_t))
ys <- intersect(getYears(p_t),getYears(q_t))[-1]
q_t <- q_t[,ys,comms]*dm[,,comms]
p_t <- p_t[,ys,comms]
# create baseyear values
q_0 <- q_t
p_0 <- p_t
for(y in intersect(getYears(p_t),getYears(q_t))){
q_0[,y,] <- setYears(q_t[,baseyear,],y)
p_0[,y,] <- setYears(p_t[,baseyear,],y)
comms <- intersect(intersect(getNames(dm), getNames(qT)), getNames(pT))
ys <- intersect(getYears(pT), getYears(qT))[-1]
qT <- qT[, ys, comms] * dm[, , comms]
pT <- pT[, ys, comms]

# create baseyear values
q0 <- qT
p0 <- pT
for (y in intersect(getYears(pT), getYears(qT))) {
q0[, y, ] <- setYears(qT[, baseyear, ], y)
p0[, y, ] <- setYears(pT[, baseyear, ], y)
}

# calculate Laspeyers price index
out <- dimSums(p_t * q_0, dim=3, na.rm=TRUE) / dimSums(p_0 * q_0, dim=3, na.rm=TRUE)
out <- dimSums(pT * q0, dim = 3, na.rm = TRUE) / dimSums(p0 * q0, dim = 3, na.rm = TRUE)

out <- out * 100
out[is.nan(out)|is.infinite(out)] <- 0
if (round) {out <- round(out)}

out <- setNames(out,paste0("Prices|Food Price Index (Index ",sub("y","",baseyear),"=100)"))
out[is.nan(out) | is.infinite(out)] <- 0
if (round) {
out <- round(out)
}

out <- setNames(out, paste0("Prices|Food Price Index (Index ", sub("y", "", baseyear), "=100)"))
names(dimnames(out))[3] <- "variable"
#weithts: values of consumption at the initial time step
weights <- dimSums(p_0 * q_0, dim=3, na.rm=TRUE)

# weithts: values of consumption at the initial time step
weights <- dimSums(p0 * q0, dim = 3, na.rm = TRUE)
names(dimnames(weights))[3] <- "variable"
dimnames(weights)[[3]] <- "Aggregate Initial Consumption Value"

weight <- weights
description <- paste0("Fao Food Price Index, ",sub("y","",baseyear),"=100")
isocountries <- TRUE
unit <- paste0("Index ",baseyear,"=100")
} else if(datasource=="ProdPrIndex"){
out <- readSource(type="ProdPrIndex")
out <- out[,,value]
description <- paste0("Fao Food Price Index, ", sub("y", "", baseyear), "=100")
isocountries <- TRUE
unit <- paste0("Index ", baseyear, "=100")

} else if (datasource == "ProdPrIndex") {
out <- readSource(type = "ProdPrIndex")
out <- out[, , value]

weight <- NULL
description <- "Fao Food Price Index, 2002-2004=100"
unit <- "Index 2002-2004=100"
isocountries <- FALSE
}

out <- add_dimension(out, dim=3.1, add="scenario", nm="historical")
out <- add_dimension(out, dim=3.2, add="model", nm=datasource)

return(list(x=out,
weight=weight,
unit=unit,
description=description,
isocountries=isocountries))
}

out <- add_dimension(out, dim = 3.1, add = "scenario", nm = "historical")
out <- add_dimension(out, dim = 3.2, add = "model", nm = datasource)

if (!is.null(weight)) {
weight <- weight + 10^-10
}

return(list(x = out,
weight = weight,
unit = unit,
description = description,
isocountries = isocountries))
}
8 changes: 4 additions & 4 deletions README.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
# madrat data preparation for validation purposes

R package **mrvalidation**, version **2.59.2**
R package **mrvalidation**, version **2.59.3**

[![CRAN status](https://www.r-pkg.org/badges/version/mrvalidation)](https://cran.r-project.org/package=mrvalidation) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.4317826.svg)](https://doi.org/10.5281/zenodo.4317826) [![R build status](https://github.com/pik-piam/mrvalidation/workflows/check/badge.svg)](https://github.com/pik-piam/mrvalidation/actions) [![codecov](https://codecov.io/gh/pik-piam/mrvalidation/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrvalidation) [![r-universe](https://pik-piam.r-universe.dev/badges/mrvalidation)](https://pik-piam.r-universe.dev/builds)

Expand Down Expand Up @@ -39,7 +39,7 @@ In case of questions / problems please contact Benjamin Leon Bodirsky <bodirsky@

To cite package **mrvalidation** in publications use:

Bodirsky B, Wirth S, Karstens K, Humpenoeder F, Stevanovic M, Mishra A, Biewald A, Weindl I, Beier F, Chen D, Crawford M, Leip D, Molina Bacca E, Kreidenweis U, W. Yalew A, von Jeetze P, Wang X, Dietrich J, Alves M (2024). _mrvalidation: madrat data preparation for validation purposes_. doi:10.5281/zenodo.4317826 <https://doi.org/10.5281/zenodo.4317826>, R package version 2.59.2, <https://github.com/pik-piam/mrvalidation>.
Bodirsky B, Wirth S, Karstens K, Humpenoeder F, Stevanovic M, Mishra A, Biewald A, Weindl I, Beier F, Chen D, Crawford M, Leip D, Molina Bacca E, Kreidenweis U, W. Yalew A, von Jeetze P, Wang X, Dietrich J, Alves M (2024). _mrvalidation: madrat data preparation for validation purposes_. doi:10.5281/zenodo.4317826 <https://doi.org/10.5281/zenodo.4317826>, R package version 2.59.3, <https://github.com/pik-piam/mrvalidation>.

A BibTeX entry for LaTeX users is

Expand All @@ -48,8 +48,8 @@ A BibTeX entry for LaTeX users is
title = {mrvalidation: madrat data preparation for validation purposes},
author = {Benjamin Leon Bodirsky and Stephen Wirth and Kristine Karstens and Florian Humpenoeder and Mishko Stevanovic and Abhijeet Mishra and Anne Biewald and Isabelle Weindl and Felicitas Beier and David Chen and Michael Crawford and Debbora Leip and Edna {Molina Bacca} and Ulrich Kreidenweis and Amsalu {W. Yalew} and Patrick {von Jeetze} and Xiaoxi Wang and Jan Philipp Dietrich and Marcos Alves},
year = {2024},
note = {R package version 2.59.2},
doi = {10.5281/zenodo.4317826},
note = {R package version 2.59.3},
url = {https://github.com/pik-piam/mrvalidation},
doi = {10.5281/zenodo.4317826},
}
```
4 changes: 2 additions & 2 deletions man/calcValidPriceIndex.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 922f740

Please sign in to comment.