From 4c7df84e96440151e562361559933e7285799912 Mon Sep 17 00:00:00 2001 From: Jan Philipp Dietrich Date: Wed, 2 Mar 2022 15:06:13 +0100 Subject: [PATCH] getRegions -> getItems & fixed various lintr warnings --- .buildlibrary | 2 +- .zenodo.json | 4 +- DESCRIPTION | 4 +- R/convertACCMIP.R | 2 +- R/convertCEDS.R | 66 +++---- R/convertCEDS2021.R | 104 +++++------ R/convertFAO.R | 360 ++++++++++++++++++++------------------- R/convertFAO_online.R | 213 ++++++++++++----------- README.md | 6 +- man/convertFAO.Rd | 5 +- man/convertFAO_online.Rd | 5 +- 11 files changed, 394 insertions(+), 377 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index c0493293..4388f6a2 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '32636076' +ValidationKey: '32656842' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.zenodo.json b/.zenodo.json index 63d448eb..f0a3f4a4 100644 --- a/.zenodo.json +++ b/.zenodo.json @@ -1,6 +1,6 @@ { "title": "mrcommons: MadRat commons Input Data Library", - "version": "1.7.13", + "version": "1.7.14", "description": "

Provides useful functions and a common structure to all the input data required to run models like MAgPIE\n and REMIND of model input data.<\/p>", "creators": [ { @@ -85,7 +85,7 @@ "name": "Soergel, Bjoern" }, { - "name": "Führlich, Pascal" + "name": "Führlich, Pascal" }, { "name": "Dietrich, Jan Philipp" diff --git a/DESCRIPTION b/DESCRIPTION index 0a148885..5a02aa0c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: mrcommons Type: Package Title: MadRat commons Input Data Library -Version: 1.7.13 -Date: 2022-03-01 +Version: 1.7.14 +Date: 2022-03-02 Authors@R: c(person("Benjamin Leon", "Bodirsky", email = "bodirsky@pik-potsdam.de", role = "aut"), person("Kristine", "Karstens", role = "aut"), person("Lavinia", "Baumstark", role = "aut"), diff --git a/R/convertACCMIP.R b/R/convertACCMIP.R index f5596bc6..aab26bfe 100644 --- a/R/convertACCMIP.R +++ b/R/convertACCMIP.R @@ -13,7 +13,7 @@ #' } convertACCMIP <- function(x) { map <- toolGetMapping(name = "CountryToCellMapping.rds", where = "mrcommons") - getRegions(x) <- map$cell + getItems(x, dim = 1, raw = TRUE) <- map$cell y <- toolAggregate(x, map, from = 1, to = 3, dim = 1) y <- toolCountryFill(y, fill = NA) return(y) diff --git a/R/convertCEDS.R b/R/convertCEDS.R index de02b199..542852fb 100644 --- a/R/convertCEDS.R +++ b/R/convertCEDS.R @@ -1,52 +1,52 @@ -convertCEDS <- function(x,subtype) { - +convertCEDS <- function(x, subtype) { + # fill all missing countries with 0 x[is.na(x)] <- 0 - x1 <- x["srb (kosovo)",,] - getRegions(x1) <- c("srb") - x["srb",,] <- x["srb",,] + x1 - x <- x[c("srb (kosovo)"),,,invert=TRUE] - - # Steve Smith 11.3.2016 on CEDS_Review_3-10-16.zip: there is a huge bug for fugitive emissions in zmb, and eth - # I believe just past 2010. so do something to correct that (just keep those emissions constant from 2010 forward + x1 <- x["srb (kosovo)", , ] + getItems(x1, dim = 1) <- "srb" + x["srb", , ] <- x["srb", , ] + x1 + x <- x[c("srb (kosovo)"), , , invert = TRUE] + + # Steve Smith 11.3.2016 on CEDS_Review_3-10-16.zip: there is a huge bug for fugitive emissions in zmb, and eth + # I believe just past 2010. so do something to correct that (just keep those emissions constant from 2010 forward # for that sector in those two countries). - - # checked: all zero expept for NMVOC. But for NMVOC emission after 2010 do not show significant deviations from before 2010 - + + # checked: all zero expept for NMVOC. But for NMVOC emission after 2010 do not + # show significant deviations from before 2010 + # rename global to glo - getRegions(x) <- gsub("global","glo", getRegions(x)) - getRegions(x) <- toupper(getRegions(x)) - - # delete ANT and SCG from raw data because their successors are already included in the data - #x <- x[c("ANT","SCG"),,invert=TRUE] + getItems(x, dim = 1) <- gsub("global", "glo", getItems(x, dim = 1)) + getItems(x, dim = 1) <- toupper(getItems(x, dim = 1)) - # most shipping and aviation data is global only (except 1A3dii_Domestic-navigation regional). We want to distribute it evenly across all countries. + # most shipping and aviation data is global only (except 1A3dii_Domestic-navigation + # regional). We want to distribute it evenly across all countries. # Therefore, save global data because it will be removed by toolCountryfill - + # 1A3dii_Domestic-navigation regional (global value is zero ) # 1A3di_International-shipping global (no regional values exist) # 1A3ai_International-aviation global (no regional values exist) # 1A3aii_Domestic-aviation global (no regional values exist) - var_glob <- c("1A3di_International-shipping", + varGlob <- c("1A3di_International-shipping", "1A3ai_International-aviation", "1A3aii_Domestic-aviation") - x_glo <- x["GLO",,var_glob] - - # remove global values. Note: the sector 2A1_Cement-production has a global sum that is indentical to the sum over regions - x <- x["GLO",,invert=TRUE] + xGLO <- x["GLO", , varGlob] + + # remove global values. Note: the sector 2A1_Cement-production has a global + # sum that is indentical to the sum over regions + x <- x["GLO", , invert = TRUE] # fills missing ISO countires and remove unknown ISO countires - x <- toolCountryFill(x,fill=0) + x <- toolCountryFill(x, fill = 0) + + # Create weight 1 for xGLO + w <- new.magpie(getItems(x, dim = 1), getItems(x, dim = 2), getItems(xGLO, dim = 3), fill = 1) - # Create weight 1 for x_glo - w <- new.magpie(getRegions(x),getYears(x),getNames(x_glo),fill=1) - # Create mapping of each country to GLO - mapping <- matrix(c(getRegions(x),rep("GLO",length(getRegions(x)))),length(getRegions(x))) - + mapping <- data.frame(from = getItems(x, dim = 1), to = "GLO") + # Spread global shipping and aviation data evenly across countries and save it to regions of x - x[,,var_glob] <- toolAggregate(x_glo,mapping,weight=w) - + x[, , varGlob] <- toolAggregate(xGLO, mapping, weight = w) + return(x) -} \ No newline at end of file +} diff --git a/R/convertCEDS2021.R b/R/convertCEDS2021.R index 7ee042b8..f6411e08 100644 --- a/R/convertCEDS2021.R +++ b/R/convertCEDS2021.R @@ -1,73 +1,75 @@ #' @title convertCEDS2021 -#' +#' #' @description converts emission data from the CEDS database #' @param x magpie object from source function #' @return MAgPIE object #' @author Benjamin Leon Bodirsky, David Klein convertCEDS2021 <- function(x) { - + # fill all missing countries with 0 x[is.na(x)] <- 0 - + # change unit to Mt - x=x/1000 - - x1 <- x["srb (kosovo)",,] - getRegions(x1) <- c("srb") - x["srb",,] <- x["srb",,] + x1 - x <- x[c("srb (kosovo)"),,,invert=TRUE] - - getRegions(x) <- gsub("global","glo", getRegions(x)) - getRegions(x) <- toupper(getRegions(x)) - - map2 <- c(BC_ktC="bc_c", - CO_ktCO="co", - CH4_ktCH4="ch4", - N2O_ktN2O="n2o_n", - NH3_ktNH3="nh3_n", - NOx_ktNO2="no2_n", - NMVOC_ktNMVOC="nmvoc", - OC_ktC="oc_c", - SO2_ktSO2="so2", - CO2_ktCO2="co2_c" + x <- x / 1000 + + x1 <- x["srb (kosovo)", , ] + getItems(x1, dim = 1) <- "srb" + x["srb", , ] <- x["srb", , ] + x1 + x <- x[c("srb (kosovo)"), , , invert = TRUE] + + getItems(x, dim = 1) <- gsub("global", "glo", getItems(x, dim = 1)) + getItems(x, dim = 1) <- toupper(getItems(x, dim = 1)) + + map2 <- c(BC_ktC = "bc_c", + CO_ktCO = "co", + CH4_ktCH4 = "ch4", + N2O_ktN2O = "n2o_n", + NH3_ktNH3 = "nh3_n", + NOx_ktNO2 = "no2_n", + NMVOC_ktNMVOC = "nmvoc", + OC_ktC = "oc_c", + SO2_ktSO2 = "so2", + CO2_ktCO2 = "co2_c" ) - getNames(x,dim=2) <- map2[getNames(x,dim=2)] - - x[,,"n2o_n"]=x[,,"n2o_n"]/44*28 - x[,,"nh3_n"]=x[,,"nh3_n"]/17*14 - x[,,"no2_n"]=x[,,"no2_n"]/46*14 - x[,,"co2_c"]=x[,,"co2_c"]/44*12 - - - - - # most shipping and aviation data is global only (except 1A3dii_Domestic-navigation regional). We want to distribute it evenly across all countries. + getNames(x, dim = 2) <- map2[getNames(x, dim = 2)] + + x[, , "n2o_n"] <- x[, , "n2o_n"] / 44 * 28 + x[, , "nh3_n"] <- x[, , "nh3_n"] / 17 * 14 + x[, , "no2_n"] <- x[, , "no2_n"] / 46 * 14 + x[, , "co2_c"] <- x[, , "co2_c"] / 44 * 12 + + + + + # most shipping and aviation data is global only (except 1A3dii_Domestic-navigation + # regional). We want to distribute it evenly across all countries. # Therefore, save global data because it will be removed by toolCountryfill - + # 1A3dii_Domestic-navigation regional (global value is zero ) # 1A3di_International-shipping global (no regional values exist) # 1A3ai_International-aviation global (no regional values exist) # 1A3aii_Domestic-aviation global (no regional values exist) - - var_glob <- c("1A3di_International-shipping", + + varGlob <- c("1A3di_International-shipping", "1A3ai_International-aviation", "1A3aii_Domestic-aviation") - x_glo <- x["GLO",,var_glob] - - # remove global values. Note: the sector 2A1_Cement-production has a global sum that is indentical to the sum over regions - x <- x["GLO",,invert=TRUE] + xGLO <- x["GLO", , varGlob] + + # remove global values. Note: the sector 2A1_Cement-production has a global + # sum that is indentical to the sum over regions + x <- x["GLO", , invert = TRUE] # fills missing ISO countires and remove unknown ISO countires - x <- toolCountryFill(x,fill=0) - - # Create weight 1 for x_glo - w <- new.magpie(getRegions(x),getYears(x),getNames(x_glo),fill=1) - + x <- toolCountryFill(x, fill = 0) + + # Create weight 1 for xGLO + w <- new.magpie(getItems(x, dim = 1), getItems(x, dim = 2), getItems(xGLO, dim = 3), fill = 1) + # Create mapping of each country to GLO - mapping <- matrix(c(getRegions(x),rep("GLO",length(getRegions(x)))),length(getRegions(x))) - + mapping <- data.frame(from = getItems(x, dim = 1), to = "GLO") + # Spread global shipping and aviation data evenly across countries and save it to regions of x - x[,,var_glob] <- toolAggregate(x_glo,mapping,weight=w) - + x[, , varGlob] <- toolAggregate(xGLO, mapping, weight = w) + return(x) -} \ No newline at end of file +} diff --git a/R/convertFAO.R b/R/convertFAO.R index 07b72356..ac0286a1 100644 --- a/R/convertFAO.R +++ b/R/convertFAO.R @@ -1,289 +1,293 @@ #' Convert FAO data -#' +#' #' Converts FAO data to fit to the common country list and removes or converts #' relative values where possible. Yields (Hg/ha) are for instance removed #' since they can later easily be calculated from production and area but might #' be problematic in the spatial aggregation. Per capita demand values are -#' transformed into absolute values using population estimates from the +#' transformed into absolute values using population estimates from the #' calcPopulationPast function. -#' +#' #' Update 23-Jan-2017 - Added FAO Forestry production and trade data (Abhi) -#' +#' #' @param x MAgPIE object containing original values #' @param subtype The FAO file type, e.g.: CBCrop #' @return Data as MAgPIE object with common country list #' @author Ulrich Kreidenweis, Abhijeet Mishra, Mishko Stevanovic #' @seealso [readFAO()], [readSource()], #' @examples -#' -#' \dontrun{ a <- readSource("FAO","Crop", convert=TRUE)} +#' \dontrun{ +#' a <- readSource("FAO", "Crop", convert = TRUE) +#' } #' @importFrom magclass magpiesort getItems dimExists -#' +#' ## check why LivePrim has such strange Units such as (0_1Gr/An) and "Yield_(Hg)" -convertFAO <- function(x,subtype) { - +convertFAO <- function(x, subtype) { + ## datasets that have only absolute values - absolute <- c("CBCrop", "CBLive", "CropProc", "Fertilizer", "Land", "LiveHead", - "LiveProc", "Pop", "ValueOfProd","ForestProdTrade","Fbs") - + absolute <- c("CBCrop", "CBLive", "CropProc", "Fertilizer", "Land", "LiveHead", + "LiveProc", "Pop", "ValueOfProd", "ForestProdTrade", "Fbs") + + - - ## datasets that contain relative values that can be deleted because they can + ## datasets that contain relative values that can be deleted because they can ## be calculated again at a later point in time ## and the dimensions that can be deleted relative_delete <- list() relative_delete[["Crop"]] <- "Yield_(Hg/Ha)" relative_delete[["Fodder"]] <- "Yield_(Hg/Ha)" - relative_delete[["LivePrim"]] <- c("Yield_Carcass_Weight_(Hg/An)", - "Yield_(100Mg/An)", - "Yield_Carcass_Weight_(0_1Gr/An)", - "Yield_(Hg/An)", - "Yield_(Hg)") - + relative_delete[["LivePrim"]] <- c("Yield_Carcass_Weight_(Hg/An)", + "Yield_(100Mg/An)", + "Yield_Carcass_Weight_(0_1Gr/An)", + "Yield_(Hg/An)", + "Yield_(Hg)") + ## datasets that contain relative values: and define these dimensions relative <- list() - relative[["FSCrop"]] <- c("food_supply_kg/cap/yr", - "food_supply_g/cap/day", - "food_supply_kcal/cap/day", - "protein_supply_g/cap/day", + relative[["FSCrop"]] <- c("food_supply_kg/cap/yr", + "food_supply_g/cap/day", + "food_supply_kcal/cap/day", + "protein_supply_g/cap/day", "fat_supply_g/cap/day") - - relative[["FSLive"]] <- c("food_supply_kg/cap/yr", - "food_supply_g/cap/day", - "food_supply_kcal/cap/day", - "protein_supply_g/cap/day", + + relative[["FSLive"]] <- c("food_supply_kg/cap/yr", + "food_supply_g/cap/day", + "food_supply_kcal/cap/day", + "protein_supply_g/cap/day", "fat_supply_g/cap/day") - + ### Section for country specific treatment ### - - ## data for Eritrea ERI added with 0 if not existing in the dimensionality of + + ## data for Eritrea ERI added with 0 if not existing in the dimensionality of ## Ethiopia, to make toolISOhistorical work - if(any(getRegions(x)=="XET") & any(getRegions(x)=="ETH") & !any(getRegions(x)=="ERI")) { - xERI <- x["ETH",,] - xERI[,,] <- 0 - getRegions(xERI) <- "ERI" - x <- magpiesort(mbind(x,xERI)) + if (all((c("XET", "ETH", "ERI") %in% getItems(x, dim = 1)) == c(TRUE, TRUE, FALSE))) { + xERI <- x["ETH", , ] + xERI[, , ] <- 0 + getItems(xERI, dim = 1) <- "ERI" + x <- magpiesort(mbind(x, xERI)) } - + ## add additional mappings additional_mapping <- list() # Eritrea ERI and Ethiopia ETH - if (all(c("XET","ETH","ERI") %in% getRegions(x))) { - additional_mapping <- append(additional_mapping, list(c("XET","ETH","y1992"),c("XET","ERI","y1992"))) + if (all(c("XET", "ETH", "ERI") %in% getItems(x, dim = 1))) { + additional_mapping <- append(additional_mapping, list(c("XET", "ETH", "y1992"), c("XET", "ERI", "y1992"))) } - + # Belgium-Luxemburg - if (all(c("XBL","BEL","LUX") %in% getRegions(x))) { - additional_mapping <- append(additional_mapping, list(c("XBL","BEL","y1999"), c("XBL","LUX", "y1999"))) - } else if(("XBL" %in% getRegions(x)) & !("BEL" %in% getRegions(x))) { - getCells(x)[getCells(x)=="XBL"] <- "BEL" + if (all(c("XBL", "BEL", "LUX") %in% getItems(x, dim = 1))) { + additional_mapping <- append(additional_mapping, list(c("XBL", "BEL", "y1999"), c("XBL", "LUX", "y1999"))) + } else if (("XBL" %in% getItems(x, dim = 1)) & !("BEL" %in% getItems(x, dim = 1))) { + getItems(x, dim = 1)[getItems(x, dim = 1) == "XBL"] <- "BEL" } - + # Sudan (former) to Sudan and Southern Sudan. If non of the latter two is in the data make Sudan (former) to Sudan - if (all(c("XSD", "SSD", "SDN") %in% getRegions(x))){ - additional_mapping <- append(additional_mapping, list(c("XSD","SSD","y2010"), c("XSD", "SDN","y2010"))) - } else if ("XSD" %in% getRegions(x) & !any(c("SDD", "SDN") %in% getRegions(x)) ) { - getRegions(x)[getRegions(x) == "XSD"] <- "SDN" + if (all(c("XSD", "SSD", "SDN") %in% getItems(x, dim = 1))) { + additional_mapping <- append(additional_mapping, list(c("XSD", "SSD", "y2010"), c("XSD", "SDN", "y2010"))) + } else if ("XSD" %in% getItems(x, dim = 1) & !any(c("SDD", "SDN") %in% getItems(x, dim = 1))) { + getItems(x, dim = 1)[getItems(x, dim = 1) == "XSD"] <- "SDN" } - + ## if there is information for CHN: China, XCN: China, mainland and at least one of the regions ## HKG: China, Hong Kong SAR, TWN: China, Taiwan Province of, MAC: China, Macao SAR ## then replace CHN information by XCN, otherwise discard XCN - if(any(getRegions(x)=="CHN") & any(getRegions(x)=="XCN") & any(getRegions(x) %in% c("HKG","TWN","MAC"))){ - China_mainland <- x["XCN",,] - getRegions(China_mainland) <- "CHN" - x["CHN",,] <- China_mainland - x <- x["XCN",,,invert=T] - } else if (any(getRegions(x) == "XCN")) { - x <- x["XCN",,,invert=T] + if (all(c("CHN", "XCN") %in% getItems(x, dim = 1)) && any(getItems(x, dim = 1) %in% c("HKG", "TWN", "MAC"))) { + China_mainland <- x["XCN", , ] + getItems(China_mainland, dim = 1) <- "CHN" + x["CHN", , ] <- China_mainland + x <- x["XCN", , , invert = TRUE] + } else if (any(getItems(x, dim = 1) == "XCN")) { + x <- x["XCN", , , invert = TRUE] } - - ## data for the Netherlands Antilles is currently removed because currently no + + ## data for the Netherlands Antilles is currently removed because currently no ## information for its successors SXM, CUW, ABW is available as input for toolISOhistorical - if(any(getRegions(x) == "ANT")) { - x <- x["ANT",,,invert=T] + if ("ANT" %in% getItems(x, dim = 1)) { + x <- x["ANT", , , invert = TRUE] } - + ## data for PCI split up into: # Marshall Islands (MH, MHL, 584) # Micronesia, Federated States of (FM, FSM, 583) # Northern Mariana Islands (MP, MNP, 580) # Palau (PW, PLW, 585) - if (all(c("PCI", "MHL", "FSM", "MNP", "PLW") %in% getRegions(x))){ - additional_mapping <- append(additional_mapping, list(c("PCI","MHL","y1991"), c("PCI", "FSM","y1991"), c("PCI", "MNP","y1991"), c("PCI", "PLW","y1991"))) - } else if ("PCI" %in% getRegions(x)) { - x <- x["PCI",,invert=T] + if (all(c("PCI", "MHL", "FSM", "MNP", "PLW") %in% getItems(x, dim = 1))) { + additional_mapping <- append(additional_mapping, list(c("PCI", "MHL", "y1991"), c("PCI", "FSM", "y1991"), c("PCI", "MNP", "y1991"), c("PCI", "PLW", "y1991"))) + } else if ("PCI" %in% getItems(x, dim = 1)) { + x <- x["PCI", , invert = TRUE] } - - + + ### in the dataset EmisAgRiceCult certain follow up states of the Soviet Union are missing. Add them with values of 0 - if(subtype=="EmisAgRiceCult") { - ISOhistorical <- read.csv2(system.file("extdata","ISOhistorical.csv",package = "madrat"),stringsAsFactors = F) - former <- ISOhistorical[ISOhistorical$fromISO %in% c("SUN", "YUG", "SCG"),"toISO"] - missing <- former[!former %in% getRegions(x)] - x2 <- new.magpie(cells_and_regions = missing, years=getYears(x), names = getNames(x)) - x2[,getYears(x2)[getYears(x2, as.integer = T)>=1992],] <- 0 - x <- mbind(x,x2) + if (subtype == "EmisAgRiceCult") { + ISOhistorical <- read.csv2(system.file("extdata", "ISOhistorical.csv", package = "madrat"), stringsAsFactors = FALSE) + former <- ISOhistorical[ISOhistorical$fromISO %in% c("SUN", "YUG", "SCG"), "toISO"] + missing <- former[!former %in% getItems(x, dim = 1)] + x2 <- new.magpie(cells_and_regions = missing, years = getYears(x), names = getNames(x)) + x2[, getYears(x2)[getYears(x2, as.integer = TRUE) >= 1992], ] <- 0 + x <- mbind(x, x2) vcat(2, "Added the countries", missing, "with value of 0 from 1992 onwards") } - + if (any(subtype == absolute)) { x[is.na(x)] <- 0 x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) - x <- toolCountryFill(x, fill=0, verbosity = 2) - if (any(grepl(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]], value=TRUE),collapse=" "), "\n" , "and would need a different treatment of NAs in convertFAO") - + x <- toolCountryFill(x, fill = 0, verbosity = 2) + if (any(grepl(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]], value = TRUE), collapse = " "), "\n", "and would need a different treatment of NAs in convertFAO") + } else if (any(subtype == names(relative_delete))) { x[is.na(x)] <- 0 - x <- x[,,relative_delete[[subtype]], invert=T] + x <- x[, , relative_delete[[subtype]], invert = TRUE] x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) - x <- toolCountryFill(x, fill=0, verbosity = 2) - if (any(grepl(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]], value=TRUE),collapse=" "), "\n" , "and would need a different treatment of NAs in convertFAO") - + x <- toolCountryFill(x, fill = 0, verbosity = 2) + if (any(grepl(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]], value = TRUE), collapse = " "), "\n", "and would need a different treatment of NAs in convertFAO") + } else if (any(subtype == c("FSCrop", "FSLive"))) { - xabs=x[,,relative[[subtype]], invert=T] - xrel <- x[,,relative[[subtype]], invert=F] - - + xabs <- x[, , relative[[subtype]], invert = TRUE] + xrel <- x[, , relative[[subtype]], invert = FALSE] + + # handling of relative values # replaced toolISOhistorical by the following approach for disaggregation - mapping <- read.csv2(system.file("extdata","ISOhistorical.csv",package = "madrat"),stringsAsFactors = F) - for(elem in additional_mapping) { mapping <- rbind(mapping,elem) } - - adopt_aggregated_average<-function(country,data,mapping){ - if(length(country)>1){stop("only one transition per function call")} - toISO=mapping$toISO[mapping$fromISO==country] - lastyear=unique(mapping$lastYear[mapping$fromISO==country]) - if (length(lastyear)>1){stop("strange transition mapping")} - allyears = getYears(data,as.integer = T) - years = allyears[allyears <= as.integer(substring(lastyear,2,5))] - data[toISO,years,] = magclass::colSums(data[country,years]) - data <- data[country,,,invert=T] + mapping <- read.csv2(system.file("extdata", "ISOhistorical.csv", package = "madrat"), stringsAsFactors = FALSE) + for (elem in additional_mapping) { + mapping <- rbind(mapping, elem) + } + + adopt_aggregated_average <- function(country, data, mapping) { + if (length(country) > 1) { +stop("only one transition per function call") +} + toISO <- mapping$toISO[mapping$fromISO == country] + lastyear <- unique(mapping$lastYear[mapping$fromISO == country]) + if (length(lastyear) > 1) { +stop("strange transition mapping") +} + allyears <- getYears(data, as.integer = TRUE) + years <- allyears[allyears <= as.integer(substring(lastyear, 2, 5))] + data[toISO, years, ] <- magclass::colSums(data[country, years]) + data <- data[country, , , invert = TRUE] return(data) } - xrel=adopt_aggregated_average(country = "SUN",data=xrel,mapping = mapping) - xrel=adopt_aggregated_average(country = "YUG",data=xrel,mapping = mapping) - xrel=adopt_aggregated_average(country = "CSK",data=xrel,mapping = mapping) - xrel=adopt_aggregated_average(country = "XET",data=xrel,mapping = mapping) - xrel=adopt_aggregated_average(country = "XBL",data=xrel,mapping = mapping) - xrel=adopt_aggregated_average(country = "SCG",data=xrel,mapping = mapping) - xrel=adopt_aggregated_average(country = "XSD",data=xrel,mapping = mapping) + xrel <- adopt_aggregated_average(country = "SUN", data = xrel, mapping = mapping) + xrel <- adopt_aggregated_average(country = "YUG", data = xrel, mapping = mapping) + xrel <- adopt_aggregated_average(country = "CSK", data = xrel, mapping = mapping) + xrel <- adopt_aggregated_average(country = "XET", data = xrel, mapping = mapping) + xrel <- adopt_aggregated_average(country = "XBL", data = xrel, mapping = mapping) + xrel <- adopt_aggregated_average(country = "SCG", data = xrel, mapping = mapping) + xrel <- adopt_aggregated_average(country = "XSD", data = xrel, mapping = mapping) # transforming relative values into absolute values - pop <- calcOutput("PopulationPast",aggregate=FALSE) - xrel <- toolCountryFill(xrel, fill=0, verbosity = 2) + pop <- calcOutput("PopulationPast", aggregate = FALSE) + xrel <- toolCountryFill(xrel, fill = 0, verbosity = 2) commonyears <- intersect(getYears(pop), getYears(x)) - xrelpop <- collapseNames(complete_magpie(pop[,commonyears,])*complete_magpie(xrel[,commonyears,])) - xrelpop <- xrelpop[,,c("food_supply_kcal/cap/day","protein_supply_g/cap/day","fat_supply_g/cap/day")] *365 - getNames(xrelpop,dim = 2) <- c("food_supply_kcal","protein_supply","fat_supply") + xrelpop <- collapseNames(complete_magpie(pop[, commonyears, ]) * complete_magpie(xrel[, commonyears, ])) + xrelpop <- xrelpop[, , c("food_supply_kcal/cap/day", "protein_supply_g/cap/day", "fat_supply_g/cap/day")] * 365 + getNames(xrelpop, dim = 2) <- c("food_supply_kcal", "protein_supply", "fat_supply") xrelpop[is.na(xrelpop)] <- 0 - + # absolute values - xabs[is.na(xabs)]=0 - xabs[xabs<0]=0 + xabs[is.na(xabs)] <- 0 + xabs[xabs < 0] <- 0 xabs <- toolISOhistorical(xabs, overwrite = TRUE, additional_mapping = additional_mapping) - xabs <- toolCountryFill(xabs, fill=0, verbosity = 2) - + xabs <- toolCountryFill(xabs, fill = 0, verbosity = 2) + x <- mbind(xabs, xrelpop) x <- complete_magpie(x) - x <- toolCountryFill(x, fill=0, verbosity = 2) - if (any(grepl(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]], value=TRUE),collapse=" "), "\n" , "and would need a different treatment of NAs in convertFAO") - + x <- toolCountryFill(x, fill = 0, verbosity = 2) + if (any(grepl(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]], value = TRUE), collapse = " "), "\n", "and would need a different treatment of NAs in convertFAO") + # automatically delete the "Implied emissions factor XXX" dimension for Emission datasets - } else if (substring(subtype,1,6)=="EmisAg" | substring(subtype,1,6)=="EmisLu") { - if (any(grepl("Implied_emission_factor", getItems(x, dim=3.2)))) { - x <- x[,,"Implied_emission_factor", pmatch=T, invert=T] + } else if (substring(subtype, 1, 6) == "EmisAg" | substring(subtype, 1, 6) == "EmisLu") { + if (any(grepl("Implied_emission_factor", getItems(x, dim = 3.2)))) { + x <- x[, , "Implied_emission_factor", pmatch = TRUE, invert = TRUE] } x[is.na(x)] <- 0 x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) - x <- toolCountryFill(x, fill=0, verbosity = 2) - - # Producer Prices Annual - } else if(subtype=="PricesProducerAnnual"){ - x <- collapseNames(x[,,"Producer_Price_(US_$_tonne)_(USD)"]) + x <- toolCountryFill(x, fill = 0, verbosity = 2) + + # Producer Prices Annual + } else if (subtype == "PricesProducerAnnual") { + x <- collapseNames(x[, , "Producer_Price_(US_$_tonne)_(USD)"]) ## Serbia and Montenegro split - if(all(c("SCG","SRB") %in% getRegions(x)) & !"MNE" %in% getRegions(x)){ - mne <- x["SRB",,] + if (all(c("SCG", "SRB") %in% getItems(x, dim = 1)) & !("MNE" %in% getItems(x, dim = 1))) { + mne <- x["SRB", , ] dimnames(mne)[[1]] <- "MNE" x <- mbind(x, mne) } ## Adjust prices of live animal weight to the carcass weith - mapping <- toolGetMapping("FAO_livestock_carcass_price_factor.csv",type="sectoral",where="mrcommons") - for(item in mapping$FAO_carcass){ + mapping <- toolGetMapping("FAO_livestock_carcass_price_factor.csv", type = "sectoral", where = "mrcommons") + for (item in mapping$FAO_carcass) { litem <- mapping$FAO_live_weigth[grep(item, mapping$FAO_carcass)] - countries <- getRegions(which(!is.na(x[,,item]),arr.ind=TRUE)) - countries <- setdiff(getRegions(x), countries) - x[countries,,item] <- x[countries,,litem]/mapping$Price_factor[grep(item, mapping$FAO_carcass)] + countries <- unique(rownames(which(!is.na(x[, , item]), arr.ind = TRUE))) + countries <- setdiff(getItems(x, dim = 1), countries) + x[countries, , item] <- x[countries, , litem] / mapping$Price_factor[grep(item, mapping$FAO_carcass)] } x[is.na(x)] <- 0 - x <- toolISOhistorical(x, overwrite=TRUE, additional_mapping=additional_mapping) - x <- toolCountryFill(x, fill=0, verbosity=2) - } - else if(subtype=="PricesProducerAnnualLCU"){ - x <- collapseNames(x[,,"Producer_Price_(Standard_local_Currency_tonne)_(SLC)"]) + x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) + x <- toolCountryFill(x, fill = 0, verbosity = 2) + } else if (subtype == "PricesProducerAnnualLCU") { + x <- collapseNames(x[, , "Producer_Price_(Standard_local_Currency_tonne)_(SLC)"]) ## Serbia and Montenegro split - if(all(c("SCG","SRB") %in% getRegions(x)) & !"MNE" %in% getRegions(x)){ - mne <- x["SRB",,] + if (all(c("SCG", "SRB") %in% getItems(x, dim = 1)) & !"MNE" %in% getItems(x, dim = 1)) { + mne <- x["SRB", , ] dimnames(mne)[[1]] <- "MNE" x <- mbind(x, mne) } ## Adjust prices of live animal weight to the carcass weith - mapping <- toolGetMapping("FAO_livestock_carcass_price_factor.csv",type="sectoral",where="mrcommons") - for(item in mapping$FAO_carcass){ + mapping <- toolGetMapping("FAO_livestock_carcass_price_factor.csv", type = "sectoral", where = "mrcommons") + for (item in mapping$FAO_carcass) { litem <- mapping$FAO_live_weigth[grep(item, mapping$FAO_carcass)] - countries <- getRegions(which(!is.na(x[,,item]),arr.ind=TRUE)) - countries <- setdiff(getRegions(x), countries) - x[countries,,item] <- x[countries,,litem]/mapping$Price_factor[grep(item, mapping$FAO_carcass)] + countries <- unique(rownames(which(!is.na(x[, , item]), arr.ind = TRUE))) + countries <- setdiff(getItems(x, dim = 1), countries) + x[countries, , item] <- x[countries, , litem] / mapping$Price_factor[grep(item, mapping$FAO_carcass)] } x[is.na(x)] <- 0 - x <- toolISOhistorical(x, overwrite=TRUE, additional_mapping=additional_mapping) - x <- toolCountryFill(x, fill=0, verbosity=2) - }else { + x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) + x <- toolCountryFill(x, fill = 0, verbosity = 2) + } else { cat("Specify whether dataset contains absolute or relative values in convertFAO") } - - + + ### set negative values (except stock variation) to 0 - - if (dimExists(3.2, x)){ + + if (dimExists(3.2, x)) { novar <- setdiff(getItems(x, dim = 3.2), "stock_variation") - x[,,novar][x[,,novar]<0] <- 0 + x[, , novar][x[, , novar] < 0] <- 0 } - + ## Unit conversion in case of FAO Forestry Trade and Production Data: - - if(subtype=="ForestProdTrade"){ - x[,,"Import_Value_(1000_US$)"] <- x[,,"Import_Value_(1000_US$)"]/1000 - x[,,"Export_Value_(1000_US$)"] <- x[,,"Export_Value_(1000_US$)"]/1000 - x[,,"Production_(tonnes)"] <- x[,,"Production_(tonnes)"]/1000000 - x[,,"Export_Quantity_(tonnes)"] <- x[,,"Export_Quantity_(tonnes)"]/1000000 - x[,,"Import_Quantity_(tonnes)"] <- x[,,"Import_Quantity_(tonnes)"]/1000000 - - getNames(x,dim = 2)[3] <- "Import_Value_(Mio_US$)" - getNames(x,dim = 2)[5] <- "Export_Value_(Mio_US$)" - getNames(x,dim = 2)[6] <- "Production_(Mio_tonnes)" - getNames(x,dim = 2)[7] <- "Import_Quantity_(Mio_tonnes)" - getNames(x,dim = 2)[8] <- "Export_Quantity_(Mio_tonnes)" - - getNames(x) <- gsub("^\\|","",getNames(x)) - - - return(x) - } - - else {return(x)} -} + if (subtype == "ForestProdTrade") { + x[, , "Import_Value_(1000_US$)"] <- x[, , "Import_Value_(1000_US$)"] / 1000 + x[, , "Export_Value_(1000_US$)"] <- x[, , "Export_Value_(1000_US$)"] / 1000 + x[, , "Production_(tonnes)"] <- x[, , "Production_(tonnes)"] / 1000000 + x[, , "Export_Quantity_(tonnes)"] <- x[, , "Export_Quantity_(tonnes)"] / 1000000 + x[, , "Import_Quantity_(tonnes)"] <- x[, , "Import_Quantity_(tonnes)"] / 1000000 + getNames(x, dim = 2)[3] <- "Import_Value_(Mio_US$)" + getNames(x, dim = 2)[5] <- "Export_Value_(Mio_US$)" + getNames(x, dim = 2)[6] <- "Production_(Mio_tonnes)" + getNames(x, dim = 2)[7] <- "Import_Quantity_(Mio_tonnes)" + getNames(x, dim = 2)[8] <- "Export_Quantity_(Mio_tonnes)" + + getNames(x) <- gsub("^\\|", "", getNames(x)) + + + return(x) + } else { +return(x) +} +} diff --git a/R/convertFAO_online.R b/R/convertFAO_online.R index d933bd68..c7795ddd 100644 --- a/R/convertFAO_online.R +++ b/R/convertFAO_online.R @@ -15,27 +15,28 @@ #' @author Ulrich Kreidenweis, Abhijeet Mishra, Mishko Stevanovic, David Klein, Edna Molina Bacca #' @seealso [readFAO()], [readSource()], #' @examples -#' -#' \dontrun{ a <- readSource("FAO_online","Crop", convert=TRUE)} +#' \dontrun{ +#' a <- readSource("FAO_online", "Crop", convert = TRUE) +#' } #' @importFrom magclass magpiesort dimExists getItems #' ## check why LivePrim has such strange Units such as (0_1Gr/An) and "Yield_(Hg)" -convertFAO_online <- function(x,subtype) { +convertFAO_online <- function(x, subtype) { # ---- Settings ---- ## datasets that have only absolute values absolute <- c("CBCrop", "CBLive", "CropProc", "Fertilizer", "Land", "LiveHead", - "LiveProc", "Pop", "ValueOfProd","ForestProdTrade","Fbs", "FbsHistoric", + "LiveProc", "Pop", "ValueOfProd", "ForestProdTrade", "Fbs", "FbsHistoric", "FertilizerProducts", "FertilizerNutrients") ## datasets that contain relative values that can be deleted because they can ## be calculated again at a later point in time ## and the dimensions that can be deleted relative_delete <- list() - relative_delete[["Crop"]] <- c("Yield_(hg/ha)","Yield_(Hg/Ha)") + relative_delete[["Crop"]] <- c("Yield_(hg/ha)", "Yield_(Hg/Ha)") relative_delete[["Fodder"]] <- "Yield_(Hg/Ha)" relative_delete[["LivePrim"]] <- c("Yield_Carcass_Weight_(Hg/An)", "Yield_(100Mg/An)", @@ -75,8 +76,8 @@ convertFAO_online <- function(x,subtype) { # select elements only if unit (dim=3.2) exists in x (otherwise magclass would complain when trying to remove non-existent elements with invert=TRUE). For capital stocks selects the complete name. The dot in the original dataset causes errors. - relative_delete <- if((subtype %in% names(relative_delete)) & subtype != "CapitalStock") relative_delete[[subtype]][relative_delete[[subtype]] %in% getItems(x,dim=3.2)] else if(subtype == "CapitalStock") relative_delete[[subtype]][relative_delete[[subtype]] %in% getItems(x,dim=3)] else NULL - if (identical(relative_delete, character(0))) stop("For this subtype (",subtype,") units are listed in 'convertFAO' whose entries should be deleted from the data, but none of the specified units could be found in the data.") + relative_delete <- if ((subtype %in% names(relative_delete)) & subtype != "CapitalStock") relative_delete[[subtype]][relative_delete[[subtype]] %in% getItems(x, dim = 3.2)] else if (subtype == "CapitalStock") relative_delete[[subtype]][relative_delete[[subtype]] %in% getItems(x, dim = 3)] else NULL + if (identical(relative_delete, character(0))) stop("For this subtype (", subtype, ") units are listed in 'convertFAO' whose entries should be deleted from the data, but none of the specified units could be found in the data.") ## datasets that contain relative values: and define these dimensions relative <- list() @@ -96,53 +97,53 @@ convertFAO_online <- function(x,subtype) { ## data for Eritrea ERI and South Sudan SSD added with 0 if not existing after the split ## to make toolISOhistorical work - if(any(getItems(x,dim=1.1)=="XET") & any(getItems(x,dim=1.1)=="ETH") & !any(getItems(x,dim=1.1)=="ERI")) { - xERI <- x["ETH",,] - xERI[,,] <- 0 - getRegions(xERI) <- "ERI" - x <- magpiesort(mbind(x,xERI)) + if (any(getItems(x, dim = 1.1) == "XET") & any(getItems(x, dim = 1.1) == "ETH") & !any(getItems(x, dim = 1.1) == "ERI")) { + xERI <- x["ETH", , ] + xERI[, , ] <- 0 + getItems(xERI, dim = 1) <- "ERI" + x <- magpiesort(mbind(x, xERI)) } - - if(any(getItems(x,dim=1.1)=="XSD") & any(getItems(x,dim=1.1)=="SDN") & !any(getItems(x,dim=1.1)=="SSD")) { - xSSD <- x["SDN",,] - xSSD[,,] <- 0 - getRegions(xSSD) <- "SSD" + + if (any(getItems(x, dim = 1.1) == "XSD") & any(getItems(x, dim = 1.1) == "SDN") & !any(getItems(x, dim = 1.1) == "SSD")) { + xSSD <- x["SDN", , ] + xSSD[, , ] <- 0 + getItems(xSSD, dim = 1) <- "SSD" x <- magpiesort(mbind(x, xSSD)) } - - + + ## add additional mappings additional_mapping <- list() # Eritrea ERI and Ethiopia ETH - if (all(c("XET","ETH","ERI") %in% getItems(x,dim=1.1))) { - additional_mapping <- append(additional_mapping, list(c("XET","ETH","y1992"),c("XET","ERI","y1992"))) + if (all(c("XET", "ETH", "ERI") %in% getItems(x, dim = 1.1))) { + additional_mapping <- append(additional_mapping, list(c("XET", "ETH", "y1992"), c("XET", "ERI", "y1992"))) } # Belgium-Luxemburg - if (all(c("XBL","BEL","LUX") %in% getItems(x,dim=1.1))) { - additional_mapping <- append(additional_mapping, list(c("XBL","BEL","y1999"), c("XBL","LUX", "y1999"))) - } else if(("XBL" %in% getItems(x,dim=1.1)) & !("BEL" %in% getItems(x,dim=1.1))) { - getCells(x)[getItems(x,dim=1.1)=="XBL"] <- "BEL" + if (all(c("XBL", "BEL", "LUX") %in% getItems(x, dim = 1.1))) { + additional_mapping <- append(additional_mapping, list(c("XBL", "BEL", "y1999"), c("XBL", "LUX", "y1999"))) + } else if (("XBL" %in% getItems(x, dim = 1.1)) & !("BEL" %in% getItems(x, dim = 1.1))) { + getCells(x)[getItems(x, dim = 1.1) == "XBL"] <- "BEL" } # Sudan (former) to Sudan and Southern Sudan. If non of the latter two is in the data make Sudan (former) to Sudan - if (all(c("XSD", "SSD", "SDN") %in% getItems(x,dim=1.1))){ - additional_mapping <- append(additional_mapping, list(c("XSD","SSD","y2011"), c("XSD", "SDN","y2011"))) - } else if ("XSD" %in% getItems(x,dim=1.1) & !any(c("SSD", "SDN") %in% getItems(x,dim=1.1)) ) { - getCells(x)[getItems(x,dim=1.1) == "XSD"] <- "SDN" - } + if (all(c("XSD", "SSD", "SDN") %in% getItems(x, dim = 1.1))) { + additional_mapping <- append(additional_mapping, list(c("XSD", "SSD", "y2011"), c("XSD", "SDN", "y2011"))) + } else if ("XSD" %in% getItems(x, dim = 1.1) & !any(c("SSD", "SDN") %in% getItems(x, dim = 1.1))) { + getCells(x)[getItems(x, dim = 1.1) == "XSD"] <- "SDN" + } ## if XCN exists, replace CHN with XCN. - if ("XCN" %in% getItems(x,dim=1.1)) { - if ("CHN" %in% getItems(x,dim=1.1)) x <- x["CHN",,,invert=TRUE] - getItems(x, dim=1)[getItems(x, dim=1)=="XCN"] <- "CHN" + if ("XCN" %in% getItems(x, dim = 1.1)) { + if ("CHN" %in% getItems(x, dim = 1.1)) x <- x["CHN", , , invert = TRUE] + getItems(x, dim = 1)[getItems(x, dim = 1) == "XCN"] <- "CHN" } ## data for the Netherlands Antilles is currently removed because currently no ## information for its successors SXM, CUW, ABW is available as input for toolISOhistorical - if(any(getItems(x,dim=1.1) == "ANT")) { - x <- x["ANT",,,invert=T] + if (any(getItems(x, dim = 1.1) == "ANT")) { + x <- x["ANT", , , invert = TRUE] } ## data for PCI split up into: @@ -150,121 +151,129 @@ convertFAO_online <- function(x,subtype) { # Micronesia, Federated States of (FM, FSM, 583) # Northern Mariana Islands (MP, MNP, 580) # Palau (PW, PLW, 585) - if (all(c("PCI", "MHL", "FSM", "MNP", "PLW") %in% getItems(x,dim=1.1))){ - additional_mapping <- append(additional_mapping, list(c("PCI","MHL","y1991"), c("PCI", "FSM","y1991"), c("PCI", "MNP","y1991"), c("PCI", "PLW","y1991"))) - } else if ("PCI" %in% getItems(x,dim=1.1)) { - x <- x["PCI",,invert=T] + if (all(c("PCI", "MHL", "FSM", "MNP", "PLW") %in% getItems(x, dim = 1.1))) { + additional_mapping <- append(additional_mapping, list(c("PCI", "MHL", "y1991"), c("PCI", "FSM", "y1991"), c("PCI", "MNP", "y1991"), c("PCI", "PLW", "y1991"))) + } else if ("PCI" %in% getItems(x, dim = 1.1)) { + x <- x["PCI", , invert = TRUE] } ### For certain subtypes: if some of the follow up states of the Soviet Union (SUN), Yugoslavia (YUG), Serbia and Montenegro (SCG) are missing add them with values of 0 - if(subtype %in% c("EmisAgRiceCult","Fertilizer", "FertilizerNutrients", "EmisAgCultOrgSoil","EmisLuCrop","EmisLuGrass","EmisAgSynthFerti")) { - ISOhistorical <- read.csv2(system.file("extdata","ISOhistorical.csv",package = "madrat"),stringsAsFactors = F) - former <- ISOhistorical[ISOhistorical$fromISO %in% c("SUN", "YUG", "SCG"),"toISO"] - missing <- former[!former %in% getItems(x,dim=1.1)] - x2 <- new.magpie(cells_and_regions = missing, years=getYears(x), names = getNames(x)) - x2[,getYears(x2)[getYears(x2, as.integer = T)>=1992],] <- 0 - x <- mbind(x,x2) + if (subtype %in% c("EmisAgRiceCult", "Fertilizer", "FertilizerNutrients", "EmisAgCultOrgSoil", "EmisLuCrop", "EmisLuGrass", "EmisAgSynthFerti")) { + ISOhistorical <- read.csv2(system.file("extdata", "ISOhistorical.csv", package = "madrat"), stringsAsFactors = FALSE) + former <- ISOhistorical[ISOhistorical$fromISO %in% c("SUN", "YUG", "SCG"), "toISO"] + missing <- former[!former %in% getItems(x, dim = 1.1)] + x2 <- new.magpie(cells_and_regions = missing, years = getYears(x), names = getNames(x)) + x2[, getYears(x2)[getYears(x2, as.integer = TRUE) >= 1992], ] <- 0 + x <- mbind(x, x2) } # ---- Treatment of absolute or relative values ---- if (any(subtype == absolute)) { x[is.na(x)] <- 0 - if(subtype!="Fbs") {x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping)} + if (subtype != "Fbs") { +x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) +} x <- toolCountryFill(x, fill = 0, verbosity = 2) - if (any(grepl(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]], value=TRUE),collapse=" "), "\n" , "and would need a different treatment of NAs in convertFAO") + if (any(grepl(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]], value = TRUE), collapse = " "), "\n", "and would need a different treatment of NAs in convertFAO") } else if (!is.null(relative_delete)) { x[is.na(x)] <- 0 - x <- x[,,relative_delete, invert=T] - x <- if (subtype != "CapitalStock") toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) else x #Capital Stock available starting from 1995 (no need for transitions) - x <- toolCountryFill(x, fill=0, verbosity = 2) - if(subtype != "CapitalStock") if (any(grepl(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]], value=TRUE),collapse=" "), "\n" , "and would need a different treatment of NAs in convertFAO") + x <- x[, , relative_delete, invert = TRUE] + x <- if (subtype != "CapitalStock") toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) else x # Capital Stock available starting from 1995 (no need for transitions) + x <- toolCountryFill(x, fill = 0, verbosity = 2) + if (subtype != "CapitalStock") if (any(grepl(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]], value = TRUE), collapse = " "), "\n", "and would need a different treatment of NAs in convertFAO") } else if (any(subtype == c("FSCrop", "FSLive"))) { - xabs <- x[,,relative[[subtype]], invert=T] - xrel <- x[,,relative[[subtype]], invert=F] + xabs <- x[, , relative[[subtype]], invert = TRUE] + xrel <- x[, , relative[[subtype]], invert = FALSE] # handling of relative values # replaced toolISOhistorical by the following approach for disaggregation - mapping <- read.csv2(system.file("extdata","ISOhistorical.csv",package = "madrat"),stringsAsFactors = F) - for(elem in additional_mapping) { mapping <- rbind(mapping,elem) } - - .adopt_aggregated_average <- function(country,data,mapping){ - if(length(country)>1){stop("only one transition per function call")} - toISO=mapping$toISO[mapping$fromISO==country] - lastyear=unique(mapping$lastYear[mapping$fromISO==country]) - if (length(lastyear)>1){stop("strange transition mapping")} - allyears = getYears(data,as.integer = T) - years = allyears[allyears <= as.integer(substring(lastyear,2,5))] - data[toISO,years,] = magclass::colSums(data[country,years]) - data <- data[country,,,invert=T] + mapping <- read.csv2(system.file("extdata", "ISOhistorical.csv", package = "madrat"), stringsAsFactors = FALSE) + for (elem in additional_mapping) { + mapping <- rbind(mapping, elem) + } + + .adopt_aggregated_average <- function(country, data, mapping) { + if (length(country) > 1) { +stop("only one transition per function call") +} + toISO <- mapping$toISO[mapping$fromISO == country] + lastyear <- unique(mapping$lastYear[mapping$fromISO == country]) + if (length(lastyear) > 1) { +stop("strange transition mapping") +} + allyears <- getYears(data, as.integer = TRUE) + years <- allyears[allyears <= as.integer(substring(lastyear, 2, 5))] + data[toISO, years, ] <- magclass::colSums(data[country, years]) + data <- data[country, , , invert = TRUE] return(data) } - xrel=.adopt_aggregated_average(country = "SUN",data=xrel,mapping = mapping) - xrel=.adopt_aggregated_average(country = "YUG",data=xrel,mapping = mapping) - xrel=.adopt_aggregated_average(country = "CSK",data=xrel,mapping = mapping) - xrel=.adopt_aggregated_average(country = "XET",data=xrel,mapping = mapping) - xrel=.adopt_aggregated_average(country = "XBL",data=xrel,mapping = mapping) - xrel=.adopt_aggregated_average(country = "SCG",data=xrel,mapping = mapping) - xrel=.adopt_aggregated_average(country = "XSD",data=xrel,mapping = mapping) + xrel <- .adopt_aggregated_average(country = "SUN", data = xrel, mapping = mapping) + xrel <- .adopt_aggregated_average(country = "YUG", data = xrel, mapping = mapping) + xrel <- .adopt_aggregated_average(country = "CSK", data = xrel, mapping = mapping) + xrel <- .adopt_aggregated_average(country = "XET", data = xrel, mapping = mapping) + xrel <- .adopt_aggregated_average(country = "XBL", data = xrel, mapping = mapping) + xrel <- .adopt_aggregated_average(country = "SCG", data = xrel, mapping = mapping) + xrel <- .adopt_aggregated_average(country = "XSD", data = xrel, mapping = mapping) # transforming relative values into absolute values - pop <- calcOutput("PopulationPast",aggregate=FALSE) - xrel <- toolCountryFill(xrel, fill=0, verbosity = 2) + pop <- calcOutput("PopulationPast", aggregate = FALSE) + xrel <- toolCountryFill(xrel, fill = 0, verbosity = 2) commonyears <- intersect(getYears(pop), getYears(x)) - xrelpop <- collapseNames(complete_magpie(pop[,commonyears,])*complete_magpie(xrel[,commonyears,])) - xrelpop <- xrelpop[,,c("food_supply_kcal/cap/day","protein_supply_g/cap/day","fat_supply_g/cap/day")] *365 - getNames(xrelpop,dim = 2) <- c("food_supply_kcal","protein_supply","fat_supply") + xrelpop <- collapseNames(complete_magpie(pop[, commonyears, ]) * complete_magpie(xrel[, commonyears, ])) + xrelpop <- xrelpop[, , c("food_supply_kcal/cap/day", "protein_supply_g/cap/day", "fat_supply_g/cap/day")] * 365 + getNames(xrelpop, dim = 2) <- c("food_supply_kcal", "protein_supply", "fat_supply") xrelpop[is.na(xrelpop)] <- 0 # absolute values - xabs[is.na(xabs)]=0 - xabs[xabs<0]=0 + xabs[is.na(xabs)] <- 0 + xabs[xabs < 0] <- 0 xabs <- toolISOhistorical(xabs, overwrite = TRUE, additional_mapping = additional_mapping) - xabs <- toolCountryFill(xabs, fill=0, verbosity = 2) + xabs <- toolCountryFill(xabs, fill = 0, verbosity = 2) x <- mbind(xabs, xrelpop) x <- complete_magpie(x) - x <- toolCountryFill(x, fill=0, verbosity = 2) - if (any(grepl(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = 'yield|Yield|/', getNames(x, fulldim=T)[[2]], value=TRUE),collapse=" "), "\n" , "and would need a different treatment of NAs in convertFAO") + x <- toolCountryFill(x, fill = 0, verbosity = 2) + if (any(grepl(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]]))) warning("The following elements could be relative: \n", paste(grep(pattern = "yield|Yield|/", getNames(x, fulldim = TRUE)[[2]], value = TRUE), collapse = " "), "\n", "and would need a different treatment of NAs in convertFAO") # automatically delete the "Implied emissions factor XXX" dimension for Emission datasets - } else if (substring(subtype,1,6)=="EmisAg" | substring(subtype,1,6)=="EmisLu") { + } else if (substring(subtype, 1, 6) == "EmisAg" | substring(subtype, 1, 6) == "EmisLu") { if (any(grepl("Implied_emission_factor", getItems(x, dim = 3.2)))) { - x <- x[,,"Implied_emission_factor", pmatch=T, invert=T] + x <- x[, , "Implied_emission_factor", pmatch = TRUE, invert = TRUE] } x[is.na(x)] <- 0 x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) - x <- toolCountryFill(x, fill=0, verbosity = 2) + x <- toolCountryFill(x, fill = 0, verbosity = 2) # Producer Prices Annual - } else if(subtype %in% c("PricesProducerAnnual","PricesProducerAnnualLCU")){ + } else if (subtype %in% c("PricesProducerAnnual", "PricesProducerAnnualLCU")) { # FAO changed the unit. Look for all possible names and select only existing ones from the magpie object - possible_names <- list (PricesProducerAnnual = c("Producer_Price_(US_$_tonne)_(USD)","Producer_Price_(USD_tonne)_(USD)"), - PricesProducerAnnualLCU = c("Producer_Price_(Standard_local_Currency_tonne)_(SLC)","Producer_Price_(SLC_tonne)_(SLC)")) - possible_names <- toolSubtypeSelect(subtype,possible_names) - x <- collapseNames(x[,,possible_names[possible_names %in% getItems(x,dim=3.2)]]) + possibleNames <- list (PricesProducerAnnual = c("Producer_Price_(US_$_tonne)_(USD)", "Producer_Price_(USD_tonne)_(USD)"), + PricesProducerAnnualLCU = c("Producer_Price_(Standard_local_Currency_tonne)_(SLC)", "Producer_Price_(SLC_tonne)_(SLC)")) + possibleNames <- toolSubtypeSelect(subtype, possibleNames) + x <- collapseNames(x[, , possibleNames[possibleNames %in% getItems(x, dim = 3.2)]]) ## Serbia and Montenegro split - if(all(c("SCG","SRB") %in% getItems(x,dim=1.1)) & !"MNE" %in% getItems(x,dim=1.1)){ - mne <- x["SRB",,] + if (all(c("SCG", "SRB") %in% getItems(x, dim = 1.1)) & !"MNE" %in% getItems(x, dim = 1.1)) { + mne <- x["SRB", , ] dimnames(mne)[[1]] <- "MNE" x <- mbind(x, mne) } ## Adjust prices of live animal weight to the carcass weight - mapping <- toolGetMapping("FAO_livestock_carcass_price_factor.csv",type="sectoral",where="mrcommons") - for(item in mapping$FAO_carcass){ + mapping <- toolGetMapping("FAO_livestock_carcass_price_factor.csv", type = "sectoral", where = "mrcommons") + for (item in mapping$FAO_carcass) { litem <- mapping$FAO_live_weigth[grep(item, mapping$FAO_carcass)] - countries <- getRegions(which(!is.na(x[,,item]),arr.ind=TRUE)) - countries <- setdiff(getItems(x,dim=1.1), countries) - x[countries,,item] <- x[countries,,litem]/mapping$Price_factor[grep(item, mapping$FAO_carcass)] + countries <- unique(rownames(which(!is.na(x[, , item]), arr.ind = TRUE))) + countries <- setdiff(getItems(x, dim = 1.1), countries) + x[countries, , item] <- x[countries, , litem] / mapping$Price_factor[grep(item, mapping$FAO_carcass)] } x[is.na(x)] <- 0 - x <- toolISOhistorical(x, overwrite=TRUE, additional_mapping=additional_mapping) - x <- toolCountryFill(x, fill=0, verbosity=2) + x <- toolISOhistorical(x, overwrite = TRUE, additional_mapping = additional_mapping) + x <- toolCountryFill(x, fill = 0, verbosity = 2) } else { cat("Specify in convertFAO whether dataset contains absolute or relative values!") @@ -272,9 +281,9 @@ convertFAO_online <- function(x,subtype) { # ---- Set negative values to 0 (except stock variation) ---- - if(dimExists(3.2, x)){ + if (dimExists(3.2, x)) { novar <- setdiff(getItems(x, dim = 3.2), "stock_variation") - x[,,novar][x[,,novar]<0] <- 0 + x[, , novar][x[, , novar] < 0] <- 0 } return(x) diff --git a/README.md b/README.md index eca229a1..ca16bb75 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # MadRat commons Input Data Library -R package **mrcommons**, version **1.7.13** +R package **mrcommons**, version **1.7.14** [![CRAN status](https://www.r-pkg.org/badges/version/mrcommons)](https://cran.r-project.org/package=mrcommons) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.3822009.svg)](https://doi.org/10.5281/zenodo.3822009) [![R build status](https://github.com/pik-piam/mrcommons/workflows/check/badge.svg)](https://github.com/pik-piam/mrcommons/actions) [![codecov](https://codecov.io/gh/pik-piam/mrcommons/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrcommons) [![r-universe](https://pik-piam.r-universe.dev/badges/mrcommons)](https://pik-piam.r-universe.dev/ui#builds) @@ -39,7 +39,7 @@ In case of questions / problems please contact Jan Philipp Dietrich . +Bodirsky B, Karstens K, Baumstark L, Weindl I, Wang X, Mishra A, Wirth S, Stevanovic M, Steinmetz N, Kreidenweis U, Rodrigues R, Popov R, Humpenoeder F, Giannousakis A, Levesque A, Klein D, Araujo E, Beier F, Oeser J, Pehl M, Leip D, Crawford M, Molina Bacca E, von Jeetze P, Martinelli E, Schreyer F, Soergel B, Führlich P, Dietrich J (2022). _mrcommons: MadRat commons Input Data Library_. doi: 10.5281/zenodo.3822009 (URL: https://doi.org/10.5281/zenodo.3822009), R package version 1.7.14, . A BibTeX entry for LaTeX users is @@ -48,7 +48,7 @@ A BibTeX entry for LaTeX users is title = {mrcommons: MadRat commons Input Data Library}, author = {Benjamin Leon Bodirsky and Kristine Karstens and Lavinia Baumstark and Isabelle Weindl and Xiaoxi Wang and Abhijeet Mishra and Stephen Wirth and Mishko Stevanovic and Nele Steinmetz and Ulrich Kreidenweis and Renato Rodrigues and Roman Popov and Florian Humpenoeder and Anastasis Giannousakis and Antoine Levesque and David Klein and Ewerton Araujo and Felicitas Beier and Julian Oeser and Michaja Pehl and Debbora Leip and Michael Crawford and Edna {Molina Bacca} and Patrick {von Jeetze} and Eleonora Martinelli and Felix Schreyer and Bjoern Soergel and Pascal Führlich and Jan Philipp Dietrich}, year = {2022}, - note = {R package version 1.7.13}, + note = {R package version 1.7.14}, doi = {10.5281/zenodo.3822009}, url = {https://github.com/pik-piam/mrcommons}, } diff --git a/man/convertFAO.Rd b/man/convertFAO.Rd index 446f2da3..926a996a 100644 --- a/man/convertFAO.Rd +++ b/man/convertFAO.Rd @@ -26,8 +26,9 @@ calcPopulationPast function. Update 23-Jan-2017 - Added FAO Forestry production and trade data (Abhi) } \examples{ - -\dontrun{ a <- readSource("FAO","Crop", convert=TRUE)} +\dontrun{ +a <- readSource("FAO", "Crop", convert = TRUE) +} } \seealso{ \code{\link[=readFAO]{readFAO()}}, \code{\link[=readSource]{readSource()}}, diff --git a/man/convertFAO_online.Rd b/man/convertFAO_online.Rd index a4c30e96..a2f0fca3 100644 --- a/man/convertFAO_online.Rd +++ b/man/convertFAO_online.Rd @@ -26,8 +26,9 @@ calcPopulationPast function. Update 23-Jan-2017 - Added FAO Forestry production and trade data (Abhi) } \examples{ - -\dontrun{ a <- readSource("FAO_online","Crop", convert=TRUE)} +\dontrun{ +a <- readSource("FAO_online", "Crop", convert = TRUE) +} } \seealso{ \code{\link[=readFAO]{readFAO()}}, \code{\link[=readSource]{readSource()}},