From f9f490792eafe2428fbd365349d30bcade9a2ed5 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 11 Feb 2026 16:46:37 +0100 Subject: [PATCH 01/40] add mapping and calcFunction for PlasticsEurope production data --- R/calcPlPlasticsEurope.R | 20 ++ R/convertPlasticsEurope.R | 23 ++ .../regional/regionmappingPlasticsEurope.csv | 250 ++++++++++++++++++ 3 files changed, 293 insertions(+) create mode 100644 R/calcPlPlasticsEurope.R create mode 100644 R/convertPlasticsEurope.R create mode 100644 inst/extdata/regional/regionmappingPlasticsEurope.csv diff --git a/R/calcPlPlasticsEurope.R b/R/calcPlPlasticsEurope.R new file mode 100644 index 00000000..d5301521 --- /dev/null +++ b/R/calcPlPlasticsEurope.R @@ -0,0 +1,20 @@ +#' This function returns plastics production data from Plastics Europe +#' +#' @author Leonie Schweiger +#' +calcPlPlasticsEurope <- function() { + # --------------------------------------------------------------------------- + # Read source data + # --------------------------------------------------------------------------- + x <- readSource("PlasticsEurope", subtype = "PlasticProduction_region") + + # --------------------------------------------------------------------------- + # Return packaged output + # --------------------------------------------------------------------------- + return(list( + x = x, + weight = NULL, + unit = "Mt Plastic", + description = "Production data from Plastics Europe" + )) +} diff --git a/R/convertPlasticsEurope.R b/R/convertPlasticsEurope.R new file mode 100644 index 00000000..1dd77bea --- /dev/null +++ b/R/convertPlasticsEurope.R @@ -0,0 +1,23 @@ +#' Convert Plastics Europe production data to ISO country level +#' +#' @param x MagPIE object containing Plastics Europe production data at regional resolution. +#' @return MagPIE object of the Plastics Europe production data disaggregated to country level. +#' @author Leonie Schweiger +#' @examples +#' \dontrun{ +#' a <- convertPlasticsEurope(x) +#' } +convertPlasticsEurope <- function(x) { + + # GDP weights for 2005-2023 + region_map <- toolGetMapping("regionmappingPlasticsEurope.csv", type = "regional", where = "mrmfa") %>% + filter(.data$PlasticsEuropeReg != "Rest") + GDP <- calcOutput("CoGDP1900To2150", scenario = "SSP2", perCapita = FALSE, aggregate = FALSE)[, paste0("y", 2005:2023), ] + x <- toolAggregate(x, + rel = region_map, dim = 1, + from = "PlasticsEuropeReg", to = "CountryCode", + weight = GDP[unique(region_map$CountryCode), , ]) + x <- toolCountryFill(x, fill = 0) + + return(x) +} diff --git a/inst/extdata/regional/regionmappingPlasticsEurope.csv b/inst/extdata/regional/regionmappingPlasticsEurope.csv new file mode 100644 index 00000000..d4677df4 --- /dev/null +++ b/inst/extdata/regional/regionmappingPlasticsEurope.csv @@ -0,0 +1,250 @@ +X;CountryCode;PlasticsEuropeReg +Aruba;ABW;Central & South America +Afghanistan;AFG;Rest of Asia +Angola;AGO;Middle East, Africa +Anguilla;AIA;Central & South America +Aland Islands;ALA;EU27+3 +Albania;ALB;Rest +Andorra;AND;EU27+3 +United Arab Emirates;ARE;Middle East, Africa +Argentina;ARG;Central & South America +Armenia;ARM;CIS +American Samoa;ASM;Rest of Asia +Antarctica;ATA;Rest +French Southern Territories;ATF;Rest +Antigua and Barbuda;ATG;Central & South America +Australia;AUS;Rest of Asia +Austria;AUT;EU27+3 +Azerbaijan;AZE;CIS +Burundi;BDI;Middle East, Africa +Belgium;BEL;EU27+3 +Benin;BEN;Middle East, Africa +Bonaire, Sint Eustatius and Saba;BES;Central & South America +Burkina Faso;BFA;Middle East, Africa +Bangladesh;BGD;Rest of Asia +Bulgaria;BGR;EU27+3 +Bahrain;BHR;Middle East, Africa +Bahamas;BHS;Central & South America +Bosnia and Herzegovina;BIH;Rest +Saint Barthelemy;BLM;Central & South America +Belarus;BLR;CIS +Belize;BLZ;Central & South America +Bermuda;BMU;Central & South America +Bolivia, Plurinational State of;BOL;Central & South America +Brazil;BRA;Central & South America +Barbados;BRB;Central & South America +Brunei Darussalam;BRN;Rest of Asia +Bhutan;BTN;Rest of Asia +Bouvet Island;BVT;Rest +Botswana;BWA;Middle East, Africa +Central African Republic;CAF;Middle East, Africa +Canada;CAN;North America +Cocos (Keeling) Islands;CCK;Rest of Asia +Switzerland;CHE;EU27+3 +Chile;CHL;Central & South America +China;CHN;China +Cote d Ivoire;CIV;Middle East, Africa +Cameroon;CMR;Middle East, Africa +Congo, the Democratic Republic of the;COD;Middle East, Africa +Congo;COG;Middle East, Africa +Cook Islands;COK;Rest of Asia +Colombia;COL;Central & South America +Comoros;COM;Middle East, Africa +Cape Verde;CPV;Middle East, Africa +Costa Rica;CRI;Central & South America +Cuba;CUB;Central & South America +Curacao;CUW;Central & South America +Christmas Island;CXR;Rest of Asia +Cayman Islands;CYM;Central & South America +Cyprus;CYP;EU27+3 +Czech Republic;CZE;EU27+3 +Germany;DEU;EU27+3 +Djibouti;DJI;Middle East, Africa +Dominica;DMA;Central & South America +Denmark;DNK;EU27+3 +Dominican Republic;DOM;Central & South America +Algeria;DZA;Middle East, Africa +Ecuador;ECU;Central & South America +Egypt;EGY;Middle East, Africa +Eritrea;ERI;Middle East, Africa +Western Sahara;ESH;Middle East, Africa +Spain;ESP;EU27+3 +Estonia;EST;EU27+3 +Ethiopia;ETH;Middle East, Africa +Finland;FIN;EU27+3 +Fiji;FJI;Rest of Asia +Falkland Islands (Malvinas);FLK;Rest +France;FRA;EU27+3 +Faroe Islands;FRO;EU27+3 +Micronesia, Federated States of;FSM;Rest of Asia +Gabon;GAB;Middle East, Africa +United Kingdom;GBR;EU27+3 +Georgia;GEO;Rest +Guernsey;GGY;EU27+3 +Ghana;GHA;Middle East, Africa +Gibraltar;GIB;EU27+3 +Guinea;GIN;Middle East, Africa +Guadeloupe;GLP;Central & South America +Gambia;GMB;Middle East, Africa +Guinea-Bissau;GNB;Middle East, Africa +Equatorial Guinea;GNQ;Middle East, Africa +Greece;GRC;EU27+3 +Grenada;GRD;Central & South America +Greenland;GRL;Rest +Guatemala;GTM;Central & South America +French Guiana;GUF;Central & South America +Guam;GUM;Rest of Asia +Guyana;GUY;Central & South America +Hong Kong;HKG;China +Heard Island and McDonald Islands;HMD;Rest +Honduras;HND;Central & South America +Croatia;HRV;EU27+3 +Haiti;HTI;Central & South America +Hungary;HUN;EU27+3 +Indonesia;IDN;Rest of Asia +Isle of Man;IMN;EU27+3 +India;IND;Rest of Asia +British Indian Ocean Territory;IOT;Rest +Ireland;IRL;EU27+3 +Iran, Islamic Republic of;IRN;Middle East, Africa +Iraq;IRQ;Middle East, Africa +Iceland;ISL;EU27+3 +Israel;ISR;Middle East, Africa +Italy;ITA;EU27+3 +Jamaica;JAM;Central & South America +Jersey;JEY;EU27+3 +Jordan;JOR;Middle East, Africa +Japan;JPN;Japan +Kazakhstan;KAZ;CIS +Kenya;KEN;Middle East, Africa +Kyrgyzstan;KGZ;CIS +Cambodia;KHM;Rest of Asia +Kiribati;KIR;Rest of Asia +Saint Kitts and Nevis;KNA;Central & South America +Korea, Republic of;KOR;Rest of Asia +Kuwait;KWT;Middle East, Africa +Lao People's Democratic Republic;LAO;Rest of Asia +Lebanon;LBN;Middle East, Africa +Liberia;LBR;Middle East, Africa +Libya;LBY;Middle East, Africa +Saint Lucia;LCA;Central & South America +Liechtenstein;LIE;EU27+3 +Sri Lanka;LKA;Rest of Asia +Lesotho;LSO;Middle East, Africa +Lithuania;LTU;EU27+3 +Luxembourg;LUX;EU27+3 +Latvia;LVA;EU27+3 +Macao;MAC;China +Saint Martin (French part);MAF;Rest +Morocco;MAR;Middle East, Africa +Monaco;MCO;EU27+3 +Moldova, Republic of;MDA;CIS +Madagascar;MDG;Middle East, Africa +Maldives;MDV;Rest of Asia +Mexico;MEX;North America +Marshall Islands;MHL;Rest of Asia +Macedonia, the former Yugoslav Republic of;MKD;Rest +Mali;MLI;Middle East, Africa +Malta;MLT;EU27+3 +Myanmar;MMR;Rest of Asia +Montenegro;MNE;Rest +Mongolia;MNG;Rest of Asia +Northern Mariana Islands;MNP;Rest of Asia +Mozambique;MOZ;Middle East, Africa +Mauritania;MRT;Middle East, Africa +Montserrat;MSR;Central & South America +Martinique;MTQ;Central & South America +Mauritius;MUS;Middle East, Africa +Malawi;MWI;Middle East, Africa +Malaysia;MYS;Rest of Asia +Mayotte;MYT;Middle East, Africa +Namibia;NAM;Middle East, Africa +New Caledonia;NCL;Rest of Asia +Niger;NER;Middle East, Africa +Norfolk Island;NFK;Rest +Nigeria;NGA;Middle East, Africa +Nicaragua;NIC;Central & South America +Niue;NIU;Rest of Asia +Netherlands;NLD;EU27+3 +Norway;NOR;EU27+3 +Nepal;NPL;Rest of Asia +Nauru;NRU;Rest of Asia +New Zealand;NZL;Rest of Asia +Oman;OMN;Middle East, Africa +Pakistan;PAK;Rest of Asia +Panama;PAN;Central & South America +Pitcairn;PCN;Rest +Peru;PER;Central & South America +Philippines;PHL;Rest of Asia +Palau;PLW;Rest of Asia +Papua New Guinea;PNG;Rest of Asia +Poland;POL;EU27+3 +Puerto Rico;PRI;Central & South America +Korea, Democratic People's Republic of;PRK;Rest of Asia +Portugal;PRT;EU27+3 +Paraguay;PRY;Central & South America +Palestine, State of;PSE;Middle East, Africa +French Polynesia;PYF;Rest of Asia +Qatar;QAT;Middle East, Africa +Reunion;REU;Middle East, Africa +Romania;ROU;EU27+3 +Russian Federation;RUS;CIS +Rwanda;RWA;Middle East, Africa +Saudi Arabia;SAU;Middle East, Africa +Sudan;SDN;Middle East, Africa +Senegal;SEN;Middle East, Africa +Singapore;SGP;Rest of Asia +South Georgia and the South Sandwich Islands;SGS;Rest +Saint Helena, Ascension and Tristan da Cunha;SHN;Middle East, Africa +Svalbard and Jan Mayen;SJM;EU27+3 +Solomon Islands;SLB;Rest of Asia +Sierra Leone;SLE;Middle East, Africa +El Salvador;SLV;Central & South America +San Marino;SMR;EU27+3 +Somalia;SOM;Middle East, Africa +Saint Pierre and Miquelon;SPM;Central & South America +Serbia;SRB;Rest +South Sudan;SSD;Middle East, Africa +Sao Tome and Principe;STP;Middle East, Africa +Suriname;SUR;Central & South America +Slovakia;SVK;EU27+3 +Slovenia;SVN;EU27+3 +Sweden;SWE;EU27+3 +Swaziland;SWZ;Middle East, Africa +Sint Maarten (Dutch part);SXM;Central & South America +Seychelles;SYC;Middle East, Africa +Syrian Arab Republic;SYR;Middle East, Africa +Turks and Caicos Islands;TCA;Central & South America +Chad;TCD;Middle East, Africa +Togo;TGO;Middle East, Africa +Thailand;THA;Rest of Asia +Tajikistan;TJK;CIS +Tokelau;TKL;Rest of Asia +Turkmenistan;TKM;CIS +Timor-Leste;TLS;Rest of Asia +Tonga;TON;Rest of Asia +Trinidad and Tobago;TTO;Central & South America +Tunisia;TUN;Middle East, Africa +Turkey;TUR;Rest of Asia +Tuvalu;TUV;Rest of Asia +Taiwan, Province of China;TWN;Rest of Asia +Tanzania, United Republic of;TZA;Middle East, Africa +Uganda;UGA;Middle East, Africa +Ukraine;UKR;Rest of Asia +United States Minor Outlying Islands;UMI;Rest +Uruguay;URY;Central & South America +United States;USA;North America +Uzbekistan;UZB;CIS +Holy See (Vatican City State);VAT;EU27+3 +Saint Vincent and the Grenadines;VCT;Central & South America +Venezuela, Bolivarian Republic of;VEN;Central & South America +Virgin Islands, British;VGB;Central & South America +Virgin Islands, U.S.;VIR;Central & South America +Viet Nam;VNM;Rest of Asia +Vanuatu;VUT;Rest of Asia +Wallis and Futuna;WLF;Rest of Asia +Samoa;WSM;Rest of Asia +Yemen;YEM;Middle East, Africa +South Africa;ZAF;Middle East, Africa +Zambia;ZMB;Middle East, Africa +Zimbabwe;ZWE;Middle East, Africa From 84100eba4bb0033ec17e39fd78f11c65de7caad6 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Mon, 16 Mar 2026 15:52:48 +0100 Subject: [PATCH 02/40] update Rd files --- NAMESPACE | 2 +- man/calcPlTrade.Rd | 22 +++++++++++++++++----- man/calcStSectorSplits.Rd | 6 ++---- man/fullMFA.Rd | 15 +++++---------- man/readBACI.Rd | 14 ++++++++------ 5 files changed, 33 insertions(+), 26 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7ec0a376..b86aed5d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ import(madrat) import(magclass) import(mrdrivers) importFrom(data.table,first) -importFrom(data.table,rbindlist) importFrom(dplyr,across) importFrom(dplyr,all_of) importFrom(dplyr,bind_rows) @@ -21,6 +20,7 @@ importFrom(dplyr,rename) importFrom(dplyr,select) importFrom(dplyr,summarise) importFrom(dplyr,summarize) +importFrom(dplyr,ungroup) importFrom(magclass,"getComment<-") importFrom(magclass,as.magpie) importFrom(magclass,where) diff --git a/man/calcPlTrade.Rd b/man/calcPlTrade.Rd index 83390a16..ba054db7 100644 --- a/man/calcPlTrade.Rd +++ b/man/calcPlTrade.Rd @@ -5,8 +5,9 @@ \title{Calculate Country-Level Plastics Trade for Various Categories} \usage{ calcPlTrade( - category = c("Final", "Primary", "Intermediate", "Manufactured"), - flow_label = c("Exports", "Imports") + category, + flow_label = c("Exports", "Imports"), + source = c("UNCTAD", "BACI") ) } \arguments{ @@ -16,6 +17,8 @@ calcPlTrade( \item "Primary" - Primary plastics \item "Intermediate" - Intermediate forms of plastic \item "Manufactured" - Intermediate manufactured plastic goods + \item "Application" - Plastic goods + \item "Waste" - Plastic waste }} \item{flow_label}{Character; trade flow: @@ -23,11 +26,20 @@ calcPlTrade( \item "Exports" - Exports \item "Imports" - Imports }} + +\item{source}{Character; data source: +\itemize{ + \item "UNCTAD" - UNCTAD (trade flows by time and region) + \item "BACI" - BACI (trade flows by time, region, sector and polymer) +}} } \description{ -Reads UNCTAD plastics trade (exports or imports) data at regional level, -backcasts data to 1950 to fill missing years 1950-2004 years, -and aggregates to country level. +Reads plastics trade (exports or imports) data at regional level, +and backcasts data to 1950 to fill missing years. +Note that aggregation to regions is done in the calc functions called by this function, +as the source BACI has bilateral trade data that allows to filter out intraregional trade +by a custom aggregation function. +Therefore, we operate already at the regional aggregation level here (isocountries=FALSE). } \author{ Qianzhi Zhang diff --git a/man/calcStSectorSplits.Rd b/man/calcStSectorSplits.Rd index cc0ce49c..3a81a1cf 100644 --- a/man/calcStSectorSplits.Rd +++ b/man/calcStSectorSplits.Rd @@ -4,12 +4,10 @@ \alias{calcStSectorSplits} \title{Calc steel sector splits} \usage{ -calcStSectorSplits(subtype = "Pauliuk2013") +calcStSectorSplits(subtype) } \arguments{ -\item{subtype}{Sector split source, currently using Pauliuk et al. (2013). -Other options is to use Pauliuk et al.'s stock sector splits or other -MFAs.} +\item{subtype}{Income bin; either "high" or "low"} } \description{ Function to load steel sector splits data in the four main end-use sectors diff --git a/man/fullMFA.Rd b/man/fullMFA.Rd index 65554595..97bfff4a 100644 --- a/man/fullMFA.Rd +++ b/man/fullMFA.Rd @@ -18,18 +18,13 @@ fullMFA( \item{dev}{Development version string} -\item{scenario}{SSP scenario used for population and GDP drivers} +\item{scenario}{SSP scenario used for population and GDP.} -\item{gdpPerCapita}{bool if GDP driver should be returned as per capita values} +\item{gdpPerCapita}{bool if GDP should be returned as per capita values.} -\item{runSections}{Character vector selecting which parts to run.} - -\item{end_future}{End year for future data (default: 2100) -Allowed values (see validSections): c("drivers", "steel", "cement", "plastic"). NULL (default) runs all.} - -\item{start_historic}{Start year for historic data (default: 1900)} - -\item{end_historic}{End year for historic data (default: 2023)} +\item{runSections}{Character vector selecting which parts to run. +Allowed values (see validSections): c("steel", "cement", "plastic"). NULL (default) runs all. +#' @param end_future End year for future data (default: 2100).} } \description{ Function that produces the complete regional data sets required for the diff --git a/man/readBACI.Rd b/man/readBACI.Rd index bb309916..971c31fe 100644 --- a/man/readBACI.Rd +++ b/man/readBACI.Rd @@ -4,16 +4,18 @@ \alias{readBACI} \title{Read BACI Trade data} \usage{ -readBACI(subtype, HS = "02") +readBACI(subset = "02", subtype) } \arguments{ -\item{subtype}{Character string specifying the scope -- "plastics"} - -\item{HS}{Character string specifying the year of the HS (Harmonized System) revision of the data +\item{subset}{Character string specifying the HS (Harmonized System) revision of the data - 92 - 02 +- 17 - 22} + +\item{subtype}{Character string specifying the scope +- "plastics_UNCTAD": plastics trade data for HS codes from UNCTAD classification into primary, intermediate, manufactured, final and waste plastics +- "plastics_UNEP": plastics trade data for HS codes from UNEP NGP (estimated plastics mass based on estimated plastics percentages in goods)} } \value{ magpie object of the BACI trade data @@ -23,7 +25,7 @@ Read BACI Trade data } \examples{ \dontrun{ -a <- readSource(type = "BACI", subtype = "plastics") +a <- readSource(type = "BACI", subtype = "plastics_UNEP", subset = "02") } } \seealso{ From 7bac1f965b5f61120be21b38a19e57d75d82b37a Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Mon, 16 Mar 2026 15:53:18 +0100 Subject: [PATCH 03/40] add Rd files --- man/calcBACI.Rd | 36 ++++++++++++++++++++++++++++++ man/calcCeIndustrializedRegions.Rd | 20 +++++++++++++++++ man/calcCeLifetimeRelStd.Rd | 16 +++++++++++++ man/calcPlPlasticsEurope.Rd | 14 ++++++++++++ man/convertPlasticsEurope.Rd | 25 +++++++++++++++++++++ man/readUNCTAD_PlasticsHSCodes.Rd | 35 +++++++++++++++++++++++++++++ man/readUNEP_NGP.Rd | 33 +++++++++++++++++++++++++++ 7 files changed, 179 insertions(+) create mode 100644 man/calcBACI.Rd create mode 100644 man/calcCeIndustrializedRegions.Rd create mode 100644 man/calcCeLifetimeRelStd.Rd create mode 100644 man/calcPlPlasticsEurope.Rd create mode 100644 man/convertPlasticsEurope.Rd create mode 100644 man/readUNCTAD_PlasticsHSCodes.Rd create mode 100644 man/readUNEP_NGP.Rd diff --git a/man/calcBACI.Rd b/man/calcBACI.Rd new file mode 100644 index 00000000..f71e489d --- /dev/null +++ b/man/calcBACI.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcBACI.R +\name{calcBACI} +\alias{calcBACI} +\title{Get BACI Trade data for specific product groups} +\usage{ +calcBACI(subtype, HS = "02") +} +\arguments{ +\item{subtype}{Character string specifying the scope +- "plastics_UNCTAD": plastics trade data for HS codes from UNCTAD classification into primary, intermediate, manufactured, final and waste plastics +- "plastics_UNEP": plastics trade data for HS codes from UNEP NGP (estimated plastics mass based on estimated plastics percentages in goods)} + +\item{HS}{Character string specifying the year of the HS (Harmonized System) revision of the data +- 92 +- 02 +- 17 +- 22} +} +\value{ +magpie object of the BACI trade data +} +\description{ +Get BACI Trade data for specific product groups +} +\examples{ +\dontrun{ +a <- calcOutput(type = "BACI", subtype = "plastics_UNCTAD", HS = "02") +} +} +\seealso{ +[calcOutput()] +} +\author{ +Leonie Schweiger +} diff --git a/man/calcCeIndustrializedRegions.Rd b/man/calcCeIndustrializedRegions.Rd new file mode 100644 index 00000000..e88d9ce3 --- /dev/null +++ b/man/calcCeIndustrializedRegions.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcCeIndustrializedRegions.R +\name{calcCeIndustrializedRegions} +\alias{calcCeIndustrializedRegions} +\title{Define Regions that have industrialized already. +Based on expert judgement for H12 regions. +When calling this function via calcOutput() for other than H12 region set, +use round=0 as an argument if a binary output is desired.} +\usage{ +calcCeIndustrializedRegions() +} +\description{ +Define Regions that have industrialized already. +Based on expert judgement for H12 regions. +When calling this function via calcOutput() for other than H12 region set, +use round=0 as an argument if a binary output is desired. +} +\author{ +Bennet Weiss +} diff --git a/man/calcCeLifetimeRelStd.Rd b/man/calcCeLifetimeRelStd.Rd new file mode 100644 index 00000000..67238425 --- /dev/null +++ b/man/calcCeLifetimeRelStd.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcCeLifetimeRelStd.R +\name{calcCeLifetimeRelStd} +\alias{calcCeLifetimeRelStd} +\title{Expert guess on the relative standard deviation of lifetime +of buildings and infrastructure} +\usage{ +calcCeLifetimeRelStd() +} +\description{ +Expert guess on the relative standard deviation of lifetime +of buildings and infrastructure +} +\author{ +Bennet Weiss +} diff --git a/man/calcPlPlasticsEurope.Rd b/man/calcPlPlasticsEurope.Rd new file mode 100644 index 00000000..8e2c5b97 --- /dev/null +++ b/man/calcPlPlasticsEurope.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcPlPlasticsEurope.R +\name{calcPlPlasticsEurope} +\alias{calcPlPlasticsEurope} +\title{This function returns plastics production data from Plastics Europe} +\usage{ +calcPlPlasticsEurope() +} +\description{ +This function returns plastics production data from Plastics Europe +} +\author{ +Leonie Schweiger +} diff --git a/man/convertPlasticsEurope.Rd b/man/convertPlasticsEurope.Rd new file mode 100644 index 00000000..61869915 --- /dev/null +++ b/man/convertPlasticsEurope.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convertPlasticsEurope.R +\name{convertPlasticsEurope} +\alias{convertPlasticsEurope} +\title{Convert Plastics Europe production data to ISO country level} +\usage{ +convertPlasticsEurope(x) +} +\arguments{ +\item{x}{MagPIE object containing Plastics Europe production data at regional resolution.} +} +\value{ +MagPIE object of the Plastics Europe production data disaggregated to country level. +} +\description{ +Convert Plastics Europe production data to ISO country level +} +\examples{ +\dontrun{ +a <- convertPlasticsEurope(x) +} +} +\author{ +Leonie Schweiger +} diff --git a/man/readUNCTAD_PlasticsHSCodes.Rd b/man/readUNCTAD_PlasticsHSCodes.Rd new file mode 100644 index 00000000..9308905a --- /dev/null +++ b/man/readUNCTAD_PlasticsHSCodes.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readUNCTAD_PlasticsHSCodes.R +\name{readUNCTAD_PlasticsHSCodes} +\alias{readUNCTAD_PlasticsHSCodes} +\title{Read HS Comtrade product classification codes for plastics products from +UNCTAD} +\usage{ +readUNCTAD_PlasticsHSCodes(subtype) +} +\arguments{ +\item{subtype}{Character string specifying specifying the year of the HS (Harmonized System) revision of the data, available are +- 02 +- 07 +- 12 +- 17 +- 22} +} +\value{ +magpie object of the UNEP NGP HS Codes +} +\description{ +Read HS Comtrade product classification codes for plastics products from +UNCTAD +} +\examples{ +\dontrun{ +a <- readSource(type = "UNCTAD_PlasticsHSCodes") +} +} +\seealso{ +[readSource()] +} +\author{ +Leonie Schweiger +} diff --git a/man/readUNEP_NGP.Rd b/man/readUNEP_NGP.Rd new file mode 100644 index 00000000..f3d9cb41 --- /dev/null +++ b/man/readUNEP_NGP.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readUNEP_NGP.R +\name{readUNEP_NGP} +\alias{readUNEP_NGP} +\title{Read HS Comtrade product classification codes for plastics products and their plastics percentage from +Tool T1.4 of the UNEP National Guidance for Plastic Pollution Hotspotting and Shaping Action} +\usage{ +readUNEP_NGP(subtype) +} +\arguments{ +\item{subtype}{whether to return 4 digit or 6 digit codes or all +- k4 +- k6 +- all} +} +\value{ +magpie object of the UNEP NGP HS Codes +} +\description{ +Read HS Comtrade product classification codes for plastics products and their plastics percentage from +Tool T1.4 of the UNEP National Guidance for Plastic Pollution Hotspotting and Shaping Action +} +\examples{ +\dontrun{ +a <- readSource(type = "UNEP_NGP") +} +} +\seealso{ +[readSource()] +} +\author{ +Leonie Schweiger +} From c95b84088084ae5007c6d356dc042169c1fedbe9 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 17 Jul 2026 15:28:18 +0200 Subject: [PATCH 04/40] fix bug in convertPlasticsEurope --- R/calcPlEoL_shares.R | 2 +- R/convertPlasticsEurope.R | 4 ++-- R/readPlasticsEurope.R | 28 ++++++++++++------------ man/calcBACI.Rd | 36 ------------------------------- man/readBACI.Rd | 4 ---- man/readUNCTAD_PlasticsHSCodes.Rd | 35 ------------------------------ man/readUNEP_NGP.Rd | 33 ---------------------------- 7 files changed, 17 insertions(+), 125 deletions(-) delete mode 100644 man/calcBACI.Rd delete mode 100644 man/readUNCTAD_PlasticsHSCodes.Rd delete mode 100644 man/readUNEP_NGP.Rd diff --git a/R/calcPlEoL_shares.R b/R/calcPlEoL_shares.R index d7d4567e..c8c31d18 100644 --- a/R/calcPlEoL_shares.R +++ b/R/calcPlEoL_shares.R @@ -52,7 +52,7 @@ calcPlEoL_shares <- function(subtype) { # - US data (1960-2018, fill gaps by linear interpolation) # - calculate shares # --------------------------------------------------------------------------- - eu <- readSource("PlasticsEurope", subtype = "PlasticEoL_EU", convert = FALSE) %>% + eu <- readSource("PlasticsEurope", subtype = "EoL_EU", convert = FALSE) %>% as.data.frame() cn_raw <- readSource("China_PlasticEoL", convert = FALSE) cn <- time_interpolate(cn_raw, interpolated_year = 1978:2021, integrate_interpolated_years = TRUE) %>% diff --git a/R/convertPlasticsEurope.R b/R/convertPlasticsEurope.R index 1dd77bea..fff75e67 100644 --- a/R/convertPlasticsEurope.R +++ b/R/convertPlasticsEurope.R @@ -9,10 +9,10 @@ #' } convertPlasticsEurope <- function(x) { - # GDP weights for 2005-2023 + # disaggregate to iso3 country level by GDP weighting region_map <- toolGetMapping("regionmappingPlasticsEurope.csv", type = "regional", where = "mrmfa") %>% filter(.data$PlasticsEuropeReg != "Rest") - GDP <- calcOutput("CoGDP1900To2150", scenario = "SSP2", perCapita = FALSE, aggregate = FALSE)[, paste0("y", 2005:2023), ] + GDP <- calcOutput("CoGDP", perCapita = FALSE, aggregate = FALSE)[, getYears(x), ] x <- toolAggregate(x, rel = region_map, dim = 1, from = "PlasticsEuropeReg", to = "CountryCode", diff --git a/R/readPlasticsEurope.R b/R/readPlasticsEurope.R index 7df1183d..8293ce85 100644 --- a/R/readPlasticsEurope.R +++ b/R/readPlasticsEurope.R @@ -6,9 +6,9 @@ #' #' @param subtype Character string specifying the dataset and scope. #' Valid formats include: -#' - "PlasticProduction_region" (plastic production in Mt, dimensions: region, year) -#' - "PlasticShare_EU" (plastic demand shares (%) by use category in the EU, dimensions: category, year) -#' - "PlasticEoL_EU" (plastic waste treatment in the EU in Mt, dimensions: year, treatment) +#' - "Production_region" (plastic production in Mt, dimensions: region, year) +#' - "SectorShare_EU" (plastic demand shares (%) by use category in the EU, dimensions: category, year) +#' - "EoL_EU" (plastic waste treatment in the EU in Mt, dimensions: year, treatment) #' #' @return magpie object of the Plastics Europe data #' @@ -18,7 +18,7 @@ #' #' @examples #' \dontrun{ -#' a <- readSource(type = "PlasticsEurope", subtype = "PlasticProduction_region") +#' a <- readSource(type = "PlasticsEurope", subtype = "Production_region") #' } #' @importFrom readxl read_excel #' @importFrom dplyr select filter @@ -29,15 +29,15 @@ readPlasticsEurope <- function(subtype) { # --------------------------------------------------------------------------- # Map subtype to Excel file parameters params <- switch(subtype, - "PlasticProduction_region" = list( + "Production_region" = list( sheet = "PlasticProduction_region", range = "A1:J20" ), - "PlasticShare_EU" = list( + "SectorShare_EU" = list( sheet = "PlasticShare_EU", range = "A1:I20" ), - "PlasticEoL_EU" = list( + "EoL_EU" = list( sheet = "PlasticEoL_EU", range = "A1:D16" ), @@ -56,21 +56,21 @@ readPlasticsEurope <- function(subtype) { # --------------------------------------------------------------------------- # Select and filter columns based on subtype df <- switch(subtype, - "PlasticProduction_region" = raw_df %>% + "Production_region" = raw_df %>% pivot_longer( cols = -"Year", names_to = "Region", values_to = "Production" ) %>% filter(.data$Region != "Total Production (Mt)"), - "PlasticShare_EU" = raw_df %>% + "SectorShare_EU" = raw_df %>% pivot_longer( cols = -"Year", names_to = "Type", values_to = "Share" ) %>% filter(.data$Type != "Total Demand (Mt)"), - "PlasticEoL_EU" = raw_df %>% + "EoL_EU" = raw_df %>% pivot_longer( cols = -"Year", names_to = "EoL", @@ -83,14 +83,14 @@ readPlasticsEurope <- function(subtype) { # Convert to magpie object and clean missing values # --------------------------------------------------------------------------- magpie_data <- switch(subtype, - "PlasticProduction_region" = as.magpie(df, temporal = 1, spatial = 2), - "PlasticShare_EU" = as.magpie(df, temporal = 1), - "PlasticEoL_EU" = as.magpie(df, temporal = 1), + "Production_region" = as.magpie(df, temporal = 1, spatial = 2), + "SectorShare_EU" = as.magpie(df, temporal = 1), + "EoL_EU" = as.magpie(df, temporal = 1), stop("Unsupported subtype: ", subtype) ) magpie_data[is.na(magpie_data)] <- 0 - if (subtype != "PlasticProduction_region") { + if (subtype != "Production_region") { getItems(magpie_data, dim = 1) <- "EUR" } getComment(magpie_data) <- subtype diff --git a/man/calcBACI.Rd b/man/calcBACI.Rd deleted file mode 100644 index f71e489d..00000000 --- a/man/calcBACI.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/calcBACI.R -\name{calcBACI} -\alias{calcBACI} -\title{Get BACI Trade data for specific product groups} -\usage{ -calcBACI(subtype, HS = "02") -} -\arguments{ -\item{subtype}{Character string specifying the scope -- "plastics_UNCTAD": plastics trade data for HS codes from UNCTAD classification into primary, intermediate, manufactured, final and waste plastics -- "plastics_UNEP": plastics trade data for HS codes from UNEP NGP (estimated plastics mass based on estimated plastics percentages in goods)} - -\item{HS}{Character string specifying the year of the HS (Harmonized System) revision of the data -- 92 -- 02 -- 17 -- 22} -} -\value{ -magpie object of the BACI trade data -} -\description{ -Get BACI Trade data for specific product groups -} -\examples{ -\dontrun{ -a <- calcOutput(type = "BACI", subtype = "plastics_UNCTAD", HS = "02") -} -} -\seealso{ -[calcOutput()] -} -\author{ -Leonie Schweiger -} diff --git a/man/readBACI.Rd b/man/readBACI.Rd index 53a8811e..2ce2c57a 100644 --- a/man/readBACI.Rd +++ b/man/readBACI.Rd @@ -38,10 +38,6 @@ material HS codes: - 02 - 17 - 22} - -\item{subtype}{Character string specifying the scope -- "plastics_UNCTAD": plastics trade data for HS codes from UNCTAD classification into primary, intermediate, manufactured, final and waste plastics -- "plastics_UNEP": plastics trade data for HS codes from UNEP NGP (estimated plastics mass based on estimated plastics percentages in goods)} } \value{ magpie object of the BACI trade data diff --git a/man/readUNCTAD_PlasticsHSCodes.Rd b/man/readUNCTAD_PlasticsHSCodes.Rd deleted file mode 100644 index 9308905a..00000000 --- a/man/readUNCTAD_PlasticsHSCodes.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/readUNCTAD_PlasticsHSCodes.R -\name{readUNCTAD_PlasticsHSCodes} -\alias{readUNCTAD_PlasticsHSCodes} -\title{Read HS Comtrade product classification codes for plastics products from -UNCTAD} -\usage{ -readUNCTAD_PlasticsHSCodes(subtype) -} -\arguments{ -\item{subtype}{Character string specifying specifying the year of the HS (Harmonized System) revision of the data, available are -- 02 -- 07 -- 12 -- 17 -- 22} -} -\value{ -magpie object of the UNEP NGP HS Codes -} -\description{ -Read HS Comtrade product classification codes for plastics products from -UNCTAD -} -\examples{ -\dontrun{ -a <- readSource(type = "UNCTAD_PlasticsHSCodes") -} -} -\seealso{ -[readSource()] -} -\author{ -Leonie Schweiger -} diff --git a/man/readUNEP_NGP.Rd b/man/readUNEP_NGP.Rd deleted file mode 100644 index f3d9cb41..00000000 --- a/man/readUNEP_NGP.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/readUNEP_NGP.R -\name{readUNEP_NGP} -\alias{readUNEP_NGP} -\title{Read HS Comtrade product classification codes for plastics products and their plastics percentage from -Tool T1.4 of the UNEP National Guidance for Plastic Pollution Hotspotting and Shaping Action} -\usage{ -readUNEP_NGP(subtype) -} -\arguments{ -\item{subtype}{whether to return 4 digit or 6 digit codes or all -- k4 -- k6 -- all} -} -\value{ -magpie object of the UNEP NGP HS Codes -} -\description{ -Read HS Comtrade product classification codes for plastics products and their plastics percentage from -Tool T1.4 of the UNEP National Guidance for Plastic Pollution Hotspotting and Shaping Action -} -\examples{ -\dontrun{ -a <- readSource(type = "UNEP_NGP") -} -} -\seealso{ -[readSource()] -} -\author{ -Leonie Schweiger -} From 4fbb41dc4a117564c598da08dd83d290156a32a1 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 21 Jul 2026 15:44:45 +0200 Subject: [PATCH 05/40] read synthetic fibre production from TextileExchange --- R/convertTextileExchange.R | 47 ++++++++++++++++++++++++++++ R/readTextileExchange.R | 59 +++++++++++++++++++++++++++++++++++ man/convertTextileExchange.Rd | 35 +++++++++++++++++++++ man/readTextileExchange.Rd | 35 +++++++++++++++++++++ 4 files changed, 176 insertions(+) create mode 100644 R/convertTextileExchange.R create mode 100644 R/readTextileExchange.R create mode 100644 man/convertTextileExchange.Rd create mode 100644 man/readTextileExchange.Rd diff --git a/R/convertTextileExchange.R b/R/convertTextileExchange.R new file mode 100644 index 00000000..929bb0ae --- /dev/null +++ b/R/convertTextileExchange.R @@ -0,0 +1,47 @@ +#' Convert Textile Exchange regional shares to country-level shares +#' +#' Disaggregates the regional synthetic-fibre production shares to ISO country +#' level. The countries belonging to each Textile Exchange region are taken from +#' \code{regionmappingTextileExchange.csv} (derived from the "comment" column of +#' the source excel file), and the region share is distributed across those countries +#' proportionally to their chemical energy consumption +#' (\code{calcOutput("ChemicalTotal")}, from mrindustry). +#' +#' Only the \code{"region_share"} subtype is convertible; the +#' \code{"timeseries_by_type"} subtype is global and must be read with +#' \code{convert = FALSE}. +#' +#' @param x MagPIE object of Textile Exchange regional shares (\code{region_share}). +#' @return MagPIE object of the shares disaggregated to ISO country level. +#' @author Leonie Schweiger +#' @examples +#' \dontrun{ +#' a <- readSource("TextileExchange", subtype = "region_share") +#' } +#' @importFrom magclass getComment getYears setYears +convertTextileExchange <- function(x) { + if (!any(grepl("region_share", getComment(x)))) { + stop("convertTextileExchange only supports the 'region_share' subtype; ", + "read 'timeseries_by_type' with convert = FALSE.") + } + + # region -> country mapping (named countries only, from the source comment column) + map <- toolGetMapping("regionmappingTextileExchange.csv", type = "regional", where = "mrmfa") + + # disaggregation weights: country-level chemical energy consumption. + # ChemicalTotal does not reach the share year (2024), so use its latest available + # year and align it to the share year. + chem <- calcOutput("ChemicalTotal", aggregate = FALSE) + chem <- setYears(chem[unique(map$CountryCode), tail(getYears(chem), 1), ], getYears(x)) + getNames(chem) <- NULL + + x <- toolAggregate(x, + rel = map, dim = 1, + from = "TextileExchangeReg", to = "CountryCode", + weight = chem + ) + + x <- toolCountryFill(x, fill = 0) + + return(x) +} diff --git a/R/readTextileExchange.R b/R/readTextileExchange.R new file mode 100644 index 00000000..9869905d --- /dev/null +++ b/R/readTextileExchange.R @@ -0,0 +1,59 @@ +#' Read Textile Exchange synthetic fibre data into a magpie object +#' +#' This function reads Textile Exchange (Materials Market Report 2025) data on +#' synthetic fibre production and its estimated regional distribution based on +#' Credence Research market data on monoethylene glycol from an Excel file, +#' based on a specified subtype, and returns a magpie object. +#' +#' @param subtype Character string specifying the dataset: +#' - "timeseries_by_type": global synthetic fibre production in Mt by fibre +#' type and year (fibre, year, production_Mt). +#' - "region_share": regional production shares (\%) by fibre and year +#' (region, fibre, share_pct, year). +#' +#' @return magpie object of the Textile Exchange data +#' +#' @author Leonie Schweiger +#' +#' @seealso [readSource()] +#' +#' @examples +#' \dontrun{ +#' a <- readSource(type = "TextileExchange", subtype = "timeseries_by_type", convert = FALSE) +#' } +#' @importFrom readxl read_excel +#' @importFrom magclass as.magpie getComment<- +#' +readTextileExchange <- function(subtype) { + # --------------------------------------------------------------------------- + # Map subtype to Excel sheet and cell range + params <- switch(subtype, + "timeseries_by_type" = list(sheet = "timeseries_by_type", range = "A1:C16"), + "region_share" = list(sheet = "region_share", range = "A1:D6"), + stop("Invalid subtype: ", subtype) + ) + + raw_df <- read_excel( + path = "TextileExchange.xlsx", + sheet = params$sheet, + range = params$range + ) + + # --------------------------------------------------------------------------- + # Convert to magpie object (global for the time series, regional for shares) + magpie_data <- switch(subtype, + "timeseries_by_type" = { + raw_df$region <- "GLO" + as.magpie(raw_df[, c("region", "year", "fibre", "production_Mt")], + spatial = 1, temporal = 2) + }, + "region_share" = as.magpie(raw_df[, c("region", "year", "fibre", "share_pct")], + spatial = 1, temporal = 2), + stop("Unsupported subtype: ", subtype) + ) + + magpie_data[is.na(magpie_data)] <- 0 + getComment(magpie_data) <- subtype + + return(magpie_data) +} diff --git a/man/convertTextileExchange.Rd b/man/convertTextileExchange.Rd new file mode 100644 index 00000000..068d3c22 --- /dev/null +++ b/man/convertTextileExchange.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convertTextileExchange.R +\name{convertTextileExchange} +\alias{convertTextileExchange} +\title{Convert Textile Exchange regional shares to country-level shares} +\usage{ +convertTextileExchange(x) +} +\arguments{ +\item{x}{MagPIE object of Textile Exchange regional shares (\code{region_share}).} +} +\value{ +MagPIE object of the shares disaggregated to ISO country level. +} +\description{ +Disaggregates the regional synthetic-fibre production shares to ISO country +level. The countries belonging to each Textile Exchange region are taken from +\code{regionmappingTextileExchange.csv} (derived from the "comment" column of +the source excel file), and the region share is distributed across those countries +proportionally to their chemical energy consumption +(\code{calcOutput("ChemicalTotal")}, from mrindustry). +} +\details{ +Only the \code{"region_share"} subtype is convertible; the +\code{"timeseries_by_type"} subtype is global and must be read with +\code{convert = FALSE}. +} +\examples{ +\dontrun{ +a <- readSource("TextileExchange", subtype = "region_share") +} +} +\author{ +Leonie Schweiger +} diff --git a/man/readTextileExchange.Rd b/man/readTextileExchange.Rd new file mode 100644 index 00000000..4283ab6a --- /dev/null +++ b/man/readTextileExchange.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readTextileExchange.R +\name{readTextileExchange} +\alias{readTextileExchange} +\title{Read Textile Exchange synthetic fibre data into a magpie object} +\usage{ +readTextileExchange(subtype) +} +\arguments{ +\item{subtype}{Character string specifying the dataset: +- "timeseries_by_type": global synthetic fibre production in Mt by fibre + type and year (fibre, year, production_Mt). +- "region_share": regional production shares (\%) by fibre and year + (region, fibre, share_pct, year).} +} +\value{ +magpie object of the Textile Exchange data +} +\description{ +This function reads Textile Exchange (Materials Market Report 2025) data on +synthetic fibre production and its estimated regional distribution based on +Credence Research market data on monoethylene glycol from an Excel file, +based on a specified subtype, and returns a magpie object. +} +\examples{ +\dontrun{ +a <- readSource(type = "TextileExchange", subtype = "timeseries_by_type", convert = FALSE) +} +} +\seealso{ +[readSource()] +} +\author{ +Leonie Schweiger +} From f2af6202f1c7f94a5a3bfb6c30811afe4f7f15fb Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 21 Jul 2026 15:45:46 +0200 Subject: [PATCH 06/40] add TextileExchange regionmapping --- .../regional/regionmappingTextileExchange.csv | 250 ++++++++++++++++++ 1 file changed, 250 insertions(+) create mode 100644 inst/extdata/regional/regionmappingTextileExchange.csv diff --git a/inst/extdata/regional/regionmappingTextileExchange.csv b/inst/extdata/regional/regionmappingTextileExchange.csv new file mode 100644 index 00000000..e77405b1 --- /dev/null +++ b/inst/extdata/regional/regionmappingTextileExchange.csv @@ -0,0 +1,250 @@ +X;CountryCode;TextileExchangeReg +Aruba;ABW;Latin America +Afghanistan;AFG;Asia-Pacific +Angola;AGO;Middle East & Africa +Anguilla;AIA;Latin America +Aland Islands;ALA;Europe +Albania;ALB;Europe +Andorra;AND;Europe +United Arab Emirates;ARE;Middle East & Africa +Argentina;ARG;Latin America +Armenia;ARM;Europe +American Samoa;ASM;Asia-Pacific +Antarctica;ATA;Asia-Pacific +French Southern Territories;ATF;Asia-Pacific +Antigua and Barbuda;ATG;Latin America +Australia;AUS;Asia-Pacific +Austria;AUT;Europe +Azerbaijan;AZE;Europe +Burundi;BDI;Middle East & Africa +Belgium;BEL;Europe +Benin;BEN;Middle East & Africa +Bonaire, Sint Eustatius and Saba;BES;Latin America +Burkina Faso;BFA;Middle East & Africa +Bangladesh;BGD;Asia-Pacific +Bulgaria;BGR;Europe +Bahrain;BHR;Middle East & Africa +Bahamas;BHS;Latin America +Bosnia and Herzegovina;BIH;Europe +Saint Barthelemy;BLM;Latin America +Belarus;BLR;Europe +Belize;BLZ;Latin America +Bermuda;BMU;Latin America +Bolivia, Plurinational State of;BOL;Latin America +Brazil;BRA;Latin America +Barbados;BRB;Latin America +Brunei Darussalam;BRN;Asia-Pacific +Bhutan;BTN;Asia-Pacific +Bouvet Island;BVT;Asia-Pacific +Botswana;BWA;Middle East & Africa +Central African Republic;CAF;Middle East & Africa +Canada;CAN;North America +Cocos (Keeling) Islands;CCK;Asia-Pacific +Switzerland;CHE;Europe +Chile;CHL;Latin America +China;CHN;Asia-Pacific +Cote d Ivoire;CIV;Middle East & Africa +Cameroon;CMR;Middle East & Africa +Congo, the Democratic Republic of the;COD;Middle East & Africa +Congo;COG;Middle East & Africa +Cook Islands;COK;Asia-Pacific +Colombia;COL;Latin America +Comoros;COM;Middle East & Africa +Cape Verde;CPV;Middle East & Africa +Costa Rica;CRI;Latin America +Cuba;CUB;Latin America +Curacao;CUW;Latin America +Christmas Island;CXR;Asia-Pacific +Cayman Islands;CYM;Latin America +Cyprus;CYP;Europe +Czech Republic;CZE;Europe +Germany;DEU;Europe +Djibouti;DJI;Middle East & Africa +Dominica;DMA;Latin America +Denmark;DNK;Europe +Dominican Republic;DOM;Latin America +Algeria;DZA;Middle East & Africa +Ecuador;ECU;Latin America +Egypt;EGY;Middle East & Africa +Eritrea;ERI;Middle East & Africa +Western Sahara;ESH;Middle East & Africa +Spain;ESP;Europe +Estonia;EST;Europe +Ethiopia;ETH;Middle East & Africa +Finland;FIN;Europe +Fiji;FJI;Asia-Pacific +Falkland Islands (Malvinas);FLK;Latin America +France;FRA;Europe +Faroe Islands;FRO;Europe +Micronesia, Federated States of;FSM;Asia-Pacific +Gabon;GAB;Middle East & Africa +United Kingdom;GBR;Europe +Georgia;GEO;Europe +Guernsey;GGY;Europe +Ghana;GHA;Middle East & Africa +Gibraltar;GIB;Europe +Guinea;GIN;Middle East & Africa +Guadeloupe;GLP;Latin America +Gambia;GMB;Middle East & Africa +Guinea-Bissau;GNB;Middle East & Africa +Equatorial Guinea;GNQ;Middle East & Africa +Greece;GRC;Europe +Grenada;GRD;Latin America +Greenland;GRL;Europe +Guatemala;GTM;Latin America +French Guiana;GUF;Latin America +Guam;GUM;Asia-Pacific +Guyana;GUY;Latin America +Hong Kong;HKG;Asia-Pacific +Heard Island and McDonald Islands;HMD;Asia-Pacific +Honduras;HND;Latin America +Croatia;HRV;Europe +Haiti;HTI;Latin America +Hungary;HUN;Europe +Indonesia;IDN;Asia-Pacific +Isle of Man;IMN;Europe +India;IND;Asia-Pacific +British Indian Ocean Territory;IOT;Asia-Pacific +Ireland;IRL;Europe +Iran, Islamic Republic of;IRN;Middle East & Africa +Iraq;IRQ;Middle East & Africa +Iceland;ISL;Europe +Israel;ISR;Middle East & Africa +Italy;ITA;Europe +Jamaica;JAM;Latin America +Jersey;JEY;Europe +Jordan;JOR;Middle East & Africa +Japan;JPN;Asia-Pacific +Kazakhstan;KAZ;Asia-Pacific +Kenya;KEN;Middle East & Africa +Kyrgyzstan;KGZ;Asia-Pacific +Cambodia;KHM;Asia-Pacific +Kiribati;KIR;Asia-Pacific +Saint Kitts and Nevis;KNA;Latin America +Korea, Republic of;KOR;Asia-Pacific +Kuwait;KWT;Middle East & Africa +Lao People's Democratic Republic;LAO;Asia-Pacific +Lebanon;LBN;Middle East & Africa +Liberia;LBR;Middle East & Africa +Libya;LBY;Middle East & Africa +Saint Lucia;LCA;Latin America +Liechtenstein;LIE;Europe +Sri Lanka;LKA;Asia-Pacific +Lesotho;LSO;Middle East & Africa +Lithuania;LTU;Europe +Luxembourg;LUX;Europe +Latvia;LVA;Europe +Macao;MAC;Asia-Pacific +Saint Martin (French part);MAF;Latin America +Morocco;MAR;Middle East & Africa +Monaco;MCO;Europe +Moldova, Republic of;MDA;Europe +Madagascar;MDG;Middle East & Africa +Maldives;MDV;Asia-Pacific +Mexico;MEX;North America +Marshall Islands;MHL;Asia-Pacific +Macedonia, the former Yugoslav Republic of;MKD;Europe +Mali;MLI;Middle East & Africa +Malta;MLT;Europe +Myanmar;MMR;Asia-Pacific +Montenegro;MNE;Europe +Mongolia;MNG;Asia-Pacific +Northern Mariana Islands;MNP;Asia-Pacific +Mozambique;MOZ;Middle East & Africa +Mauritania;MRT;Middle East & Africa +Montserrat;MSR;Latin America +Martinique;MTQ;Latin America +Mauritius;MUS;Middle East & Africa +Malawi;MWI;Middle East & Africa +Malaysia;MYS;Asia-Pacific +Mayotte;MYT;Middle East & Africa +Namibia;NAM;Middle East & Africa +New Caledonia;NCL;Asia-Pacific +Niger;NER;Middle East & Africa +Norfolk Island;NFK;Asia-Pacific +Nigeria;NGA;Middle East & Africa +Nicaragua;NIC;Latin America +Niue;NIU;Asia-Pacific +Netherlands;NLD;Europe +Norway;NOR;Europe +Nepal;NPL;Asia-Pacific +Nauru;NRU;Asia-Pacific +New Zealand;NZL;Asia-Pacific +Oman;OMN;Middle East & Africa +Pakistan;PAK;Asia-Pacific +Panama;PAN;Latin America +Pitcairn;PCN;Asia-Pacific +Peru;PER;Latin America +Philippines;PHL;Asia-Pacific +Palau;PLW;Asia-Pacific +Papua New Guinea;PNG;Asia-Pacific +Poland;POL;Europe +Puerto Rico;PRI;Latin America +Korea, Democratic People's Republic of;PRK;Asia-Pacific +Portugal;PRT;Europe +Paraguay;PRY;Latin America +Palestine, State of;PSE;Middle East & Africa +French Polynesia;PYF;Asia-Pacific +Qatar;QAT;Middle East & Africa +Reunion;REU;Middle East & Africa +Romania;ROU;Europe +Russian Federation;RUS;Europe +Rwanda;RWA;Middle East & Africa +Saudi Arabia;SAU;Middle East & Africa +Sudan;SDN;Middle East & Africa +Senegal;SEN;Middle East & Africa +Singapore;SGP;Asia-Pacific +South Georgia and the South Sandwich Islands;SGS;Latin America +Saint Helena, Ascension and Tristan da Cunha;SHN;Middle East & Africa +Svalbard and Jan Mayen;SJM;Europe +Solomon Islands;SLB;Asia-Pacific +Sierra Leone;SLE;Middle East & Africa +El Salvador;SLV;Latin America +San Marino;SMR;Europe +Somalia;SOM;Middle East & Africa +Saint Pierre and Miquelon;SPM;Latin America +Serbia;SRB;Europe +South Sudan;SSD;Middle East & Africa +Sao Tome and Principe;STP;Middle East & Africa +Suriname;SUR;Latin America +Slovakia;SVK;Europe +Slovenia;SVN;Europe +Sweden;SWE;Europe +Swaziland;SWZ;Middle East & Africa +Sint Maarten (Dutch part);SXM;Latin America +Seychelles;SYC;Middle East & Africa +Syrian Arab Republic;SYR;Middle East & Africa +Turks and Caicos Islands;TCA;Latin America +Chad;TCD;Middle East & Africa +Togo;TGO;Middle East & Africa +Thailand;THA;Asia-Pacific +Tajikistan;TJK;Asia-Pacific +Tokelau;TKL;Asia-Pacific +Turkmenistan;TKM;Asia-Pacific +Timor-Leste;TLS;Asia-Pacific +Tonga;TON;Asia-Pacific +Trinidad and Tobago;TTO;Latin America +Tunisia;TUN;Middle East & Africa +Turkey;TUR;Asia-Pacific +Tuvalu;TUV;Asia-Pacific +Taiwan, Province of China;TWN;Asia-Pacific +Tanzania, United Republic of;TZA;Middle East & Africa +Uganda;UGA;Middle East & Africa +Ukraine;UKR;Europe +United States Minor Outlying Islands;UMI;Asia-Pacific +Uruguay;URY;Latin America +United States;USA;North America +Uzbekistan;UZB;Asia-Pacific +Holy See (Vatican City State);VAT;Europe +Saint Vincent and the Grenadines;VCT;Latin America +Venezuela, Bolivarian Republic of;VEN;Latin America +Virgin Islands, British;VGB;Latin America +Virgin Islands, U.S.;VIR;Latin America +Viet Nam;VNM;Asia-Pacific +Vanuatu;VUT;Asia-Pacific +Wallis and Futuna;WLF;Asia-Pacific +Samoa;WSM;Asia-Pacific +Yemen;YEM;Middle East & Africa +South Africa;ZAF;Middle East & Africa +Zambia;ZMB;Middle East & Africa +Zimbabwe;ZWE;Middle East & Africa From ce5e7c846760215fb952f3efce341990c7eb6f9e Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 21 Jul 2026 15:55:50 +0200 Subject: [PATCH 07/40] calc synthetic Fibre production (calcPlSyntheticFibre) --- R/calcPlSyntheticFibre.R | 48 +++++++++++++++++++++++++++++++++++++ man/calcPlSyntheticFibre.Rd | 30 +++++++++++++++++++++++ 2 files changed, 78 insertions(+) create mode 100644 R/calcPlSyntheticFibre.R create mode 100644 man/calcPlSyntheticFibre.Rd diff --git a/R/calcPlSyntheticFibre.R b/R/calcPlSyntheticFibre.R new file mode 100644 index 00000000..497bea59 --- /dev/null +++ b/R/calcPlSyntheticFibre.R @@ -0,0 +1,48 @@ +#' Calculate synthetic fibre production by country +#' +#' Combines the global synthetic fibre production time series (Polyester, +#' Polyamide (nylon) and Acrylic) from Textile Exchange with the estimated +#' country-level production shares based on Credence Research market data +#' on monoethylene glycol (MEG) to yield a total synthetic +#' fibre production by country and year. +#' +#' @return A list in \code{\link[madrat]{calcOutput}} format with total synthetic +#' fibre production by country and year. +#' @author Leonie Schweiger +#' @seealso [readTextileExchange()] +#' @examples +#' \dontrun{ +#' a <- calcOutput("PlSyntheticFibre") +#' } +#' @importFrom magclass dimSums collapseDim setYears getItems getYears new.magpie +#' @export +calcPlSyntheticFibre <- function() { + # global synthetic fibre production per year (sum over the three fibre types) + total <- dimSums( + readSource("TextileExchange", subtype = "timeseries_by_type", convert = FALSE), + dim = 3 + ) + + # country-level production shares (fraction); single fibre (Polyester proxy) and + # single year (2024), applied as a static distribution key across all years + share <- setYears(collapseDim( + readSource("TextileExchange", subtype = "region_share", convert = TRUE) + ), NULL) / 100 + + # production by country and year = global total(year) * country share + x <- total * share + + return(list( + x = x, + weight = NULL, + unit = "Mt", + description = paste( + "Synthetic fibre production (Polyester + Polyamide (nylon) + Acrylic) by", + "country, 2020-2024, from Textile Exchange Materials Market Report 2025.", + "Global totals disaggregated to countries using the 2024 regional split", + "(polyester/MEG proxy) distributed by chemical energy consumption." + ), + note = "dimensions: (Time,Region,value)", + min = 0 + )) +} diff --git a/man/calcPlSyntheticFibre.Rd b/man/calcPlSyntheticFibre.Rd new file mode 100644 index 00000000..5110df55 --- /dev/null +++ b/man/calcPlSyntheticFibre.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcPlSyntheticFibre.R +\name{calcPlSyntheticFibre} +\alias{calcPlSyntheticFibre} +\title{Calculate synthetic fibre production by country} +\usage{ +calcPlSyntheticFibre() +} +\value{ +A list in \code{\link[madrat]{calcOutput}} format with total synthetic + fibre production by country and year. +} +\description{ +Combines the global synthetic fibre production time series (Polyester, +Polyamide (nylon) and Acrylic) from Textile Exchange with the estimated +country-level production shares based on Credence Research market data +on monoethylene glycol (MEG) to yield a total synthetic +fibre production by country and year. +} +\examples{ +\dontrun{ +a <- calcOutput("PlSyntheticFibre") +} +} +\seealso{ +[readTextileExchange()] +} +\author{ +Leonie Schweiger +} From 41ed7711baee17c1a54e101c295862477739a95a Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 21 Jul 2026 16:50:35 +0200 Subject: [PATCH 08/40] add synthetic rubber production from IRSG --- R/calcPlSyntheticRubber.R | 53 ++++++++++++++++++ R/convertIRSG.R | 43 +++++++++++++++ R/convertTextileExchange.R | 3 +- R/readIRSG.R | 59 +++++++++++++++++++++ inst/extdata/regional/regionmappingIRSG.csv | 29 ++++++++++ man/calcPlSyntheticRubber.Rd | 31 +++++++++++ man/convertIRSG.Rd | 29 ++++++++++ man/readIRSG.Rd | 35 ++++++++++++ 8 files changed, 281 insertions(+), 1 deletion(-) create mode 100644 R/calcPlSyntheticRubber.R create mode 100644 R/convertIRSG.R create mode 100644 R/readIRSG.R create mode 100644 inst/extdata/regional/regionmappingIRSG.csv create mode 100644 man/calcPlSyntheticRubber.Rd create mode 100644 man/convertIRSG.Rd create mode 100644 man/readIRSG.Rd diff --git a/R/calcPlSyntheticRubber.R b/R/calcPlSyntheticRubber.R new file mode 100644 index 00000000..40d45953 --- /dev/null +++ b/R/calcPlSyntheticRubber.R @@ -0,0 +1,53 @@ +#' Calculate synthetic rubber production by country +#' +#' Combines the IRSG regional synthetic rubber production (disaggregated to +#' country level via chemical energy consumption) with the global production +#' totals for the more recent years. For years in which only a global figure is +#' available, country production is obtained by multiplying the global total by +#' each country's production share from the closest year for which country data +#' exist. +#' +#' @return A list in \code{\link[madrat]{calcOutput}} format with synthetic +#' rubber production by country and year. +#' @author Leonie Schweiger +#' @seealso [readIRSG()] +#' @examples +#' \dontrun{ +#' a <- calcOutput("PlSyntheticRubber") +#' } +#' @importFrom magclass dimSums getYears setYears mbind +#' @export +calcPlSyntheticRubber <- function() { + # country-level production for the years with a regional split (2018-2020) + countryProd <- readSource("IRSG", subtype = "regional", convert = TRUE) + # global totals for the years with only a global figure (2021-2024) + globalTotal <- readSource("IRSG", subtype = "global_total", convert = FALSE) + getNames(globalTotal) <- NULL + + regionalYears <- getYears(countryProd, as.integer = TRUE) + globalYears <- getYears(globalTotal, as.integer = TRUE) + onlyGlobalYears <- setdiff(globalYears, regionalYears) + + # for each global-only year, apply the country shares of the closest year with data + shares <- countryProd/dimSums(countryProd, dim=1) + target_years = union(regionalYears, globalYears) + shares <- toolInterpolate(shares, years=target_years, extrapolate=TRUE) + globalProd <- globalTotal[,onlyGlobalYears,] * shares[,onlyGlobalYears,] + + # 2018-2020 taken directly, 2021-2024 derived from global totals * closest-year shares + x <- mbind(countryProd, globalProd) + + return(list( + x = x, + weight = NULL, + unit = "Mt", + description = paste( + "Synthetic rubber production by country and year from IRSG. Regional", + "production (2018-2020) is disaggregated to countries by chemical energy", + "consumption; years with only a global total (2021-2024) are split using", + "each country's production share from the closest year with country data." + ), + note = "dimensions: (Time,Region,value)", + min = 0 + )) +} diff --git a/R/convertIRSG.R b/R/convertIRSG.R new file mode 100644 index 00000000..a306da4d --- /dev/null +++ b/R/convertIRSG.R @@ -0,0 +1,43 @@ +#' Convert IRSG synthetic rubber data to a magpie object at country level +#' +#' Disaggregates the IRSG regional synthetic rubber production to ISO country +#' level. The regions (Asia, Europe, Americas, Africa) are split into their +#' member countries (see \code{regionmappingIRSG.csv}) weighted by country-level +#' chemical energy consumption from \code{\link[mrindustry]{calcChemicalTotal}}. +#' +#' Only the "regional" subtype is country-resolved. The "global_total" subtype +#' is global data and must be read with \code{convert = FALSE}. +#' +#' @param x magpie object of IRSG regional data. +#' @param subtype Character string, must be "regional". +#' @return magpie object of the IRSG data disaggregated to country level. +#' @author Leonie Schweiger +#' +#' @importFrom magclass getYears setYears dimSums +convertIRSG <- function(x, subtype) { + if (subtype != "regional") { + stop( + "convertIRSG only supports subtype 'regional'. Global data ('global_total') ", + "is not country-resolved; read it with convert = FALSE." + ) + } + + # region -> country mapping (IRSG grouping from the source's country lists) + map <- toolGetMapping("regionmappingIRSG.csv", type = "regional", where = "mrmfa") + countries <- unique(map$CountryCode) + + # country-level chemical energy consumption as disaggregation weight + weight <- calcOutput("ChemicalTotal", aggregate = FALSE)[countries,getYears(x),] + getNames(weight) <- NULL + + # disaggregate regions to countries, weighted by chemical energy consumption + x <- toolAggregate(x, + rel = map, dim = 1, + from = "IRSGReg", to = "CountryCode", weight = weight + ) + + # countries outside the source's regions get zero production + x <- toolCountryFill(x, fill = 0, verbosity = 2) + + return(x) +} diff --git a/R/convertTextileExchange.R b/R/convertTextileExchange.R index 929bb0ae..1b97bdce 100644 --- a/R/convertTextileExchange.R +++ b/R/convertTextileExchange.R @@ -32,7 +32,8 @@ convertTextileExchange <- function(x) { # ChemicalTotal does not reach the share year (2024), so use its latest available # year and align it to the share year. chem <- calcOutput("ChemicalTotal", aggregate = FALSE) - chem <- setYears(chem[unique(map$CountryCode), tail(getYears(chem), 1), ], getYears(x)) + chem <- toolInterpolate(chem, union(getYears(chem), getYears(x)), extrapolate = TRUE) + chem <- chem[,getYears(x),] getNames(chem) <- NULL x <- toolAggregate(x, diff --git a/R/readIRSG.R b/R/readIRSG.R new file mode 100644 index 00000000..32594fc7 --- /dev/null +++ b/R/readIRSG.R @@ -0,0 +1,59 @@ +#' Read IRSG synthetic rubber data into a magpie object +#' +#' This function reads International Rubber Study Group (IRSG) data on synthetic +#' rubber (SR) production from an Excel file, based on a specified subtype, and +#' returns a magpie object. +#' +#' @param subtype Character string specifying the dataset: +#' - "global_total": global synthetic rubber production in Mt by year +#' (year, global_SR_production_Mt). Global data (region GLO). +#' - "regional": regional synthetic rubber production in Mt by region and +#' year (region, year, regional_SR_production_Mt). +#' Regions are Asia, Europe, Americas and Africa (IRSG grouping). +#' +#' @return magpie object of the IRSG synthetic rubber data +#' +#' @author Leonie Schweiger +#' +#' @seealso [readSource()] +#' +#' @examples +#' \dontrun{ +#' a <- readSource(type = "IRSG", subtype = "regional", convert = FALSE) +#' } +#' @importFrom readxl read_excel +#' @importFrom magclass as.magpie getComment<- +#' +readIRSG <- function(subtype) { + # --------------------------------------------------------------------------- + # Map subtype to Excel sheet and cell range (only the required columns) + params <- switch(subtype, + "global_total" = list(sheet = "global_total", range = "A1:B5"), + "regional" = list(sheet = "regional", range = "A1:C13"), + stop("Invalid subtype: ", subtype) + ) + + rawData <- read_excel( + path = "IRSG_rubber.xlsx", + sheet = params$sheet, + range = params$range + ) + + # --------------------------------------------------------------------------- + # Convert to magpie object (global for the totals, regional for the split) + magpieData <- switch(subtype, + "global_total" = { + rawData$region <- "GLO" + as.magpie(rawData[, c("region", "year", "global_SR_production_Mt")], + spatial = 1, temporal = 2) + }, + "regional" = as.magpie(rawData[, c("region", "year", "regional_SR_production_Mt")], + spatial = 1, temporal = 2), + stop("Unsupported subtype: ", subtype) + ) + + magpieData[is.na(magpieData)] <- 0 + getComment(magpieData) <- subtype + + return(magpieData) +} diff --git a/inst/extdata/regional/regionmappingIRSG.csv b/inst/extdata/regional/regionmappingIRSG.csv new file mode 100644 index 00000000..699ec44d --- /dev/null +++ b/inst/extdata/regional/regionmappingIRSG.csv @@ -0,0 +1,29 @@ + ,CountryCode,IRSGReg +China,CHN,Asia +India,IND,Asia +Indonesia,IDN,Asia +Japan,JPN,Asia +South Korea,KOR,Asia +Malaysia,MYS,Asia +Singapore,SGP,Asia +Taiwan,TWN,Asia +Thailand,THA,Asia +Belgium,BEL,Europe +Czech Republic,CZE,Europe +France,FRA,Europe +Germany,DEU,Europe +Italy,ITA,Europe +Netherlands,NLD,Europe +Poland,POL,Europe +Spain,ESP,Europe +United Kingdom,GBR,Europe +Russia,RUS,Europe +Serbia,SRB,Europe +Argentina,ARG,Americas +Brazil,BRA,Americas +Canada,CAN,Americas +Mexico,MEX,Americas +United States of America,USA,Americas +South Africa,ZAF,Africa +Saudi Arabia,SAU,Africa +Iran,IRN,Africa diff --git a/man/calcPlSyntheticRubber.Rd b/man/calcPlSyntheticRubber.Rd new file mode 100644 index 00000000..7c22c5f5 --- /dev/null +++ b/man/calcPlSyntheticRubber.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcPlSyntheticRubber.R +\name{calcPlSyntheticRubber} +\alias{calcPlSyntheticRubber} +\title{Calculate synthetic rubber production by country} +\usage{ +calcPlSyntheticRubber() +} +\value{ +A list in \code{\link[madrat]{calcOutput}} format with synthetic + rubber production by country and year. +} +\description{ +Combines the IRSG regional synthetic rubber production (disaggregated to +country level via chemical energy consumption) with the global production +totals for the more recent years. For years in which only a global figure is +available, country production is obtained by multiplying the global total by +each country's production share from the closest year for which country data +exist. +} +\examples{ +\dontrun{ +a <- calcOutput("PlSyntheticRubber") +} +} +\seealso{ +[readIRSG()] +} +\author{ +Leonie Schweiger +} diff --git a/man/convertIRSG.Rd b/man/convertIRSG.Rd new file mode 100644 index 00000000..c9c914c4 --- /dev/null +++ b/man/convertIRSG.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convertIRSG.R +\name{convertIRSG} +\alias{convertIRSG} +\title{Convert IRSG synthetic rubber data to a magpie object at country level} +\usage{ +convertIRSG(x, subtype) +} +\arguments{ +\item{x}{magpie object of IRSG regional data.} + +\item{subtype}{Character string, must be "regional".} +} +\value{ +magpie object of the IRSG data disaggregated to country level. +} +\description{ +Disaggregates the IRSG regional synthetic rubber production to ISO country +level. The regions (Asia, Europe, Americas, Africa) are split into their +member countries (see \code{regionmappingIRSG.csv}) weighted by country-level +chemical energy consumption from \code{\link[mrindustry]{calcChemicalTotal}}. +} +\details{ +Only the "regional" subtype is country-resolved. The "global_total" subtype +is global data and must be read with \code{convert = FALSE}. +} +\author{ +Leonie Schweiger +} diff --git a/man/readIRSG.Rd b/man/readIRSG.Rd new file mode 100644 index 00000000..39c9a208 --- /dev/null +++ b/man/readIRSG.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readIRSG.R +\name{readIRSG} +\alias{readIRSG} +\title{Read IRSG synthetic rubber data into a magpie object} +\usage{ +readIRSG(subtype) +} +\arguments{ +\item{subtype}{Character string specifying the dataset: +- "global_total": global synthetic rubber production in Mt by year + (year, global_SR_production_Mt). Global data (region GLO). +- "regional": regional synthetic rubber production in Mt by region and + year (region, year, regional_SR_production_Mt). + Regions are Asia, Europe, Americas and Africa (IRSG grouping).} +} +\value{ +magpie object of the IRSG synthetic rubber data +} +\description{ +This function reads International Rubber Study Group (IRSG) data on synthetic +rubber (SR) production from an Excel file, based on a specified subtype, and +returns a magpie object. +} +\examples{ +\dontrun{ +a <- readSource(type = "IRSG", subtype = "regional", convert = FALSE) +} +} +\seealso{ +[readSource()] +} +\author{ +Leonie Schweiger +} From a68a22cb85c1faedda5e652c0feeed355b63b98c Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 22 Jul 2026 09:53:32 +0200 Subject: [PATCH 09/40] disaggregation of PlasticsEurope based on chemical energy consumption --- NAMESPACE | 6 ++++++ R/convertPlasticsEurope.R | 12 ++++++++---- R/readPlasticsEurope.R | 6 +++--- man/readPlasticsEurope.Rd | 8 ++++---- 4 files changed, 21 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index aa14ed82..98686476 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,8 @@ # Generated by roxygen2: do not edit by hand export(MplotMulti) +export(calcPlSyntheticFibre) +export(calcPlSyntheticRubber) export(getSources_mrmfa) import(GDPuc) import(madrat) @@ -29,14 +31,18 @@ importFrom(magclass,"getItems<-") importFrom(magclass,"getNames<-") importFrom(magclass,add_dimension) importFrom(magclass,as.magpie) +importFrom(magclass,collapseDim) importFrom(magclass,collapseNames) importFrom(magclass,dimSums) +importFrom(magclass,getComment) importFrom(magclass,getItems) importFrom(magclass,getNames) importFrom(magclass,getYears) importFrom(magclass,mbind) importFrom(magclass,mselect) +importFrom(magclass,new.magpie) importFrom(magclass,setNames) +importFrom(magclass,setYears) importFrom(magclass,where) importFrom(magpiesets,findset) importFrom(magrittr,"%>%") diff --git a/R/convertPlasticsEurope.R b/R/convertPlasticsEurope.R index fff75e67..72ce1833 100644 --- a/R/convertPlasticsEurope.R +++ b/R/convertPlasticsEurope.R @@ -9,15 +9,19 @@ #' } convertPlasticsEurope <- function(x) { - # disaggregate to iso3 country level by GDP weighting + # disaggregate to iso3 country level by chemical energy consumption weighting + # Countries mapped to "Rest" are outside PlasticsEurope's 8 reporting regions + # (e.g. Western Balkans, Georgia). They are intentionally dropped here and + # filled with 0 production below, since PlasticsEurope does not cover them. region_map <- toolGetMapping("regionmappingPlasticsEurope.csv", type = "regional", where = "mrmfa") %>% filter(.data$PlasticsEuropeReg != "Rest") - GDP <- calcOutput("CoGDP", perCapita = FALSE, aggregate = FALSE)[, getYears(x), ] + chem <- calcOutput("ChemicalTotal", aggregate = FALSE) + chem <- toolInterpolate(chem, union(getYears(chem), getYears(x)), extrapolate = TRUE) x <- toolAggregate(x, rel = region_map, dim = 1, from = "PlasticsEuropeReg", to = "CountryCode", - weight = GDP[unique(region_map$CountryCode), , ]) - x <- toolCountryFill(x, fill = 0) + weight = chem[unique(region_map$CountryCode), getYears(x), ]) + x <- toolCountryFill(x, fill = 0, verbosity = 2) return(x) } diff --git a/R/readPlasticsEurope.R b/R/readPlasticsEurope.R index 8293ce85..794d5dc0 100644 --- a/R/readPlasticsEurope.R +++ b/R/readPlasticsEurope.R @@ -30,15 +30,15 @@ readPlasticsEurope <- function(subtype) { # Map subtype to Excel file parameters params <- switch(subtype, "Production_region" = list( - sheet = "PlasticProduction_region", + sheet = "Production_region", range = "A1:J20" ), "SectorShare_EU" = list( - sheet = "PlasticShare_EU", + sheet = "SectorShare_EU", range = "A1:I20" ), "EoL_EU" = list( - sheet = "PlasticEoL_EU", + sheet = "EoL_EU", range = "A1:D16" ), stop("Invalid subtype: ", subtype) diff --git a/man/readPlasticsEurope.Rd b/man/readPlasticsEurope.Rd index c024a111..ce6a52b7 100644 --- a/man/readPlasticsEurope.Rd +++ b/man/readPlasticsEurope.Rd @@ -9,9 +9,9 @@ readPlasticsEurope(subtype) \arguments{ \item{subtype}{Character string specifying the dataset and scope. Valid formats include: -- "PlasticProduction_region" (plastic production in Mt, dimensions: region, year) -- "PlasticShare_EU" (plastic demand shares (%) by use category in the EU, dimensions: category, year) -- "PlasticEoL_EU" (plastic waste treatment in the EU in Mt, dimensions: year, treatment)} +- "Production_region" (plastic production in Mt, dimensions: region, year) +- "SectorShare_EU" (plastic demand shares (%) by use category in the EU, dimensions: category, year) +- "EoL_EU" (plastic waste treatment in the EU in Mt, dimensions: year, treatment)} } \value{ magpie object of the Plastics Europe data @@ -23,7 +23,7 @@ based on a specified subtype, and returns a cleaned magpie object. } \examples{ \dontrun{ -a <- readSource(type = "PlasticsEurope", subtype = "PlasticProduction_region") +a <- readSource(type = "PlasticsEurope", subtype = "Production_region") } } \seealso{ From ebe208c4f3aa6f6dffa5a3ca60ff90d8c5c3753c Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 22 Jul 2026 14:12:02 +0200 Subject: [PATCH 10/40] read sector_shares subtype from GaoCabrera2025 --- R/readGaoCabrera2025.R | 148 ++++++++++++++++++++++++++------------ man/readGaoCabrera2025.Rd | 44 ++++++++---- 2 files changed, 135 insertions(+), 57 deletions(-) diff --git a/R/readGaoCabrera2025.R b/R/readGaoCabrera2025.R index ef202a6e..664790cf 100644 --- a/R/readGaoCabrera2025.R +++ b/R/readGaoCabrera2025.R @@ -1,65 +1,125 @@ -#' Read Gao & Cabrera-Serrenho 2025 apparent polymer consumption +#' Read Gao & Cabrera-Serrenho 2025 polymer consumption and end-use distribution #' #' @description -#' Read the apparent polymer consumption ("D") from Gao & Cabrera-Serrenho (2025), -#' doi:10.1016/j.resconrec.2025.108518, data from doi:10.17863/CAM.101645, -#' from the MATLAB file \code{D.mat}. D is a 1x8 cell array -#' (one cell per world region); each cell is a 14x44 matrix with rows = 14 -#' polymer groups and columns = years 1978-2021. Apparent consumption = ICIS -#' production + net trade (virgin + recycled), in kilotonnes (kt). -#' Note that, per the paper SI, the years 2020 and 2021 rely on incomplete trade -#' data and are less reliable. +#' Read data from Gao & Cabrera-Serrenho (2025), +#' doi:10.1016/j.resconrec.2025.108518, data from doi:10.17863/CAM.101645. +#' Two datasets are available via \code{subtype}: +#' +#' \code{"consumption"} (default): apparent polymer consumption ("D") from the +#' MATLAB file \code{D.mat}. D is a 1x8 cell array (one cell per world region); +#' each cell is a 14x44 matrix with rows = 14 polymer groups and columns = +#' years 1978-2021. Apparent consumption = ICIS production + net trade +#' (virgin + recycled), in kilotonnes (kt). Note that, per the paper SI, the +#' years 2020 and 2021 rely on incomplete trade data and are less reliable. +#' +#' \code{"sector_shares"}: the distribution of each polymer across 8 end-use +#' sectors, from the MATLAB file \code{distributionsV3.mat}. The file stores 12 +#' named 8x1 vectors (one per polymer, each summing to 1 across the sectors); +#' these are mapped onto the same 14 polymer groups as \code{"consumption"}. +#' The two fibre groups without their own vector (Polyester fibre, Other fibre +#' (acrylic)) reuse the Polyamide-fibre distribution (\code{PPAdist}). The +#' result is not country-resolved, so read it with \code{convert = FALSE}. #' #' @author Leonie Schweiger -#' @return MagPIE object with apparent consumption in kt, dimensions -#' (region, year, polymer): 8 regions x 44 years x 14 polymers. +#' @param subtype Character string selecting the dataset: +#' \code{"consumption"} (default) returns apparent consumption in kt, +#' dimensions (region, year, polymer): 8 regions x 44 years x 14 polymers. +#' \code{"sector_shares"} returns unitless end-use sector shares, +#' dimensions (sector, polymer): 8 sectors x 14 polymers, each polymer +#' column summing to ~1. +#' @return MagPIE object (see \code{subtype}). #' @seealso \code{\link[madrat]{readSource}} #' @examples #' \dontrun{ -#' readSource("GaoCabrera2025", convert = FALSE) +#' readSource("GaoCabrera2025", subtype = "consumption", convert = FALSE) +#' readSource("GaoCabrera2025", subtype = "sector_shares", convert = FALSE) #' } -#' @importFrom magclass as.magpie -readGaoCabrera2025 <- function() { - # Region labels in the cell order of D.mat, matching the `region` column of - # regionmappingGaoCabrera2025.csv (note "and", not "&"). - regionLabels <- c( - "North America", "Latin America", "Western and Central Europe", - "Eastern Europe and Central Asia", "Africa", "Middle East", - "Northeast Asia", "South Asia and the Pacific" - ) - - # Polymer labels in matrix-row order (verified against paper text + SI Table S3). +#' @importFrom magclass as.magpie getComment<- +readGaoCabrera2025 <- function(subtype = "consumption") { + # Polymer labels in D.mat matrix-row order (verified against paper text + + # SI Table S3). Shared by both subtypes so their polymer dimension matches. polymerLabels <- c( "LDPE", "LLDPE", "HDPE", "PP", "PS", "PVC", "PET", "PUR", "Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)", "Rubbers", "Other thermoplastics", "Other thermosets" ) - - years <- 1978:2021 # 44 columns - nReg <- length(regionLabels) # 8 nPoly <- length(polymerLabels) # 14 - mat <- R.matlab::readMat("D.mat") + x <- switch(subtype, + "consumption" = { + # Apparent polymer consumption from D.mat -> magpie (region, year, polymer). + # Region labels in the cell order of D.mat, matching the `region` column of + # regionmappingGaoCabrera2025.csv (note "and", not "&"). + regionLabels <- c( + "North America", "Latin America", "Western and Central Europe", + "Eastern Europe and Central Asia", "Africa", "Middle East", + "Northeast Asia", "South Asia and the Pacific" + ) + + years <- 1978:2021 # 44 columns + nReg <- length(regionLabels) # 8 - # mat$D is a length-8 list; each element is a length-1 list holding a 14x44 matrix. - cells <- lapply(mat$D, function(cell) { - mtx <- if (is.list(cell)) cell[[1]] else cell # unwrap the 1-element list - as.matrix(mtx) - }) + mat <- R.matlab::readMat("D.mat") - # build a tidy long table (region, polymer, year, value in kt) - rows <- lapply(seq_len(nReg), function(m) { - data.frame( - region = regionLabels[m], - polymer = rep(polymerLabels, times = length(years)), - year = rep(years, each = nPoly), - value = as.vector(cells[[m]]), - stringsAsFactors = FALSE - ) - }) - long <- do.call(rbind, rows) + # mat$D is a length-8 list; each element is a length-1 list holding a 14x44 matrix. + cells <- lapply(mat$D, function(cell) { + mtx <- if (is.list(cell)) cell[[1]] else cell # unwrap the 1-element list + as.matrix(mtx) + }) - x <- as.magpie(long, spatial = "region", temporal = "year", datacol = "value") + # build a tidy long table (region, polymer, year, value in kt) + rows <- lapply(seq_len(nReg), function(m) { + data.frame( + region = regionLabels[m], + polymer = rep(polymerLabels, times = length(years)), + year = rep(years, each = nPoly), + value = as.vector(cells[[m]]), + stringsAsFactors = FALSE + ) + }) + long <- do.call(rbind, rows) + + as.magpie(long, spatial = "region", temporal = "year", datacol = "value") + }, + "sector_shares" = { + # End-use sector distribution from distributionsV3.mat -> magpie (sector, polymer). + # Sector row order of each 8x1 vector. + sectorLabels <- c( + "packaging", "transportation", "building and construction", + "electrical and electronic", "consumer and institutional", + "industrial machinery", "textile", "other" + ) + + # Map each of the 14 D.mat polymer groups to the source variable in the .mat + # file. Only 12 vectors exist; the two fibres without a vector (Polyester + # fibre, Other fibre (acrylic)) reuse the Polyamide-fibre vector (PPAdist). + polymerToVar <- c( + "LDPE" = "LDPEdist", "LLDPE" = "LLDPEdist", "HDPE" = "HDPEdist", + "PP" = "PPdist", "PS" = "PSdist", "PVC" = "PVCdist", "PET" = "PETdist", + "PUR" = "PURdist", "Polyester fibre" = "PPAdist", + "Polyamide fibre" = "PPAdist", "Other fibre (acrylic)" = "PPAdist", + "Rubbers" = "Rubberdist", "Other thermoplastics" = "Otherdist", + "Other thermosets" = "Epoxydist" + ) + + mat <- R.matlab::readMat("distributionsV3.mat") + + # build a tidy long table (sector, polymer, value = unitless share) + rows <- lapply(polymerLabels, function(poly) { + data.frame( + sector = sectorLabels, + polymer = poly, + value = as.vector(mat[[polymerToVar[[poly]]]]), + stringsAsFactors = FALSE + ) + }) + long <- do.call(rbind, rows) + + as.magpie(long, datacol = "value") + }, + stop("Invalid subtype: ", subtype) + ) + getComment(x) <- subtype return(x) } diff --git a/man/readGaoCabrera2025.Rd b/man/readGaoCabrera2025.Rd index 76c10de2..edaad36c 100644 --- a/man/readGaoCabrera2025.Rd +++ b/man/readGaoCabrera2025.Rd @@ -2,27 +2,45 @@ % Please edit documentation in R/readGaoCabrera2025.R \name{readGaoCabrera2025} \alias{readGaoCabrera2025} -\title{Read Gao & Cabrera-Serrenho 2025 apparent polymer consumption} +\title{Read Gao & Cabrera-Serrenho 2025 polymer consumption and end-use distribution} \usage{ -readGaoCabrera2025() +readGaoCabrera2025(subtype = "consumption") +} +\arguments{ +\item{subtype}{Character string selecting the dataset: +\code{"consumption"} (default) returns apparent consumption in kt, +dimensions (region, year, polymer): 8 regions x 44 years x 14 polymers. +\code{"sector_shares"} returns unitless end-use sector shares, +dimensions (sector, polymer): 8 sectors x 14 polymers, each polymer +column summing to ~1.} } \value{ -MagPIE object with apparent consumption in kt, dimensions -(region, year, polymer): 8 regions x 44 years x 14 polymers. +MagPIE object (see \code{subtype}). } \description{ -Read the apparent polymer consumption ("D") from Gao & Cabrera-Serrenho (2025), -doi:10.1016/j.resconrec.2025.108518, data from doi:10.17863/CAM.101645, -from the MATLAB file \code{D.mat}. D is a 1x8 cell array -(one cell per world region); each cell is a 14x44 matrix with rows = 14 -polymer groups and columns = years 1978-2021. Apparent consumption = ICIS -production + net trade (virgin + recycled), in kilotonnes (kt). -Note that, per the paper SI, the years 2020 and 2021 rely on incomplete trade -data and are less reliable. +Read data from Gao & Cabrera-Serrenho (2025), +doi:10.1016/j.resconrec.2025.108518, data from doi:10.17863/CAM.101645. +Two datasets are available via \code{subtype}: + +\code{"consumption"} (default): apparent polymer consumption ("D") from the +MATLAB file \code{D.mat}. D is a 1x8 cell array (one cell per world region); +each cell is a 14x44 matrix with rows = 14 polymer groups and columns = +years 1978-2021. Apparent consumption = ICIS production + net trade +(virgin + recycled), in kilotonnes (kt). Note that, per the paper SI, the +years 2020 and 2021 rely on incomplete trade data and are less reliable. + +\code{"sector_shares"}: the distribution of each polymer across 8 end-use +sectors, from the MATLAB file \code{distributionsV3.mat}. The file stores 12 +named 8x1 vectors (one per polymer, each summing to 1 across the sectors); +these are mapped onto the same 14 polymer groups as \code{"consumption"}. +The two fibre groups without their own vector (Polyester fibre, Other fibre +(acrylic)) reuse the Polyamide-fibre distribution (\code{PPAdist}). The +result is not country-resolved, so read it with \code{convert = FALSE}. } \examples{ \dontrun{ -readSource("GaoCabrera2025", convert = FALSE) +readSource("GaoCabrera2025", subtype = "consumption", convert = FALSE) +readSource("GaoCabrera2025", subtype = "sector_shares", convert = FALSE) } } \seealso{ From b665d72917b7de84d139a5199f5f07a3a0cec8ff Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 22 Jul 2026 14:57:37 +0200 Subject: [PATCH 11/40] calcPlProduction --- NAMESPACE | 3 ++ R/calcPlGaoCabrera.R | 2 +- R/calcPlPlasticsEurope.R | 2 +- R/calcPlProduction.R | 98 ++++++++++++++++++++++++++++++++++++++++ man/calcPlProduction.Rd | 43 ++++++++++++++++++ 5 files changed, 146 insertions(+), 2 deletions(-) create mode 100644 R/calcPlProduction.R create mode 100644 man/calcPlProduction.Rd diff --git a/NAMESPACE b/NAMESPACE index 98686476..5cd06dff 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand export(MplotMulti) +export(calcPlProduction) export(calcPlSyntheticFibre) export(calcPlSyntheticRubber) export(getSources_mrmfa) @@ -29,6 +30,7 @@ importFrom(dplyr,ungroup) importFrom(magclass,"getComment<-") importFrom(magclass,"getItems<-") importFrom(magclass,"getNames<-") +importFrom(magclass,"getSets<-") importFrom(magclass,add_dimension) importFrom(magclass,as.magpie) importFrom(magclass,collapseDim) @@ -38,6 +40,7 @@ importFrom(magclass,getComment) importFrom(magclass,getItems) importFrom(magclass,getNames) importFrom(magclass,getYears) +importFrom(magclass,magpiesort) importFrom(magclass,mbind) importFrom(magclass,mselect) importFrom(magclass,new.magpie) diff --git a/R/calcPlGaoCabrera.R b/R/calcPlGaoCabrera.R index 667ae59b..d17f2469 100644 --- a/R/calcPlGaoCabrera.R +++ b/R/calcPlGaoCabrera.R @@ -12,7 +12,7 @@ #' @seealso \code{\link{readGaoCabrera2025}}, \code{\link{calcPlPottinger}} #' @importFrom magclass dimSums getNames<- calcPlGaoCabrera <- function() { - x <- readSource("GaoCabrera2025") + x <- readSource("GaoCabrera2025", subtype = "consumption") # sum all 14 polymers into a single total and convert kt -> Mt x <- dimSums(x, dim = 3) / 1000 diff --git a/R/calcPlPlasticsEurope.R b/R/calcPlPlasticsEurope.R index d5301521..33c60345 100644 --- a/R/calcPlPlasticsEurope.R +++ b/R/calcPlPlasticsEurope.R @@ -6,7 +6,7 @@ calcPlPlasticsEurope <- function() { # --------------------------------------------------------------------------- # Read source data # --------------------------------------------------------------------------- - x <- readSource("PlasticsEurope", subtype = "PlasticProduction_region") + x <- readSource("PlasticsEurope", subtype = "Production_region") # --------------------------------------------------------------------------- # Return packaged output diff --git a/R/calcPlProduction.R b/R/calcPlProduction.R new file mode 100644 index 00000000..8c1be2e6 --- /dev/null +++ b/R/calcPlProduction.R @@ -0,0 +1,98 @@ +#' Calculate combined plastics, fibre and rubber production by country +#' +#' Merges the three country-level production series of the plastics subsystem +#' into a single magpie object with a \code{type} dimension +#' (\code{Fibre}, \code{Rubber}, \code{Plastics}) and backcasts each series to +#' 1950. Synthetic fibre comes from Textile Exchange +#' (\code{\link{calcPlSyntheticFibre}}), synthetic rubber from IRSG +#' (\code{\link{calcPlSyntheticRubber}}) and conventional plastics from Plastics +#' Europe (\code{\link{calcPlPlasticsEurope}}). +#' +#' Each source only covers recent years, so every series is backcast +#' independently along the total plastics trend: first with the OECD regional +#' plastic use (1990-2019, \code{readSource("OECD_Plastic", +#' "Use_1990-2019_region")}) and then with the Geyer et al. 2017 global +#' production (1950-2015, \code{readSource("Geyer", "Prod_1950-2015")}). Since +#' the fibre series only starts in 2020 - one year after the OECD reference ends +#' - its 2019 value is assumed equal to 2020 so that it overlaps the OECD +#' reference and can be backcast. +#' +#' @return A list in \code{\link[madrat]{calcOutput}} format with plastics, +#' fibre and rubber production by country, type and year (1950-2024). +#' @author Leonie Schweiger +#' @seealso [calcPlSyntheticFibre()], [calcPlSyntheticRubber()], +#' [calcPlPlasticsEurope()], [toolBackcastByReference()] +#' @examples +#' \dontrun{ +#' a <- calcOutput("PlProduction") +#' } +#' @importFrom magclass dimSums getYears setYears getNames getNames<- getItems +#' @importFrom magclass getSets<- collapseDim mbind new.magpie magpiesort +#' @export +calcPlProduction <- function() { + # --------------------------------------------------------------------------- + # Read the three country-level production series and tag each with a type name + # --------------------------------------------------------------------------- + prep <- function(m, typeName) { + m <- collapseDim(m) + getNames(m) <- typeName + m + } + fibre <- prep(calcOutput("PlSyntheticFibre", aggregate = FALSE), "Fibre") + rubber <- prep(calcOutput("PlSyntheticRubber", aggregate = FALSE), "Rubber") + plastics <- prep(calcOutput("PlPlasticsEurope", aggregate = FALSE), "Plastics") + + # --------------------------------------------------------------------------- + # Fibre only starts in 2020, one year after the OECD reference ends (2019). + # Assume fibre 2019 = fibre 2020 so it overlaps the OECD reference. + # --------------------------------------------------------------------------- + fibreFirstYear <- min(getYears(fibre, as.integer = TRUE)) + fibre <- mbind(setYears(fibre[, fibreFirstYear, ], "y2019"), fibre) + + # --------------------------------------------------------------------------- + # Build the two backcasting references (total plastics trend) + # --------------------------------------------------------------------------- + oecdTotal <- readSource("OECD_Plastic", subtype = "Use_1990-2019_region") + # clean set names + getSets(oecdTotal, fulldim = FALSE) <- c("region", "year", "data") + geyer <- readSource("Geyer", subtype = "Prod_1950-2015", convert = FALSE) + + # --------------------------------------------------------------------------- + # Backcast each source independently: OECD (-> 1990) then Geyer (-> 1950) + # --------------------------------------------------------------------------- + backcast <- function(s) { + s <- toolBackcastByReference(s, oecdTotal) + s <- toolBackcastByReference(s, geyer) + magpiesort(s) + } + fibre <- backcast(fibre) + rubber <- backcast(rubber) + plastics <- backcast(plastics) + + # --------------------------------------------------------------------------- + # trim to the last year covered by all types (sources may end in different years), + # then merge into the type dimension. + # --------------------------------------------------------------------------- + lastYear <- min(max(getYears(fibre)), max(getYears(rubber)), max(getYears(plastics))) + alignYears <- function(x) { + x <- x[,getYears(x) Date: Wed, 22 Jul 2026 17:08:31 +0200 Subject: [PATCH 12/40] calcPlSectorPolymerSplit --- NAMESPACE | 2 + R/calcPlSectorPolymerSplit.R | 96 +++++++++++++++++++++++++++++++++ man/calcPlSectorPolymerSplit.Rd | 43 +++++++++++++++ 3 files changed, 141 insertions(+) create mode 100644 R/calcPlSectorPolymerSplit.R create mode 100644 man/calcPlSectorPolymerSplit.Rd diff --git a/NAMESPACE b/NAMESPACE index 5cd06dff..15024d10 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(MplotMulti) export(calcPlProduction) +export(calcPlSectorPolymerSplit) export(calcPlSyntheticFibre) export(calcPlSyntheticRubber) export(getSources_mrmfa) @@ -39,6 +40,7 @@ importFrom(magclass,dimSums) importFrom(magclass,getComment) importFrom(magclass,getItems) importFrom(magclass,getNames) +importFrom(magclass,getSets) importFrom(magclass,getYears) importFrom(magclass,magpiesort) importFrom(magclass,mbind) diff --git a/R/calcPlSectorPolymerSplit.R b/R/calcPlSectorPolymerSplit.R new file mode 100644 index 00000000..67ebdfd4 --- /dev/null +++ b/R/calcPlSectorPolymerSplit.R @@ -0,0 +1,96 @@ +#' Calculate polymer and sector split shares within each plastics type +#' +#' @description +#' Split total Fibre, Rubber and Plastics consumption into individual polymers +#' and end-use sectors. Combines the apparent polymer consumption of Gao & +#' Cabrera-Serrenho (2025) (\code{readSource("GaoCabrera2025", "consumption")}) +#' with their polymer-specific end-use sector distribution +#' (\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every +#' country and year, the consumption of each polymer in each of the 8 end-use +#' sectors. These are normalized within each type (\code{Fibre}, \code{Rubber}, +#' \code{Plastics}) so that the shares over \code{(polymer, sector)} sum to 1. +#' +#' Multiplying the result with a \code{(time, region, type)} total - e.g. the +#' output of \code{\link{calcPlProduction}} - yields absolute values per +#' \code{(time, region, type, polymer, sector)}. That multiplication happens in +#' remind-mfa, not here. The three fibre polymers form type \code{Fibre}, +#' \code{Rubbers} forms type \code{Rubber}, and the remaining polymers form type +#' \code{Plastics}, matching the \code{type} dimension of +#' \code{\link{calcPlProduction}}. +#' +#' @return A list in \code{\link[madrat]{calcOutput}} format with the polymer and +#' sector split shares by country, year, type, polymer and sector (1978-2021). +#' The weight is the per-type total consumption. Years 2020-2021 rely on +#' incomplete Gao trade data. +#' @author Leonie Schweiger +#' @seealso \code{\link{readGaoCabrera2025}}, \code{\link{calcPlProduction}} +#' @examples +#' \dontrun{ +#' a <- calcOutput("PlSectorPolymerSplit") +#' } +#' @importFrom magclass getItems collapseDim add_dimension mselect mbind dimSums +#' @importFrom magclass getSets getSets<- +#' @export +calcPlSectorPolymerSplit <- function() { + # --------------------------------------------------------------------------- + # Inputs: apparent polymer consumption (ISO3 x year x polymer, kt) and the + # polymer-specific end-use sector distribution (sector x polymer, unitless). + # --------------------------------------------------------------------------- + cons <- readSource("GaoCabrera2025", subtype = "consumption") + # sector_shares carries both sector and polymer as name subdims (sector.polymer) + # with only dummy spatial/temporal dims; collapse those so it broadcasts cleanly. + shares <- collapseDim(readSource("GaoCabrera2025", subtype = "sector_shares", convert = FALSE)) + + # --------------------------------------------------------------------------- + # Outer product cons x shares -> absolute consumption per polymer and sector. + # `cons` has name dim polymer; `shares` has name dims sector.polymer. The + # product matches on the shared polymer subdim and broadcasts cons over sector + # (and the single shares value over region/year). + # --------------------------------------------------------------------------- + absolute <- cons * shares # (region, year, polymer.sector), kt + + # --------------------------------------------------------------------------- + # Add the type subdim (Fibre / Rubber / Plastics) by splitting on the polymer + # groups. `type` becomes the first subdim so a (time, region, type) object + # multiplies cleanly across polymer/sector. + # --------------------------------------------------------------------------- + fibrePolymers <- c("Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)") + rubberPolymers <- "Rubbers" + plasticsPolymers <- setdiff(getItems(cons, dim = "polymer"), c(fibrePolymers, rubberPolymers)) + + tagType <- function(polys, typeName) { + add_dimension(mselect(absolute, polymer = polys), dim = 3.1, add = "type", nm = typeName) + } + absTyped <- mbind( + tagType(plasticsPolymers, "Plastics"), + tagType(fibrePolymers, "Fibre"), + tagType(rubberPolymers, "Rubber") + ) + + # --------------------------------------------------------------------------- + # Normalize within type. Each polymer's sector shares sum to 1, so the per-type + # total equals that type's summed polymer consumption. + # --------------------------------------------------------------------------- + typeTotal <- dimSums(absTyped, dim = c("polymer", "sector")) # (region, year, type) + x <- absTyped / typeTotal # broadcasts typeTotal over polymer.sector via the type subdim + x[is.na(x)] <- 0 # 0/0 for types with no consumption -> 0 + + return(list( + x = x, + weight = typeTotal, + unit = "share", + description = paste( + "Share of each polymer and end-use sector within total Fibre/Rubber/Plastics", + "apparent consumption per region, from Gao & Cabrera-Serrenho (2025) polymer", + "consumption times the polymer-specific sector distribution. Sums to 1 over", + "(polymer, sector) within each (region, year, type). Multiply by a", + "(time, region, type) total to obtain absolute values (done in remind-mfa)." + ), + note = paste( + "dimensions: (Time, Region, Type, Polymer, Sector); shares sum to 1 within", + "each (Time, Region, Type). Years 2020-2021 rely on incomplete Gao trade data." + ), + min = 0, + max = 1 + )) +} diff --git a/man/calcPlSectorPolymerSplit.Rd b/man/calcPlSectorPolymerSplit.Rd new file mode 100644 index 00000000..2c32c39c --- /dev/null +++ b/man/calcPlSectorPolymerSplit.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcPlSectorPolymerSplit.R +\name{calcPlSectorPolymerSplit} +\alias{calcPlSectorPolymerSplit} +\title{Calculate polymer and sector split shares within each plastics type} +\usage{ +calcPlSectorPolymerSplit() +} +\value{ +A list in \code{\link[madrat]{calcOutput}} format with the polymer and + sector split shares by country, year, type, polymer and sector (1978-2021). + The weight is the per-type total consumption. Years 2020-2021 rely on + incomplete Gao trade data. +} +\description{ +Split total Fibre, Rubber and Plastics consumption into individual polymers +and end-use sectors. Combines the apparent polymer consumption of Gao & +Cabrera-Serrenho (2025) (\code{readSource("GaoCabrera2025", "consumption")}) +with their polymer-specific end-use sector distribution +(\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every +country and year, the consumption of each polymer in each of the 8 end-use +sectors. These are normalized within each type (\code{Fibre}, \code{Rubber}, +\code{Plastics}) so that the shares over \code{(polymer, sector)} sum to 1. + +Multiplying the result with a \code{(time, region, type)} total - e.g. the +output of \code{\link{calcPlProduction}} - yields absolute values per +\code{(time, region, type, polymer, sector)}. That multiplication happens in +remind-mfa, not here. The three fibre polymers form type \code{Fibre}, +\code{Rubbers} forms type \code{Rubber}, and the remaining polymers form type +\code{Plastics}, matching the \code{type} dimension of +\code{\link{calcPlProduction}}. +} +\examples{ +\dontrun{ +a <- calcOutput("PlSectorPolymerSplit") +} +} +\seealso{ +\code{\link{readGaoCabrera2025}}, \code{\link{calcPlProduction}} +} +\author{ +Leonie Schweiger +} From 5fd9a0335ab6fd5ac7969d8331cd4f39ebf1b441 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 24 Jul 2026 11:16:57 +0200 Subject: [PATCH 13/40] read in fibre data for more historical years --- R/calcPlProduction.R | 7 ------- R/calcPlSyntheticFibre.R | 23 ++++++++++++++++++----- R/readTextileExchange.R | 3 +-- 3 files changed, 19 insertions(+), 14 deletions(-) diff --git a/R/calcPlProduction.R b/R/calcPlProduction.R index 8c1be2e6..776d6cc1 100644 --- a/R/calcPlProduction.R +++ b/R/calcPlProduction.R @@ -42,13 +42,6 @@ calcPlProduction <- function() { rubber <- prep(calcOutput("PlSyntheticRubber", aggregate = FALSE), "Rubber") plastics <- prep(calcOutput("PlPlasticsEurope", aggregate = FALSE), "Plastics") - # --------------------------------------------------------------------------- - # Fibre only starts in 2020, one year after the OECD reference ends (2019). - # Assume fibre 2019 = fibre 2020 so it overlaps the OECD reference. - # --------------------------------------------------------------------------- - fibreFirstYear <- min(getYears(fibre, as.integer = TRUE)) - fibre <- mbind(setYears(fibre[, fibreFirstYear, ], "y2019"), fibre) - # --------------------------------------------------------------------------- # Build the two backcasting references (total plastics trend) # --------------------------------------------------------------------------- diff --git a/R/calcPlSyntheticFibre.R b/R/calcPlSyntheticFibre.R index 497bea59..9fb0388c 100644 --- a/R/calcPlSyntheticFibre.R +++ b/R/calcPlSyntheticFibre.R @@ -14,14 +14,27 @@ #' \dontrun{ #' a <- calcOutput("PlSyntheticFibre") #' } -#' @importFrom magclass dimSums collapseDim setYears getItems getYears new.magpie +#' @importFrom magclass dimSums collapseDim setYears getItems getYears new.magpie magpiesort #' @export calcPlSyntheticFibre <- function() { - # global synthetic fibre production per year (sum over the three fibre types) - total <- dimSums( - readSource("TextileExchange", subtype = "timeseries_by_type", convert = FALSE), - dim = 3 + + # read source and interpolate missing years + data <- readSource("TextileExchange", subtype = "timeseries_by_type", convert = FALSE) %>% magpiesort() + + data_years <- getYears(data, as.integer=TRUE) + interpolated <- toolInterpolate( + data, + years = seq(data_years[1], data_years[length(data_years)], 1), + type = "linear" ) + # backcast missing years by oecd (first historic years differ between fibre types) + oecdTotal <- dimSums(readSource("OECD_Plastic", subtype = "Use_1990-2019_region"), dim = 1) + getItems(oecdTotal, dim=3) <- NULL + getRegions(oecdTotal) <- "GLO" + extrapolated <- toolBackcastByReference(interpolated, oecdTotal) + + # global synthetic fibre production per year (sum over the three fibre types) + total <- dimSums(extrapolated, dim = 3) # country-level production shares (fraction); single fibre (Polyester proxy) and # single year (2024), applied as a static distribution key across all years diff --git a/R/readTextileExchange.R b/R/readTextileExchange.R index 9869905d..e02cf207 100644 --- a/R/readTextileExchange.R +++ b/R/readTextileExchange.R @@ -28,7 +28,7 @@ readTextileExchange <- function(subtype) { # --------------------------------------------------------------------------- # Map subtype to Excel sheet and cell range params <- switch(subtype, - "timeseries_by_type" = list(sheet = "timeseries_by_type", range = "A1:C16"), + "timeseries_by_type" = list(sheet = "timeseries_by_type", range = "A1:C41"), "region_share" = list(sheet = "region_share", range = "A1:D6"), stop("Invalid subtype: ", subtype) ) @@ -52,7 +52,6 @@ readTextileExchange <- function(subtype) { stop("Unsupported subtype: ", subtype) ) - magpie_data[is.na(magpie_data)] <- 0 getComment(magpie_data) <- subtype return(magpie_data) From 2962e7b60a176925adaa6fe2353d9f7267e91801 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 24 Jul 2026 12:15:28 +0200 Subject: [PATCH 14/40] improve plastics/fibre split --- R/calcPlProduction.R | 45 +++++++++++++++++++++------------------- R/calcPlSyntheticFibre.R | 7 ++++--- R/readTextileExchange.R | 6 +++--- 3 files changed, 31 insertions(+), 27 deletions(-) diff --git a/R/calcPlProduction.R b/R/calcPlProduction.R index 776d6cc1..39dc9e23 100644 --- a/R/calcPlProduction.R +++ b/R/calcPlProduction.R @@ -31,16 +31,11 @@ #' @export calcPlProduction <- function() { # --------------------------------------------------------------------------- - # Read the three country-level production series and tag each with a type name + # Read the three country-level production series # --------------------------------------------------------------------------- - prep <- function(m, typeName) { - m <- collapseDim(m) - getNames(m) <- typeName - m - } - fibre <- prep(calcOutput("PlSyntheticFibre", aggregate = FALSE), "Fibre") - rubber <- prep(calcOutput("PlSyntheticRubber", aggregate = FALSE), "Rubber") - plastics <- prep(calcOutput("PlPlasticsEurope", aggregate = FALSE), "Plastics") + fibre <- calcOutput("PlSyntheticFibre", aggregate = FALSE) + rubber <- calcOutput("PlSyntheticRubber", aggregate = FALSE) + plastics <- calcOutput("PlPlasticsEurope", aggregate = FALSE) # --------------------------------------------------------------------------- # Build the two backcasting references (total plastics trend) @@ -51,26 +46,35 @@ calcPlProduction <- function() { geyer <- readSource("Geyer", subtype = "Prod_1950-2015", convert = FALSE) # --------------------------------------------------------------------------- - # Backcast each source independently: OECD (-> 1990) then Geyer (-> 1950) + # Backcast each source independently: OECD (-> 1990) then Geyer (-> 1950) and + # trim to the last year covered by all types (sources may end in different years) # --------------------------------------------------------------------------- - backcast <- function(s) { - s <- toolBackcastByReference(s, oecdTotal) - s <- toolBackcastByReference(s, geyer) - magpiesort(s) + lastYear <- min(max(getYears(fibre)), max(getYears(rubber)), max(getYears(plastics))) + backcast <- function(x) { + x <- toolBackcastByReference(x, oecdTotal) + x <- toolBackcastByReference(x, geyer) + magpiesort(x) + x <- x[,getYears(x) Date: Fri, 24 Jul 2026 14:19:09 +0200 Subject: [PATCH 15/40] Gao & Cabrera: map LLDPE and LDPE to LDPE --- R/calcPlGaoCabrera2025.R | 53 ++++++++++++++++++++++++++++++++++++ R/calcPlSectorPolymerSplit.R | 22 +++------------ R/readGaoCabrera2025.R | 6 ++-- man/calcPlGaoCabrera2025.Rd | 32 ++++++++++++++++++++++ 4 files changed, 92 insertions(+), 21 deletions(-) create mode 100644 R/calcPlGaoCabrera2025.R create mode 100644 man/calcPlGaoCabrera2025.Rd diff --git a/R/calcPlGaoCabrera2025.R b/R/calcPlGaoCabrera2025.R new file mode 100644 index 00000000..51393a95 --- /dev/null +++ b/R/calcPlGaoCabrera2025.R @@ -0,0 +1,53 @@ +#' Calculate absolute consumption per polymer and sector from Gao & Cabrera-Serrenho (2025) +#' +#' @description +#' Combines the apparent polymer consumption of Gao & Cabrera-Serrenho (2025) +#' (\code{readSource("GaoCabrera2025", "consumption")}) +#' with their polymer-specific end-use sector distribution +#' (\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every +#' country and year, the consumption of each polymer in each of the 8 end-use +#' sectors. +#' +#' @return A list in \code{\link[madrat]{calcOutput}} format with the absolute +#' consumption by country, year, type, polymer and sector (1978-2021). +#' Years 2020-2021 rely on incomplete Gao trade data. +#' @author Leonie Schweiger +#' @seealso \code{\link{readGaoCabrera2025}}, \code{\link{calcPlProduction}} +#' @examples +#' \dontrun{ +#' a <- calcOutput("PlGaoCabrera2025") +#' } +#' @importFrom magclass collapseDim +#' @export +calcPlGaoCabrera2025 <- function() { + # --------------------------------------------------------------------------- + # Inputs: apparent polymer consumption (ISO3 x year x polymer, kt) and the + # polymer-specific end-use sector distribution (sector x polymer, unitless). + # --------------------------------------------------------------------------- + cons <- readSource("GaoCabrera2025", subtype = "consumption") + # sector_shares carries both sector and polymer as name subdims (sector.polymer) + # with only dummy spatial/temporal dims; collapse those so it broadcasts cleanly. + shares <- collapseDim(readSource("GaoCabrera2025", subtype = "sector_shares", convert = FALSE)) + + # --------------------------------------------------------------------------- + # Outer product cons x shares -> absolute consumption per polymer and sector. + # `cons` has name dim polymer; `shares` has name dims sector.polymer. The + # product matches on the shared polymer subdim and broadcasts cons over sector + # (and the single shares value over region/year). + # --------------------------------------------------------------------------- + absolute <- cons * shares / 1000 # (region, year, polymer.sector), kt -> Mt + + # Merge LLDPE into LDPE (report both polyethylenes together as LDPE) + polyMap <- data.frame(from = getItems(absolute, dim = "polymer")) + polyMap$to <- ifelse(polyMap$from == "LLDPE", "LDPE", polyMap$from) + absolute <- toolAggregate(absolute, rel = polyMap, dim = 3.1, from = "from", to = "to") + + return(list( + x = absolute, + weight = NULL, + unit = "Mt", + description = paste( + "Apparent consumption per polymer and end-use sector, from Gao & Cabrera-Serrenho (2025)." + ) + )) +} diff --git a/R/calcPlSectorPolymerSplit.R b/R/calcPlSectorPolymerSplit.R index 67ebdfd4..9e3d4a73 100644 --- a/R/calcPlSectorPolymerSplit.R +++ b/R/calcPlSectorPolymerSplit.R @@ -32,22 +32,8 @@ #' @importFrom magclass getSets getSets<- #' @export calcPlSectorPolymerSplit <- function() { - # --------------------------------------------------------------------------- - # Inputs: apparent polymer consumption (ISO3 x year x polymer, kt) and the - # polymer-specific end-use sector distribution (sector x polymer, unitless). - # --------------------------------------------------------------------------- - cons <- readSource("GaoCabrera2025", subtype = "consumption") - # sector_shares carries both sector and polymer as name subdims (sector.polymer) - # with only dummy spatial/temporal dims; collapse those so it broadcasts cleanly. - shares <- collapseDim(readSource("GaoCabrera2025", subtype = "sector_shares", convert = FALSE)) - - # --------------------------------------------------------------------------- - # Outer product cons x shares -> absolute consumption per polymer and sector. - # `cons` has name dim polymer; `shares` has name dims sector.polymer. The - # product matches on the shared polymer subdim and broadcasts cons over sector - # (and the single shares value over region/year). - # --------------------------------------------------------------------------- - absolute <- cons * shares # (region, year, polymer.sector), kt + + data <- calcOutput("PlGaoCabrera2025", aggregate=FALSE) # --------------------------------------------------------------------------- # Add the type subdim (Fibre / Rubber / Plastics) by splitting on the polymer @@ -56,10 +42,10 @@ calcPlSectorPolymerSplit <- function() { # --------------------------------------------------------------------------- fibrePolymers <- c("Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)") rubberPolymers <- "Rubbers" - plasticsPolymers <- setdiff(getItems(cons, dim = "polymer"), c(fibrePolymers, rubberPolymers)) + plasticsPolymers <- setdiff(getItems(data, dim = "polymer"), c(fibrePolymers, rubberPolymers)) tagType <- function(polys, typeName) { - add_dimension(mselect(absolute, polymer = polys), dim = 3.1, add = "type", nm = typeName) + add_dimension(mselect(data, polymer = polys), dim = 3.1, add = "type", nm = typeName) } absTyped <- mbind( tagType(plasticsPolymers, "Plastics"), diff --git a/R/readGaoCabrera2025.R b/R/readGaoCabrera2025.R index 664790cf..fbef502e 100644 --- a/R/readGaoCabrera2025.R +++ b/R/readGaoCabrera2025.R @@ -85,9 +85,9 @@ readGaoCabrera2025 <- function(subtype = "consumption") { # End-use sector distribution from distributionsV3.mat -> magpie (sector, polymer). # Sector row order of each 8x1 vector. sectorLabels <- c( - "packaging", "transportation", "building and construction", - "electrical and electronic", "consumer and institutional", - "industrial machinery", "textile", "other" + "Packaging", "Transportation", "Buildings & Construction", + "Electrical/Electronics", "Consumer & Institutional", + "Industrial Machinery", "Textile sector", "Others" ) # Map each of the 14 D.mat polymer groups to the source variable in the .mat diff --git a/man/calcPlGaoCabrera2025.Rd b/man/calcPlGaoCabrera2025.Rd new file mode 100644 index 00000000..76f0bdbc --- /dev/null +++ b/man/calcPlGaoCabrera2025.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcPlGaoCabrera2025.R +\name{calcPlGaoCabrera2025} +\alias{calcPlGaoCabrera2025} +\title{Calculate absolute consumption per polymer and sector from Gao & Cabrera-Serrenho (2025)} +\usage{ +calcPlGaoCabrera2025() +} +\value{ +A list in \code{\link[madrat]{calcOutput}} format with the absolute + consumption by country, year, type, polymer and sector (1978-2021). + Years 2020-2021 rely on incomplete Gao trade data. +} +\description{ +Combines the apparent polymer consumption of Gao & Cabrera-Serrenho (2025) +(\code{readSource("GaoCabrera2025", "consumption")}) +with their polymer-specific end-use sector distribution +(\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every +country and year, the consumption of each polymer in each of the 8 end-use +sectors. +} +\examples{ +\dontrun{ +a <- calcOutput("PlGaoCabrera2025") +} +} +\seealso{ +\code{\link{readGaoCabrera2025}}, \code{\link{calcPlProduction}} +} +\author{ +Leonie Schweiger +} From 8f46c63ac1ae082eba2182e9a453ffd5ca426719 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 24 Jul 2026 16:02:50 +0200 Subject: [PATCH 16/40] split PlSectorPolymerSplit into two functions, the first calculating absolute consumption per sector and polymer, the second the splits --- R/calcPlGaoCabrera2025.R | 20 +++++++++++++++++++- R/calcPlSectorPolymerSplit.R | 33 +++++---------------------------- 2 files changed, 24 insertions(+), 29 deletions(-) diff --git a/R/calcPlGaoCabrera2025.R b/R/calcPlGaoCabrera2025.R index 51393a95..803cb218 100644 --- a/R/calcPlGaoCabrera2025.R +++ b/R/calcPlGaoCabrera2025.R @@ -42,8 +42,26 @@ calcPlGaoCabrera2025 <- function() { polyMap$to <- ifelse(polyMap$from == "LLDPE", "LDPE", polyMap$from) absolute <- toolAggregate(absolute, rel = polyMap, dim = 3.1, from = "from", to = "to") + # --------------------------------------------------------------------------- + # Add the type subdim (Fibre / Rubber / Plastics) by splitting on the polymer + # groups. `type` becomes the first subdim so a (time, region, type) object + # multiplies cleanly across polymer/sector. + # --------------------------------------------------------------------------- + fibrePolymers <- c("Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)") + rubberPolymers <- "Rubbers" + plasticsPolymers <- setdiff(getItems(absolute, dim = "polymer"), c(fibrePolymers, rubberPolymers)) + + tagType <- function(polys, typeName) { + add_dimension(mselect(absolute, polymer = polys), dim = 3.1, add = "type", nm = typeName) + } + absTyped <- mbind( + tagType(plasticsPolymers, "Plastics"), + tagType(fibrePolymers, "Fibre"), + tagType(rubberPolymers, "Rubber") + ) + return(list( - x = absolute, + x = absTyped, weight = NULL, unit = "Mt", description = paste( diff --git a/R/calcPlSectorPolymerSplit.R b/R/calcPlSectorPolymerSplit.R index 9e3d4a73..1e98ff22 100644 --- a/R/calcPlSectorPolymerSplit.R +++ b/R/calcPlSectorPolymerSplit.R @@ -2,12 +2,8 @@ #' #' @description #' Split total Fibre, Rubber and Plastics consumption into individual polymers -#' and end-use sectors. Combines the apparent polymer consumption of Gao & -#' Cabrera-Serrenho (2025) (\code{readSource("GaoCabrera2025", "consumption")}) -#' with their polymer-specific end-use sector distribution -#' (\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every -#' country and year, the consumption of each polymer in each of the 8 end-use -#' sectors. These are normalized within each type (\code{Fibre}, \code{Rubber}, +#' and end-use sectors. Consumption of each polymer in each of the 8 end-use +#' sectors is normalized within each type (\code{Fibre}, \code{Rubber}, #' \code{Plastics}) so that the shares over \code{(polymer, sector)} sum to 1. #' #' Multiplying the result with a \code{(time, region, type)} total - e.g. the @@ -28,37 +24,18 @@ #' \dontrun{ #' a <- calcOutput("PlSectorPolymerSplit") #' } -#' @importFrom magclass getItems collapseDim add_dimension mselect mbind dimSums -#' @importFrom magclass getSets getSets<- +#' @importFrom magclass dimSums #' @export calcPlSectorPolymerSplit <- function() { data <- calcOutput("PlGaoCabrera2025", aggregate=FALSE) - # --------------------------------------------------------------------------- - # Add the type subdim (Fibre / Rubber / Plastics) by splitting on the polymer - # groups. `type` becomes the first subdim so a (time, region, type) object - # multiplies cleanly across polymer/sector. - # --------------------------------------------------------------------------- - fibrePolymers <- c("Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)") - rubberPolymers <- "Rubbers" - plasticsPolymers <- setdiff(getItems(data, dim = "polymer"), c(fibrePolymers, rubberPolymers)) - - tagType <- function(polys, typeName) { - add_dimension(mselect(data, polymer = polys), dim = 3.1, add = "type", nm = typeName) - } - absTyped <- mbind( - tagType(plasticsPolymers, "Plastics"), - tagType(fibrePolymers, "Fibre"), - tagType(rubberPolymers, "Rubber") - ) - # --------------------------------------------------------------------------- # Normalize within type. Each polymer's sector shares sum to 1, so the per-type # total equals that type's summed polymer consumption. # --------------------------------------------------------------------------- - typeTotal <- dimSums(absTyped, dim = c("polymer", "sector")) # (region, year, type) - x <- absTyped / typeTotal # broadcasts typeTotal over polymer.sector via the type subdim + typeTotal <- dimSums(data, dim = c("polymer", "sector")) # (region, year, type) + x <- data / typeTotal # broadcasts typeTotal over polymer.sector via the type subdim x[is.na(x)] <- 0 # 0/0 for types with no consumption -> 0 return(list( From c259cb016cd8eb1762bc563c6c8e99e772b565f1 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 24 Jul 2026 16:03:30 +0200 Subject: [PATCH 17/40] update lifetime sector mapping --- R/calcPlLifetime.R | 2 -- inst/extdata/sectoral/structuremappingPlasticGeyerLifetime.csv | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/R/calcPlLifetime.R b/R/calcPlLifetime.R index 466835f6..52ee9782 100644 --- a/R/calcPlLifetime.R +++ b/R/calcPlLifetime.R @@ -14,8 +14,6 @@ calcPlLifetime <- function(subtype) { rel = sector_map, dim = 3, from = "Source", to = "Target" ) - # remove category "Industrial Machinery" - data <- data[, , getItems(data, 3) != "Industrial Machinery"] description <- paste( subtype, " of plastic goods by use sector. ", diff --git a/inst/extdata/sectoral/structuremappingPlasticGeyerLifetime.csv b/inst/extdata/sectoral/structuremappingPlasticGeyerLifetime.csv index afd70e21..5051a583 100644 --- a/inst/extdata/sectoral/structuremappingPlasticGeyerLifetime.csv +++ b/inst/extdata/sectoral/structuremappingPlasticGeyerLifetime.csv @@ -3,7 +3,7 @@ Packaging,Packaging Transportation,Transportation Building and Construction,Buildings & Construction Electrical/ Electronic,Electrical/Electronics -Consumer & Institutional Products,Household & Leisure & Sports +Consumer & Institutional Products,Consumer & Institutional Industrial Machinery,Industrial Machinery Other,Others Textiles,Textile sector From a6cfe47a0dcffcdc64c8ca9300b9ebfbd30a3244 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 24 Jul 2026 16:04:38 +0200 Subject: [PATCH 18/40] reduce obsolete dimensions in MechLoss and MechReYield --- R/calcPlMechLoss.R | 26 +++++--------------------- R/calcPlMechReYield.R | 25 +++++-------------------- 2 files changed, 10 insertions(+), 41 deletions(-) diff --git a/R/calcPlMechLoss.R b/R/calcPlMechLoss.R index 247d5168..7961215f 100644 --- a/R/calcPlMechLoss.R +++ b/R/calcPlMechLoss.R @@ -1,27 +1,10 @@ -#' Calculate Country-Level Mechanical Recycling Loss Trajectories -#' -#' Generate time series of mechanical recycling loss trajectories by sector and region, -#' then aggregate to countries for 1950-2100. +#' Set Country-Level Mechanical Recycling Loss #' #' @author Qianzhi Zhang #' calcPlMechLoss <- function() { - sector_map <- toolGetMapping( - "structuremappingPlasticManu.csv", - type = "sectoral", where = "mrmfa" - ) - - targets <- setdiff(unique(sector_map$Target), "Total") - - x <- new.magpie( - cells_and_regions = madrat::getISOlist(), - years = 1950:2100, - names = targets, - fill = 0.05 - ) - weight <- x - weight[, ] <- 1 + x <- new.magpie(fill = 0.05) description <- paste0( "Uncontrolled loss rate of mechanical recycling based on Brown et al. 2023, ", @@ -29,9 +12,10 @@ calcPlMechLoss <- function() { ) return(list( x = x, - weight = weight, + weight = NULL, unit = "% Mechanical Recycling Loss", + isocountries= FALSE, description = description, - note = "dimensions: (Time,Region,Material,value)" + note = "dimensions: (value)" )) } diff --git a/R/calcPlMechReYield.R b/R/calcPlMechReYield.R index 869dc3d4..0e8b8cbb 100644 --- a/R/calcPlMechReYield.R +++ b/R/calcPlMechReYield.R @@ -1,32 +1,17 @@ -#' Calculate Country-Level Mechanical Recycling Yield Trajectories -#' -#' Generate time series of mechanical recycling yield (efficiency) trajectories by sector and region, -#' then aggregate to countries for 1950-2100. +#' Set Country-Level Mechanical Recycling Yield #' #' @author Qianzhi Zhang #' calcPlMechReYield <- function() { - sector_map <- toolGetMapping( - "structuremappingPlasticManu.csv", - type = "sectoral", where = "mrmfa" - ) - targets <- setdiff(unique(sector_map$Target), "Total") - - x <- new.magpie( - cells_and_regions = madrat::getISOlist(), - years = 1950:2100, - names = targets, - fill = 0.79 - ) - weight <- x - weight[, ] <- 1 + x <- new.magpie(fill = 0.79) return(list( x = x, - weight = weight, + weight = NULL, unit = "% Mechanical recycling efficiency", + isocountries= FALSE, description = "Mechanical recycling yield trajectories aggregated to country level for 1950-2100.", - note = "dimensions: (Time,Region,Material,value)" + note = "dimensions: (value)" )) } From 184c93c0a90c7298e589bc30bf962cee2544d492 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 24 Jul 2026 16:08:53 +0200 Subject: [PATCH 19/40] update trade functions to new polymer and sector mapping --- R/calcPlBACI.R | 29 ++++++++----------- R/calcPlTrade.R | 6 ++-- .../sectoral/polymermappingUNEP_NGP.csv | 26 ++++++++++------- .../sectoral/polymermappingUNEP_NGP_waste.csv | 20 ++++++------- .../sectoral/sectormappingUNEP_NGP.csv | 2 +- 5 files changed, 41 insertions(+), 42 deletions(-) diff --git a/R/calcPlBACI.R b/R/calcPlBACI.R index 13dd4f81..7fcd6623 100644 --- a/R/calcPlBACI.R +++ b/R/calcPlBACI.R @@ -69,40 +69,35 @@ calcPlBACI <- function(subtype, category, HS) { } else { polymer_map <- toolGetMapping("polymermappingUNEP_NGP.csv", type = "sectoral", where = "mrmfa") } - # use polymer use by sector as weights (summarize over all Regions, - # as polymer share by sector is constant over all Regions in OECD data); + # use polymer use by sector as weights (summarize over all Regions and Years); # use total polymer use over all sectors as weights for "General" sector - use <- calcOutput("PlOECD", subtype = "Use_2019_region", aggregate = TRUE) %>% as.data.frame() - use_by_sector <- use %>% - rename(sector = "Data2", polymer = "Data1") %>% - filter(.data$polymer != "Total") %>% - group_by(.data$sector, .data$polymer) %>% - summarize(value = sum(.data$Value)) %>% - mutate(sector = case_when(.data$sector == "Total" ~ "General", .default = .data$sector)) - split <- merge(polymer_map, use_by_sector, by.y = "polymer", by.x = "Target") %>% + use_sector <- dimSums(calcOutput("PlGaoCabrera2025", aggregate = TRUE), dim = c("region","year")) + use_total <- dimSums(use_sector, dim = "sector") %>% addDim(dim=3.2, dimName="sector", item="General") + use_by_sector <- mbind(use_sector, use_total) %>% as.data.frame(rev=3) + split <- merge(polymer_map, use_by_sector, by.y = "polymer", by.x = "Target_polymer") %>% group_by(.data$sector, .data$Source) %>% mutate( - total = sum(.data$value, na.rm = TRUE), - weight = .data$value / .data$total + total = sum(.data$.value, na.rm = TRUE), + weight = .data$.value / .data$total ) %>% - select(-"total", -"value") + select(-"total", -".value") df <- left_join(df, split, by = c("polymer" = "Source", "sector")) %>% mutate(value = .data$value * .data$weight) - # some weights are NaN for polymers that are not used in a specific sector according to OECD, + # some weights are NaN for polymers that are not used in a specific sector according to Gao & Cabrera, # throw a warning if these combination appear in the dataset nan <- df %>% filter(is.na(.data$weight)) if (nrow(nan) > 0) { warning(paste( "The following sector-polymer combinations cannot be mapped from the BACI data - as they do not exist in the OECD dataset used for weighting:\n", + as they do not exist in the GaoCabrera dataset used for weighting:\n", paste(utils::capture.output(print(nan)), collapse = "\n") )) } df <- df %>% select(-"polymer", -"weight") %>% - rename("polymer" = "Target") %>% - group_by(.data$t, .data$exporter, .data$importer, .data$polymer, .data$sector) %>% + rename("polymer" = "Target_polymer") %>% + group_by(.data$t, .data$exporter, .data$importer, .data$type, .data$polymer, .data$sector) %>% summarize(value = sum(.data$value)) %>% ungroup() } diff --git a/R/calcPlTrade.R b/R/calcPlTrade.R index 639b9bbe..9355835c 100644 --- a/R/calcPlTrade.R +++ b/R/calcPlTrade.R @@ -89,7 +89,7 @@ calcPlTrade <- function( } # reference used for backcasting - reference <- calcOutput("PlConsumptionByGood", aggregate = FALSE) + reference <- calcOutput("PlProduction", aggregate = FALSE) # --------------------------------------------------------------------------- # Load data @@ -115,11 +115,11 @@ calcPlTrade <- function( } if (data_source == "BACI_UNEP") { - note <- "dimensions: (Historic Time,Region,Material,Good,value)" + note <- "dimensions: (Historic Time,Region,Type,Material,Good,value)" # remove sector column for Primary and Waste category ("General" for all) if (category %in% c("Primary", "Waste")) { x <- collapseNames(x) - note <- "dimensions: (Historic Time,Region,Material,value)" + note <- "dimensions: (Historic Time,Region,Type,Material,value)" } } else if (data_source == "BACI_UNCTAD") { note <- "dimensions: (Historic Time,Region,value)" diff --git a/inst/extdata/sectoral/polymermappingUNEP_NGP.csv b/inst/extdata/sectoral/polymermappingUNEP_NGP.csv index 15a6e085..ff466eee 100644 --- a/inst/extdata/sectoral/polymermappingUNEP_NGP.csv +++ b/inst/extdata/sectoral/polymermappingUNEP_NGP.csv @@ -1,7 +1,10 @@ -Source;Target -Unknown;ABS_ASA_SAN -Unknown;Fibres -Unknown;Elastomers (tyres) +Source;Target_polymer +Unknown;Polyester fibre +Unknown;Polyamide fibre +Unknown;Other fibre (acrylic) +Unknown;Rubbers +Unknown;Other thermoplastics +Unknown;Other thermosets Unknown;HDPE Unknown;PET Unknown;PP @@ -9,16 +12,17 @@ Unknown;PS Unknown;PUR Unknown;LDPE Unknown;PVC -Unknown;Others PP;PP PS;PS PVC;PVC -Other;Others -Other;ABS_ASA_SAN -Other;PUR -Synthetic Rubber;Elastomers (tyres) LDPE;LDPE HDPE;HDPE PET;PET -Polyester;Others -Fibres;Fibres +Synthetic Rubber;Rubbers +Polyester;Other thermosets +Other;Other thermosets +Other;Other thermoplastics +Other;PUR +Fibres;Polyester fibre +Fibres;Polyamide fibre +Fibres;Other fibre (acrylic) \ No newline at end of file diff --git a/inst/extdata/sectoral/polymermappingUNEP_NGP_waste.csv b/inst/extdata/sectoral/polymermappingUNEP_NGP_waste.csv index a9d3511f..99a9f8e9 100644 --- a/inst/extdata/sectoral/polymermappingUNEP_NGP_waste.csv +++ b/inst/extdata/sectoral/polymermappingUNEP_NGP_waste.csv @@ -1,10 +1,10 @@ -Source;Target;Sector -Other;PET; -Other;PP; -Other;PUR; -Other;Others; -PS;ABS_ASA_SAN; -PS;PS; -PVC;PVC; -LDPE;LDPE; -LDPE;HDPE; +Source;Target_polymer +Other;PET +Other;PP +Other;PUR +Other;Other thermoplastics +Other;Other thermosets +PS;PS +PVC;PVC +LDPE;LDPE +LDPE;HDPE diff --git a/inst/extdata/sectoral/sectormappingUNEP_NGP.csv b/inst/extdata/sectoral/sectormappingUNEP_NGP.csv index b671d69e..5ab34c3a 100644 --- a/inst/extdata/sectoral/sectormappingUNEP_NGP.csv +++ b/inst/extdata/sectoral/sectormappingUNEP_NGP.csv @@ -2,7 +2,7 @@ Source;Target Automotive-tyres;Transportation Automotive-other;Transportation Textile;Textile sector -Houshold, Leisure, Sport;Household & Leisure & Sports +Houshold, Leisure, Sport;Consumer & Institutional Electronics;Electrical/Electronics Construction;Buildings & Construction Packaging;Packaging From 96abb584fa121968c7dcd97785efb9fb5559d6f7 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Fri, 24 Jul 2026 16:39:08 +0200 Subject: [PATCH 20/40] update .Rd files --- NAMESPACE | 2 +- man/calcPlMechLoss.Rd | 5 ++--- man/calcPlMechReYield.Rd | 5 ++--- man/calcPlSectorPolymerSplit.Rd | 8 ++------ 4 files changed, 7 insertions(+), 13 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 15024d10..736ba305 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand export(MplotMulti) +export(calcPlGaoCabrera2025) export(calcPlProduction) export(calcPlSectorPolymerSplit) export(calcPlSyntheticFibre) @@ -40,7 +41,6 @@ importFrom(magclass,dimSums) importFrom(magclass,getComment) importFrom(magclass,getItems) importFrom(magclass,getNames) -importFrom(magclass,getSets) importFrom(magclass,getYears) importFrom(magclass,magpiesort) importFrom(magclass,mbind) diff --git a/man/calcPlMechLoss.Rd b/man/calcPlMechLoss.Rd index 3fb29f73..bd3f0b3f 100644 --- a/man/calcPlMechLoss.Rd +++ b/man/calcPlMechLoss.Rd @@ -2,13 +2,12 @@ % Please edit documentation in R/calcPlMechLoss.R \name{calcPlMechLoss} \alias{calcPlMechLoss} -\title{Calculate Country-Level Mechanical Recycling Loss Trajectories} +\title{Set Country-Level Mechanical Recycling Loss} \usage{ calcPlMechLoss() } \description{ -Generate time series of mechanical recycling loss trajectories by sector and region, -then aggregate to countries for 1950-2100. +Set Country-Level Mechanical Recycling Loss } \author{ Qianzhi Zhang diff --git a/man/calcPlMechReYield.Rd b/man/calcPlMechReYield.Rd index 1e279935..5e00d501 100644 --- a/man/calcPlMechReYield.Rd +++ b/man/calcPlMechReYield.Rd @@ -2,13 +2,12 @@ % Please edit documentation in R/calcPlMechReYield.R \name{calcPlMechReYield} \alias{calcPlMechReYield} -\title{Calculate Country-Level Mechanical Recycling Yield Trajectories} +\title{Set Country-Level Mechanical Recycling Yield} \usage{ calcPlMechReYield() } \description{ -Generate time series of mechanical recycling yield (efficiency) trajectories by sector and region, -then aggregate to countries for 1950-2100. +Set Country-Level Mechanical Recycling Yield } \author{ Qianzhi Zhang diff --git a/man/calcPlSectorPolymerSplit.Rd b/man/calcPlSectorPolymerSplit.Rd index 2c32c39c..c67e17f6 100644 --- a/man/calcPlSectorPolymerSplit.Rd +++ b/man/calcPlSectorPolymerSplit.Rd @@ -14,12 +14,8 @@ A list in \code{\link[madrat]{calcOutput}} format with the polymer and } \description{ Split total Fibre, Rubber and Plastics consumption into individual polymers -and end-use sectors. Combines the apparent polymer consumption of Gao & -Cabrera-Serrenho (2025) (\code{readSource("GaoCabrera2025", "consumption")}) -with their polymer-specific end-use sector distribution -(\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every -country and year, the consumption of each polymer in each of the 8 end-use -sectors. These are normalized within each type (\code{Fibre}, \code{Rubber}, +and end-use sectors. Consumption of each polymer in each of the 8 end-use +sectors is normalized within each type (\code{Fibre}, \code{Rubber}, \code{Plastics}) so that the shares over \code{(polymer, sector)} sum to 1. Multiplying the result with a \code{(time, region, type)} total - e.g. the From 8bc1ee776f116c9d755c22457253212cfd5da9c3 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Mon, 27 Jul 2026 10:48:08 +0200 Subject: [PATCH 21/40] backcast GaoCabrera --- R/calcPlGaoCabrera2025.R | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/R/calcPlGaoCabrera2025.R b/R/calcPlGaoCabrera2025.R index 803cb218..43b73acd 100644 --- a/R/calcPlGaoCabrera2025.R +++ b/R/calcPlGaoCabrera2025.R @@ -42,17 +42,22 @@ calcPlGaoCabrera2025 <- function() { polyMap$to <- ifelse(polyMap$from == "LLDPE", "LDPE", polyMap$from) absolute <- toolAggregate(absolute, rel = polyMap, dim = 3.1, from = "from", to = "to") + # --------------------------------------------------------------------------- + # Backcast data to 1950 using Geyer et al. (2023) global polymer consumption data + # --------------------------------------------------------------------------- + geyer <- readSource("Geyer", subtype = "Prod_1950-2015", convert = FALSE) + absoluteBackcasted <- toolBackcastByReference(absolute, geyer) + # --------------------------------------------------------------------------- # Add the type subdim (Fibre / Rubber / Plastics) by splitting on the polymer - # groups. `type` becomes the first subdim so a (time, region, type) object - # multiplies cleanly across polymer/sector. + # groups. # --------------------------------------------------------------------------- fibrePolymers <- c("Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)") rubberPolymers <- "Rubbers" - plasticsPolymers <- setdiff(getItems(absolute, dim = "polymer"), c(fibrePolymers, rubberPolymers)) + plasticsPolymers <- setdiff(getItems(absoluteBackcasted, dim = "polymer"), c(fibrePolymers, rubberPolymers)) tagType <- function(polys, typeName) { - add_dimension(mselect(absolute, polymer = polys), dim = 3.1, add = "type", nm = typeName) + add_dimension(mselect(absoluteBackcasted, polymer = polys), dim = 3.1, add = "type", nm = typeName) } absTyped <- mbind( tagType(plasticsPolymers, "Plastics"), From a5ccda5e0e1fd8dda04a43595730f45f28794743 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Mon, 27 Jul 2026 10:58:06 +0200 Subject: [PATCH 22/40] fix bug --- R/calcPlBACI.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/calcPlBACI.R b/R/calcPlBACI.R index 7fcd6623..a60231b2 100644 --- a/R/calcPlBACI.R +++ b/R/calcPlBACI.R @@ -72,7 +72,7 @@ calcPlBACI <- function(subtype, category, HS) { # use polymer use by sector as weights (summarize over all Regions and Years); # use total polymer use over all sectors as weights for "General" sector use_sector <- dimSums(calcOutput("PlGaoCabrera2025", aggregate = TRUE), dim = c("region","year")) - use_total <- dimSums(use_sector, dim = "sector") %>% addDim(dim=3.2, dimName="sector", item="General") + use_total <- dimSums(use_sector, dim = "sector") %>% addDim(dim=3.3, dimName="sector", item="General") use_by_sector <- mbind(use_sector, use_total) %>% as.data.frame(rev=3) split <- merge(polymer_map, use_by_sector, by.y = "polymer", by.x = "Target_polymer") %>% group_by(.data$sector, .data$Source) %>% From c4ebea3435ca2f39948b31bcdd2b22109910d3c9 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Mon, 27 Jul 2026 11:00:30 +0200 Subject: [PATCH 23/40] add PlProduction to fullMFA --- R/fullMFA.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/fullMFA.R b/R/fullMFA.R index 145f6353..dc02eb57 100644 --- a/R/fullMFA.R +++ b/R/fullMFA.R @@ -161,9 +161,12 @@ fullMFA <- function(rev = 0, # common parameters calcOutput("CoPopulation", file = "pl_population.cs4r", scenarios = driverScenarios, collapse = FALSE, smooth = TRUE, years = start_historic:end_future) calcOutput("CoGDP", file = "pl_gdppc.cs4r", perCapita = gdpPerCapita, scenarios = driverScenarios, collapse = FALSE, smooth = TRUE, years = start_historic:end_future) + # Production + calcOutput("PlProduction", file = "pl_production.cs4r", years = start_historic:end_historic) # Consumption - calcOutput("PlConsumptionByGood", file = "pl_consumption.cs4r") - calcOutput("PlSectorSplit", file = "pl_sector_split.cs4r", aggregate = FALSE) + calcOutput("PlSectorPolymerSplit", file = "pl_sector_polymer_split.cs4r", years = start_historic:end_historic) + #calcOutput("PlConsumptionByGood", file = "pl_consumption.cs4r") + #calcOutput("PlSectorSplit", file = "pl_sector_split.cs4r", aggregate = FALSE) # Trade # calcOutput("PlTrade", category = "Final", flow_label = "Exports", data_source = "UNCTAD", file = "pl_final_his_exports.cs4r", years = start_historic:end_historic) # calcOutput("PlTrade", category = "Final", flow_label = "Imports", data_source = "UNCTAD", file = "pl_final_his_imports.cs4r", years = start_historic:end_historic) @@ -186,8 +189,8 @@ fullMFA <- function(rev = 0, calcOutput("PlHVCinput", subtype = "HVC_input_ratio", aggregate = FALSE, file = "pl_HVC_input_ratio.cs4r") calcOutput("PlHVCinput", subtype = "C4_input_ratio", aggregate = FALSE, file = "pl_C4_input_ratio.cs4r") calcOutput("PlOECD_MGshare", file = "pl_material_shares_in_goods.cs4r") - calcOutput("PlMechReYield", round = 2, file = "pl_mechanical_recycling_yield.cs4r", years = start_historic:end_future) # fix 0.79 - calcOutput("PlMechLoss", file = "pl_reclmech_loss_uncontrolled_rate.cs4r", years = start_historic:end_future) # fix 0.05 + calcOutput("PlMechReYield", round = 2, file = "pl_mechanical_recycling_yield.cs4r", aggregate = FALSE) # fix 0.79 + calcOutput("PlMechLoss", file = "pl_reclmech_loss_uncontrolled_rate.cs4r", aggregate = FALSE) # fix 0.05 calcOutput("PlLifetime", subtype = "Lifetime_mean", aggregate = FALSE, file = "pl_lifetime_mean.cs4r") calcOutput("PlLifetime", subtype = "Lifetime_std", aggregate = FALSE, file = "pl_lifetime_std.cs4r") calcOutput("PlCarbonContent", aggregate = FALSE, file = "pl_carbon_content_materials.cs4r") From 991b0f76ffa04ed77d63fa9f05b3498fc0c7462c Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Mon, 27 Jul 2026 12:05:52 +0200 Subject: [PATCH 24/40] update Plastics_CarbonContent for new polymer dimensions --- R/readPlastics_CarbonContent.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/readPlastics_CarbonContent.R b/R/readPlastics_CarbonContent.R index 0db7ce08..ab3cbcf1 100644 --- a/R/readPlastics_CarbonContent.R +++ b/R/readPlastics_CarbonContent.R @@ -20,7 +20,7 @@ readPlastics_CarbonContent <- function(subtype) { switchboard <- list( "plastics" = function() { df <- read_excel( - path = file.path("v2.0", "Plastics_CarbonContent.xlsx"), + path = file.path("v3.0", "Plastics_CarbonContent.xlsx"), sheet = "final", range = "A1:B13" ) @@ -29,7 +29,7 @@ readPlastics_CarbonContent <- function(subtype) { }, "HVC" = function() { df <- read_excel( - path = file.path("v2.0", "Plastics_CarbonContent.xlsx"), + path = file.path("v3.0", "Plastics_CarbonContent.xlsx"), sheet = "HVC", range = "A1:B8" ) From ac75eea985d826cd95b3e0819b857cdf0cafb8c3 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Mon, 27 Jul 2026 22:17:37 +0200 Subject: [PATCH 25/40] update HVC input to new polymer dims --- R/calcPlHVCinput.R | 50 ++++++++----------- R/readLeviCullen.R | 6 +-- R/readPlastics_CarbonContent.R | 2 +- .../sectoral/polymermappingLeviCullen.csv | 24 ++++++--- 4 files changed, 43 insertions(+), 39 deletions(-) diff --git a/R/calcPlHVCinput.R b/R/calcPlHVCinput.R index 1d2b4615..678cd126 100644 --- a/R/calcPlHVCinput.R +++ b/R/calcPlHVCinput.R @@ -64,20 +64,8 @@ calcPlHVCinput <- function(subtype) { HVC_input_magclass <- as.magpie(HVC_input) # --------------------------------------------------------------------------- - # map polymers to REMIND-MFA polymers using production weights for ABS&SAN mapping to ABS_ASA_SAN - # --------------------------------------------------------------------------- - polymer_map <- toolGetMapping("polymermappingLeviCullen.csv", type = "sectoral", where = "mrmfa") - production_volumes <- readSource("LeviCullen", subtype = "Production", convert = FALSE) - weights <- mselect(production_volumes, stage = "total production", type = "plastics", to = polymerization$polymer, collapseNames = TRUE) %>% collapseDim() - HVC_input_mapped <- HVC_input_magclass %>% - toolAggregate(rel = polymer_map, dim = 3.1, from = "Source", to = "Target", weight = weights, wdim = 3.1) - polymerization_mapped <- polymerization_magclass %>% - toolAggregate(rel = polymer_map, dim = 3.1, from = "Source", to = "Target", weight = weights, wdim = 3.1) - - # --------------------------------------------------------------------------- - # fill data for Fibres, Bioplastics and Other with assumptions: - # for Fibres, assume same input as for PET, since 85% of global Fibre production is polyester - # for Bioplastics and Other, regress HVC inputs by carbon content and assume typical polymerization yield + # fill data for Other thermosets with assumption: + # regress HVC inputs by carbon content and assume typical polymerization yield # according to Levi and Cullen 2018 (total input = 1.02) # --------------------------------------------------------------------------- @@ -86,27 +74,20 @@ calcPlHVCinput <- function(subtype) { mselect(Element = "C") %>% collapseDim() # keep only C content, result: (polymer) - # --- Fibres: copy HVC input and polymerization yield from PET --- - fibres_HVC <- HVC_input_mapped[, , "PET"] - getItems(fibres_HVC, dim = 3.1) <- "Fibres" - fibres_polym <- polymerization_mapped[, , "PET"] - getItems(fibres_polym, dim = 3.1) <- "Fibres" - - # --- Bioplastics & Others: linear regression of HVC input on carbon content --- # build a dataframe of known polymer carbon contents and their HVC inputs per (element, HVC type) - known_polymers <- getItems(HVC_input_mapped, dim = 3.1) + known_polymers <- getItems(HVC_input_magclass, dim = 3.1) cc_known <- as.data.frame(mselect(carbon_content_pl, Polymer = known_polymers)) %>% select("Data1", "Value") %>% rename(polymer = "Data1", carbon = "Value") - hvc_known <- as.data.frame(HVC_input_mapped) %>% + hvc_known <- as.data.frame(HVC_input_magclass) %>% select(-"Cell", -"Region", -"Year") %>% rename(polymer = "Data1", element = "Data2", hvc_type = "Data3", hvc_input = "Value") reg_data <- merge(hvc_known, cc_known, by = "polymer") - # for each element, fit lm on HVC w/o C4 only and predict; C4 input is assumed zero - missing_polymers <- c("BioPlastics", "Others") + # fit lm on HVC w/o C4 only and predict; C4 input is assumed zero + missing_polymers <- c("Other thermosets") cc_missing <- as.data.frame(mselect(carbon_content_pl, Polymer = missing_polymers)) %>% select("Data1", "Value") %>% rename(polymer = "Data1", carbon = "Value") @@ -130,16 +111,27 @@ calcPlHVCinput <- function(subtype) { missing_HVC <- add_columns(missing_HVC, addnm = "C4", dim = "hvc_type", fill = 0) getItems(missing_HVC, dim = 1) <- NULL - # polymerization yield of 98% for Bioplastics and Others + # polymerization yield of 98% missing_polym <- new.magpie( names = missing_polymers, sets = c("region", "year", "polymer"), fill = 1.02 ) getItems(missing_polym, dim = 1) <- NULL + # --------------------------------------------------------------------------- + # map polymers to REMIND-MFA polymers using production weights + # --------------------------------------------------------------------------- + polymer_map <- toolGetMapping("polymermappingLeviCullen.csv", type = "sectoral", where = "mrmfa") + production_volumes <- readSource("LeviCullen", subtype = "Production", convert = FALSE) + weights <- mselect(production_volumes, stage = "total production", type = "plastics", to = polymerization$polymer, collapseNames = TRUE) %>% collapseDim() + HVC_input_mapped <- HVC_input_magclass %>% + toolAggregate(rel = polymer_map, dim = 3.1, from = "Source", to = "Target", weight = weights, wdim = 3.1) + polymerization_mapped <- polymerization_magclass %>% + toolAggregate(rel = polymer_map, dim = 3.1, from = "Source", to = "Target", weight = weights, wdim = 3.1) + # --- combine all polymers --- - HVC_input_full <- mbind(HVC_input_mapped, fibres_HVC, missing_HVC) - polymerization_full <- mbind(polymerization_mapped, fibres_polym, missing_polym) + HVC_input_full <- mbind(HVC_input_mapped, missing_HVC) + polymerization_full <- mbind(polymerization_mapped, missing_polym) # get HVC input ratio HVC_input_ratio <- HVC_input_full / polymerization_full @@ -164,7 +156,7 @@ calcPlHVCinput <- function(subtype) { subtype, " of plastics by polymer. ", "Data derived from Levi and Cullen 2018 https://doi.org/10.1021/acs.est.7b04573 for available polymers; ", - "for PUR, Fibres, Others and Bioplastics based on assumptions regarding their composition." + "for 'Other thermosets' based on assumptions regarding their composition." ) output <- list( x = x, diff --git a/R/readLeviCullen.R b/R/readLeviCullen.R index d6f2b2b5..f250c12f 100644 --- a/R/readLeviCullen.R +++ b/R/readLeviCullen.R @@ -8,18 +8,18 @@ #' - "Production" flows and total production volumes of chemicals in the plastics production chain from several Tables in SI #' @author Leonie Schweiger readLeviCullen <- function(subtype) { - version <- "v1.0" + version <- "v2.0" switchboard <- list( "Production" = function() { path <- file.path(".", version, "LeviCullen.xlsx") - df <- readxl::read_excel(path = path, sheet = "production", range = "A1:G47") %>% + df <- readxl::read_excel(path = path, sheet = "production", range = "A1:G58") %>% select("stage", "type", "from", "to", "flow (Mt)") x <- as.magpie(df) return(x) }, "HVCbyProcess" = function() { path <- file.path(".", version, "LeviCullen.xlsx") - df <- readxl::read_excel(path = path, sheet = "HVC input by process", range = "A1:D25") + df <- readxl::read_excel(path = path, sheet = "HVC input by process", range = "A1:D51") x <- as.magpie(df) return(x) } diff --git a/R/readPlastics_CarbonContent.R b/R/readPlastics_CarbonContent.R index ab3cbcf1..f87f3aaf 100644 --- a/R/readPlastics_CarbonContent.R +++ b/R/readPlastics_CarbonContent.R @@ -22,7 +22,7 @@ readPlastics_CarbonContent <- function(subtype) { df <- read_excel( path = file.path("v3.0", "Plastics_CarbonContent.xlsx"), sheet = "final", - range = "A1:B13" + range = "A1:B14" ) x <- as.magpie(df) return(x) diff --git a/inst/extdata/sectoral/polymermappingLeviCullen.csv b/inst/extdata/sectoral/polymermappingLeviCullen.csv index 3f0a7b75..98b28f1d 100644 --- a/inst/extdata/sectoral/polymermappingLeviCullen.csv +++ b/inst/extdata/sectoral/polymermappingLeviCullen.csv @@ -1,11 +1,23 @@ Source;Target +HDPE;HDPE +LDPE;LDPE +PET;PET PP;PP PS;PS PVC;PVC -ABS;ABS_ASA_SAN -SAN;ABS_ASA_SAN PUR;PUR -Styrene-butadiene rubber (SBR);Elastomers (tyres) -LDPE;LDPE -HDPE;HDPE -PET;PET +ABS;Other thermoplastics +SAN;Other thermoplastics +EPS;Other thermoplastics +PC;Other thermoplastics +PMMA;Other thermoplastics +Styrene-butadiene rubber (SBR);Rubbers +Nitrile butadiene;Rubbers +Polybutadiene;Rubbers +Polychloroprene;Rubbers +Polyamide 6 fibre;Polyamide fibre +Polyamide 66 fibre;Polyamide fibre +PET fibre;PET fibre +PP fibre;Other fibre +Polyacrylonitrile fibre;Other fibre + From 59052303267ff13af1bb55772762aad3c129e1d0 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 28 Jul 2026 10:31:57 +0200 Subject: [PATCH 26/40] fix polymer names --- R/calcPlGaoCabrera2025.R | 8 +++++--- R/calcPlSyntheticFibre.R | 6 +++--- R/readGaoCabrera2025.R | 4 ++-- man/calcPlGaoCabrera2025.Rd | 2 +- man/calcPlSyntheticFibre.Rd | 6 +++--- 5 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/calcPlGaoCabrera2025.R b/R/calcPlGaoCabrera2025.R index 43b73acd..1d8118df 100644 --- a/R/calcPlGaoCabrera2025.R +++ b/R/calcPlGaoCabrera2025.R @@ -1,7 +1,7 @@ #' Calculate absolute consumption per polymer and sector from Gao & Cabrera-Serrenho (2025) #' #' @description -#' Combines the apparent polymer consumption of Gao & Cabrera-Serrenho (2025) +#' Combines the apparent polymer consumption of Gao & Cabrera-Serrenho (2025) #' (\code{readSource("GaoCabrera2025", "consumption")}) #' with their polymer-specific end-use sector distribution #' (\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every @@ -41,6 +41,8 @@ calcPlGaoCabrera2025 <- function() { polyMap <- data.frame(from = getItems(absolute, dim = "polymer")) polyMap$to <- ifelse(polyMap$from == "LLDPE", "LDPE", polyMap$from) absolute <- toolAggregate(absolute, rel = polyMap, dim = 3.1, from = "from", to = "to") + # TODO Other fibre category only includes acrylic fibres; however, for remind-mfa, + # this includes also PP fibre and Elastane (PU fibre) which need to be subtracted from PP and PUR # --------------------------------------------------------------------------- # Backcast data to 1950 using Geyer et al. (2023) global polymer consumption data @@ -50,9 +52,9 @@ calcPlGaoCabrera2025 <- function() { # --------------------------------------------------------------------------- # Add the type subdim (Fibre / Rubber / Plastics) by splitting on the polymer - # groups. + # groups. # --------------------------------------------------------------------------- - fibrePolymers <- c("Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)") + fibrePolymers <- c("PET fibre", "Polyamide fibre", "Other fibre") rubberPolymers <- "Rubbers" plasticsPolymers <- setdiff(getItems(absoluteBackcasted, dim = "polymer"), c(fibrePolymers, rubberPolymers)) diff --git a/R/calcPlSyntheticFibre.R b/R/calcPlSyntheticFibre.R index 3e28b86d..492a3ce0 100644 --- a/R/calcPlSyntheticFibre.R +++ b/R/calcPlSyntheticFibre.R @@ -1,9 +1,9 @@ #' Calculate synthetic fibre production by country #' #' Combines the global synthetic fibre production time series (Polyester, -#' Polyamide (nylon) and Acrylic) from Textile Exchange with the estimated -#' country-level production shares based on Credence Research market data -#' on monoethylene glycol (MEG) to yield a total synthetic +#' Polyamide (nylon), Acrylic, Polypropylene and Elastane) from Textile Exchange +#' with the estimated country-level production shares based on Credence Research +#' market data on monoethylene glycol (MEG) to yield a total synthetic #' fibre production by country and year. #' #' @return A list in \code{\link[madrat]{calcOutput}} format with total synthetic diff --git a/R/readGaoCabrera2025.R b/R/readGaoCabrera2025.R index fbef502e..d0c30056 100644 --- a/R/readGaoCabrera2025.R +++ b/R/readGaoCabrera2025.R @@ -96,8 +96,8 @@ readGaoCabrera2025 <- function(subtype = "consumption") { polymerToVar <- c( "LDPE" = "LDPEdist", "LLDPE" = "LLDPEdist", "HDPE" = "HDPEdist", "PP" = "PPdist", "PS" = "PSdist", "PVC" = "PVCdist", "PET" = "PETdist", - "PUR" = "PURdist", "Polyester fibre" = "PPAdist", - "Polyamide fibre" = "PPAdist", "Other fibre (acrylic)" = "PPAdist", + "PUR" = "PURdist", "PET fibre" = "PPAdist", + "Polyamide fibre" = "PPAdist", "Other fibre" = "PPAdist", "Rubbers" = "Rubberdist", "Other thermoplastics" = "Otherdist", "Other thermosets" = "Epoxydist" ) diff --git a/man/calcPlGaoCabrera2025.Rd b/man/calcPlGaoCabrera2025.Rd index 76f0bdbc..f8938f55 100644 --- a/man/calcPlGaoCabrera2025.Rd +++ b/man/calcPlGaoCabrera2025.Rd @@ -12,7 +12,7 @@ A list in \code{\link[madrat]{calcOutput}} format with the absolute Years 2020-2021 rely on incomplete Gao trade data. } \description{ -Combines the apparent polymer consumption of Gao & Cabrera-Serrenho (2025) +Combines the apparent polymer consumption of Gao & Cabrera-Serrenho (2025) (\code{readSource("GaoCabrera2025", "consumption")}) with their polymer-specific end-use sector distribution (\code{readSource("GaoCabrera2025", "sector_shares")}) to obtain, for every diff --git a/man/calcPlSyntheticFibre.Rd b/man/calcPlSyntheticFibre.Rd index 5110df55..f994da02 100644 --- a/man/calcPlSyntheticFibre.Rd +++ b/man/calcPlSyntheticFibre.Rd @@ -12,9 +12,9 @@ A list in \code{\link[madrat]{calcOutput}} format with total synthetic } \description{ Combines the global synthetic fibre production time series (Polyester, -Polyamide (nylon) and Acrylic) from Textile Exchange with the estimated -country-level production shares based on Credence Research market data -on monoethylene glycol (MEG) to yield a total synthetic +Polyamide (nylon), Acrylic, Polypropylene and Elastane) from Textile Exchange +with the estimated country-level production shares based on Credence Research +market data on monoethylene glycol (MEG) to yield a total synthetic fibre production by country and year. } \examples{ From 6f43e48db713638b240b2fd16b906c5da4e02f42 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 28 Jul 2026 11:10:50 +0200 Subject: [PATCH 27/40] fix bug --- R/readGaoCabrera2025.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/readGaoCabrera2025.R b/R/readGaoCabrera2025.R index d0c30056..8ebf726a 100644 --- a/R/readGaoCabrera2025.R +++ b/R/readGaoCabrera2025.R @@ -40,7 +40,7 @@ readGaoCabrera2025 <- function(subtype = "consumption") { # SI Table S3). Shared by both subtypes so their polymer dimension matches. polymerLabels <- c( "LDPE", "LLDPE", "HDPE", "PP", "PS", "PVC", "PET", "PUR", - "Polyester fibre", "Polyamide fibre", "Other fibre (acrylic)", + "PET fibre", "Polyamide fibre", "Other fibre", "Rubbers", "Other thermoplastics", "Other thermosets" ) nPoly <- length(polymerLabels) # 14 From 562e6c616d402fbcecc38d7bbfae58b80b358eaf Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 28 Jul 2026 12:12:36 +0200 Subject: [PATCH 28/40] fix UNEP-NGP polymer mapping --- inst/extdata/sectoral/polymermappingUNEP_NGP.csv | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/inst/extdata/sectoral/polymermappingUNEP_NGP.csv b/inst/extdata/sectoral/polymermappingUNEP_NGP.csv index ff466eee..3883593a 100644 --- a/inst/extdata/sectoral/polymermappingUNEP_NGP.csv +++ b/inst/extdata/sectoral/polymermappingUNEP_NGP.csv @@ -1,7 +1,7 @@ Source;Target_polymer -Unknown;Polyester fibre +Unknown;PET fibre Unknown;Polyamide fibre -Unknown;Other fibre (acrylic) +Unknown;Other fibre Unknown;Rubbers Unknown;Other thermoplastics Unknown;Other thermosets @@ -23,6 +23,6 @@ Polyester;Other thermosets Other;Other thermosets Other;Other thermoplastics Other;PUR -Fibres;Polyester fibre +Fibres;PET fibre Fibres;Polyamide fibre -Fibres;Other fibre (acrylic) \ No newline at end of file +Fibres;Other fibre \ No newline at end of file From be9cc43c70879b02c0a6215a8891dab9c2a3e941 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 28 Jul 2026 13:49:58 +0200 Subject: [PATCH 29/40] preserve type dim in plastics waste trade --- R/calcPlTrade.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/calcPlTrade.R b/R/calcPlTrade.R index 9355835c..3335aa95 100644 --- a/R/calcPlTrade.R +++ b/R/calcPlTrade.R @@ -118,7 +118,7 @@ calcPlTrade <- function( note <- "dimensions: (Historic Time,Region,Type,Material,Good,value)" # remove sector column for Primary and Waste category ("General" for all) if (category %in% c("Primary", "Waste")) { - x <- collapseNames(x) + x <- collapseNames(x, preservedim = "type") note <- "dimensions: (Historic Time,Region,Type,Material,value)" } } else if (data_source == "BACI_UNCTAD") { From 41bec78464968381c9be8bf213e77b6b1971b50e Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 28 Jul 2026 16:11:47 +0200 Subject: [PATCH 30/40] fix linter warnings --- R/calcPlBACI.R | 8 ++++---- R/calcPlHVCinput.R | 11 +++++++---- R/calcPlMechLoss.R | 4 ++-- R/calcPlMechReYield.R | 2 +- R/calcPlProduction.R | 6 +++--- R/calcPlSectorPolymerSplit.R | 4 ++-- R/calcPlSyntheticFibre.R | 11 +++++------ R/calcPlSyntheticRubber.R | 8 ++++---- R/convertIRSG.R | 2 +- R/convertTextileExchange.R | 2 +- R/readLeviCullen.R | 6 ++++-- man/calcPlSyntheticFibre.Rd | 4 ++-- man/readLeviCullen.Rd | 6 ++++-- 13 files changed, 40 insertions(+), 34 deletions(-) diff --git a/R/calcPlBACI.R b/R/calcPlBACI.R index a60231b2..4e891715 100644 --- a/R/calcPlBACI.R +++ b/R/calcPlBACI.R @@ -64,16 +64,16 @@ calcPlBACI <- function(subtype, category, HS) { rename("sector" = "Target") # map UNEP-NGP polymers to polymers used in REMIND-MFA - if (category == "Waste"){ + if (category == "Waste") { polymer_map <- toolGetMapping("polymermappingUNEP_NGP_waste.csv", type = "sectoral", where = "mrmfa") } else { polymer_map <- toolGetMapping("polymermappingUNEP_NGP.csv", type = "sectoral", where = "mrmfa") } # use polymer use by sector as weights (summarize over all Regions and Years); # use total polymer use over all sectors as weights for "General" sector - use_sector <- dimSums(calcOutput("PlGaoCabrera2025", aggregate = TRUE), dim = c("region","year")) - use_total <- dimSums(use_sector, dim = "sector") %>% addDim(dim=3.3, dimName="sector", item="General") - use_by_sector <- mbind(use_sector, use_total) %>% as.data.frame(rev=3) + use_sector <- dimSums(calcOutput("PlGaoCabrera2025", aggregate = TRUE), dim = c("region", "year")) + use_total <- dimSums(use_sector, dim = "sector") %>% addDim(dim = 3.3, dimName = "sector", item = "General") + use_by_sector <- mbind(use_sector, use_total) %>% as.data.frame(rev = 3) split <- merge(polymer_map, use_by_sector, by.y = "polymer", by.x = "Target_polymer") %>% group_by(.data$sector, .data$Source) %>% mutate( diff --git a/R/calcPlHVCinput.R b/R/calcPlHVCinput.R index 678cd126..7352ea95 100644 --- a/R/calcPlHVCinput.R +++ b/R/calcPlHVCinput.R @@ -58,7 +58,9 @@ calcPlHVCinput <- function(subtype) { # merge with HVC input and calculate total HVC input by element HVC_input <- merge(HVC_input, carbon_content, by.x = "input", by.y = "Data1") %>% - mutate(input_by_element = .data$tonnes * .data$Value, hvc_type = case_when(.data$input == "butadiene" ~ "C4", .default = "HVC w/o C4")) %>% + mutate( + input_by_element = .data$tonnes * .data$Value, + hvc_type = case_when(.data$input == "butadiene" ~ "C4", .default = "HVC w/o C4")) %>% group_by(.data$polymer, .data$element, .data$hvc_type) %>% summarize(HVC_input = sum(.data$input_by_element)) HVC_input_magclass <- as.magpie(HVC_input) @@ -97,8 +99,8 @@ calcPlHVCinput <- function(subtype) { group_by(.data$element) %>% tidyr::nest() %>% mutate( - model = purrr::map(.data$data, ~ lm(hvc_input ~ carbon, data = .x)), - pred = purrr::map(.data$model, ~ predict(.x, newdata = cc_missing)) + model = purrr::map(.data$data, ~ stats::lm(hvc_input ~ carbon, data = .x)), + pred = purrr::map(.data$model, function(m) stats::predict(m, newdata = cc_missing)) ) %>% tidyr::unnest("pred") %>% mutate( @@ -123,7 +125,8 @@ calcPlHVCinput <- function(subtype) { # --------------------------------------------------------------------------- polymer_map <- toolGetMapping("polymermappingLeviCullen.csv", type = "sectoral", where = "mrmfa") production_volumes <- readSource("LeviCullen", subtype = "Production", convert = FALSE) - weights <- mselect(production_volumes, stage = "total production", type = "plastics", to = polymerization$polymer, collapseNames = TRUE) %>% collapseDim() + weights <- mselect(production_volumes, stage = "total production", type = "plastics", to = polymerization$polymer, + collapseNames = TRUE) %>% collapseDim() HVC_input_mapped <- HVC_input_magclass %>% toolAggregate(rel = polymer_map, dim = 3.1, from = "Source", to = "Target", weight = weights, wdim = 3.1) polymerization_mapped <- polymerization_magclass %>% diff --git a/R/calcPlMechLoss.R b/R/calcPlMechLoss.R index 7961215f..396c08bb 100644 --- a/R/calcPlMechLoss.R +++ b/R/calcPlMechLoss.R @@ -1,4 +1,4 @@ -#' Set Country-Level Mechanical Recycling Loss +#' Set Country-Level Mechanical Recycling Loss #' #' @author Qianzhi Zhang #' @@ -14,7 +14,7 @@ calcPlMechLoss <- function() { x = x, weight = NULL, unit = "% Mechanical Recycling Loss", - isocountries= FALSE, + isocountries = FALSE, description = description, note = "dimensions: (value)" )) diff --git a/R/calcPlMechReYield.R b/R/calcPlMechReYield.R index 0e8b8cbb..dcbaaa31 100644 --- a/R/calcPlMechReYield.R +++ b/R/calcPlMechReYield.R @@ -10,7 +10,7 @@ calcPlMechReYield <- function() { x = x, weight = NULL, unit = "% Mechanical recycling efficiency", - isocountries= FALSE, + isocountries = FALSE, description = "Mechanical recycling yield trajectories aggregated to country level for 1950-2100.", note = "dimensions: (value)" )) diff --git a/R/calcPlProduction.R b/R/calcPlProduction.R index 39dc9e23..7088a286 100644 --- a/R/calcPlProduction.R +++ b/R/calcPlProduction.R @@ -54,7 +54,7 @@ calcPlProduction <- function() { x <- toolBackcastByReference(x, oecdTotal) x <- toolBackcastByReference(x, geyer) magpiesort(x) - x <- x[,getYears(x)% magpiesort() - data_years <- getYears(data, as.integer=TRUE) + data_years <- getYears(data, as.integer = TRUE) interpolated <- toolInterpolate( data, years = seq(data_years[1], data_years[length(data_years)], 1), @@ -29,8 +28,8 @@ calcPlSyntheticFibre <- function() { ) # backcast missing years by oecd (first historic years differ between fibre types) oecdTotal <- dimSums(readSource("OECD_Plastic", subtype = "Use_1990-2019_region"), dim = 1) - getItems(oecdTotal, dim=3) <- NULL - getItems(oecdTotal, dim=1) <- "GLO" + getItems(oecdTotal, dim = 3) <- NULL + getItems(oecdTotal, dim = 1) <- "GLO" extrapolated <- toolBackcastByReference(interpolated, oecdTotal) # global synthetic fibre production per year (sum over the three fibre types, diff --git a/R/calcPlSyntheticRubber.R b/R/calcPlSyntheticRubber.R index 40d45953..c40360a5 100644 --- a/R/calcPlSyntheticRubber.R +++ b/R/calcPlSyntheticRubber.R @@ -29,10 +29,10 @@ calcPlSyntheticRubber <- function() { onlyGlobalYears <- setdiff(globalYears, regionalYears) # for each global-only year, apply the country shares of the closest year with data - shares <- countryProd/dimSums(countryProd, dim=1) - target_years = union(regionalYears, globalYears) - shares <- toolInterpolate(shares, years=target_years, extrapolate=TRUE) - globalProd <- globalTotal[,onlyGlobalYears,] * shares[,onlyGlobalYears,] + shares <- countryProd / dimSums(countryProd, dim = 1) + target_years <- union(regionalYears, globalYears) + shares <- toolInterpolate(shares, years = target_years, extrapolate = TRUE) + globalProd <- globalTotal[, onlyGlobalYears, ] * shares[, onlyGlobalYears, ] # 2018-2020 taken directly, 2021-2024 derived from global totals * closest-year shares x <- mbind(countryProd, globalProd) diff --git a/R/convertIRSG.R b/R/convertIRSG.R index a306da4d..afbb487e 100644 --- a/R/convertIRSG.R +++ b/R/convertIRSG.R @@ -27,7 +27,7 @@ convertIRSG <- function(x, subtype) { countries <- unique(map$CountryCode) # country-level chemical energy consumption as disaggregation weight - weight <- calcOutput("ChemicalTotal", aggregate = FALSE)[countries,getYears(x),] + weight <- calcOutput("ChemicalTotal", aggregate = FALSE)[countries, getYears(x), ] getNames(weight) <- NULL # disaggregate regions to countries, weighted by chemical energy consumption diff --git a/R/convertTextileExchange.R b/R/convertTextileExchange.R index 1b97bdce..ca111333 100644 --- a/R/convertTextileExchange.R +++ b/R/convertTextileExchange.R @@ -33,7 +33,7 @@ convertTextileExchange <- function(x) { # year and align it to the share year. chem <- calcOutput("ChemicalTotal", aggregate = FALSE) chem <- toolInterpolate(chem, union(getYears(chem), getYears(x)), extrapolate = TRUE) - chem <- chem[,getYears(x),] + chem <- chem[, getYears(x), ] getNames(chem) <- NULL x <- toolAggregate(x, diff --git a/R/readLeviCullen.R b/R/readLeviCullen.R index f250c12f..b740bd6d 100644 --- a/R/readLeviCullen.R +++ b/R/readLeviCullen.R @@ -1,11 +1,13 @@ #' Read data from Levi and Cullen (2018) #' @description #' Read data from supplementary material of Levi and Cullen (2018) paper -#' 'Mapping Global Flows of Chemicals: From Fossil Fuel Feedstocks to Chemical Products'. https://doi.org/10.1021/acs.est.7b04573 +#' 'Mapping Global Flows of Chemicals: From Fossil Fuel Feedstocks to Chemical Products'. +#' https://doi.org/10.1021/acs.est.7b04573 #' @param subtype #' - "HVCbyProcess" HVC inputs for chemical processes in the plastics production chain from Table S20 #' For PUR that is not covered separately in the paper, assumptions were made regarding a typical composition -#' - "Production" flows and total production volumes of chemicals in the plastics production chain from several Tables in SI +#' - "Production" flows and total production volumes of chemicals in the plastics production chain from +#' several Tables in SI #' @author Leonie Schweiger readLeviCullen <- function(subtype) { version <- "v2.0" diff --git a/man/calcPlSyntheticFibre.Rd b/man/calcPlSyntheticFibre.Rd index f994da02..2e9aada8 100644 --- a/man/calcPlSyntheticFibre.Rd +++ b/man/calcPlSyntheticFibre.Rd @@ -12,8 +12,8 @@ A list in \code{\link[madrat]{calcOutput}} format with total synthetic } \description{ Combines the global synthetic fibre production time series (Polyester, -Polyamide (nylon), Acrylic, Polypropylene and Elastane) from Textile Exchange -with the estimated country-level production shares based on Credence Research +Polyamide (nylon), Acrylic, Polypropylene and Elastane) from Textile Exchange +with the estimated country-level production shares based on Credence Research market data on monoethylene glycol (MEG) to yield a total synthetic fibre production by country and year. } diff --git a/man/readLeviCullen.Rd b/man/readLeviCullen.Rd index 55edd855..88e4082a 100644 --- a/man/readLeviCullen.Rd +++ b/man/readLeviCullen.Rd @@ -9,11 +9,13 @@ readLeviCullen(subtype) \arguments{ \item{subtype}{- "HVCbyProcess" HVC inputs for chemical processes in the plastics production chain from Table S20 For PUR that is not covered separately in the paper, assumptions were made regarding a typical composition -- "Production" flows and total production volumes of chemicals in the plastics production chain from several Tables in SI} +- "Production" flows and total production volumes of chemicals in the plastics production chain from + several Tables in SI} } \description{ Read data from supplementary material of Levi and Cullen (2018) paper -'Mapping Global Flows of Chemicals: From Fossil Fuel Feedstocks to Chemical Products'. https://doi.org/10.1021/acs.est.7b04573 +'Mapping Global Flows of Chemicals: From Fossil Fuel Feedstocks to Chemical Products'. +https://doi.org/10.1021/acs.est.7b04573 } \author{ Leonie Schweiger From 869b4fc98ef4f703a9b7fd5a151bd1497876f958 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Tue, 28 Jul 2026 16:12:05 +0200 Subject: [PATCH 31/40] remove collapseDims from toolAggregateBilateralTrade --- R/toolAggregateBilateralTrade.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/toolAggregateBilateralTrade.R b/R/toolAggregateBilateralTrade.R index 087d4e8a..6cc29db7 100644 --- a/R/toolAggregateBilateralTrade.R +++ b/R/toolAggregateBilateralTrade.R @@ -39,8 +39,7 @@ toolAggregateBilateralTrade <- function(x, rel, flow_label) { x <- df %>% select("Region", "Year" = "t", all_of(group_vars), "value") %>% - as.magpie(spatial = 1, temporal = 2) %>% - collapseDim() + as.magpie(spatial = 1, temporal = 2) return(x) } From 930c989232e699cc758e3db5b7b224481e5663cf Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 10:53:21 +0200 Subject: [PATCH 32/40] fix target years warning for PlTrade output --- R/calcPlTrade.R | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) diff --git a/R/calcPlTrade.R b/R/calcPlTrade.R index 3335aa95..11d96d40 100644 --- a/R/calcPlTrade.R +++ b/R/calcPlTrade.R @@ -29,12 +29,17 @@ #' - 02 #' - 17 #' - 22 +#' @param target_years integer vector of target years for the output data. +#' If NULL, all years from reference (plastics production) are included. +#' Note: the 'years' argument in calcOutput does not work properly for this function, +#' so 'target years' should be set here instead. #' @author Qianzhi Zhang, Leonie Schweiger calcPlTrade <- function( category, flow_label = c("Exports", "Imports"), data_source = c("UNCTAD", "BACI_UNCTAD", "BACI_UNEP"), - HS = "92" + HS = "92", + target_years = NULL ) { # --------------------------------------------------------------------------- # validate inputs @@ -63,9 +68,16 @@ calcPlTrade <- function( ) } + # --------------------------------------------------------------------------- # define a custom aggregation function that filters out all intra-regional trade # and returns both imports and exports for each region in the region mapping - # in addition, data is backcasted to 1950 based on reference + # in addition, data is backcasted to 1950 based on reference (and eventually + # forecasted if reference covers more recent years) + # --------------------------------------------------------------------------- + # reference used for backcasting + reference <- calcOutput("PlProduction", aggregate = FALSE, years = target_years) + target_years <- getYears(reference, as.integer = TRUE) + .customAggregate <- function(x, rel, reference, flow_label) { x <- toolAggregateBilateralTrade(x, rel, flow_label) @@ -79,18 +91,15 @@ calcPlTrade <- function( x <- add_columns(x, addnm = missingRegions, dim = 1, fill = NA) } - if (dimExists("sector", x)) { - x <- toolBackcastByReference(x, ref) - } else { - x <- toolBackcastByReference(x, dimSums(ref, dim = 3)) - } + x <- toolBackcastByReference(x, ref) + x <- toolBackcastByReference(x, ref, doForecast = TRUE) + + # cut x to target years + x <- x[, target_years, ] return(x) } - # reference used for backcasting - reference <- calcOutput("PlProduction", aggregate = FALSE) - # --------------------------------------------------------------------------- # Load data # --------------------------------------------------------------------------- @@ -98,9 +107,9 @@ calcPlTrade <- function( # Load trade data for the selected category and flow label trade <- calcOutput("PlUNCTAD", subtype = category, aggregate = FALSE) trade_filtered <- collapseNames(trade[, , getNames(trade, dim = 1) == flow_label]) - # backcast trade data to 1950 based on historic plastic consumption - consumption <- collapseNames(dimSums(reference, dim = 3)) - x <- toolBackcastByReference(trade_filtered, consumption) + # backcast trade data to 1950 based on historic plastic production + production <- collapseNames(dimSums(reference, dim = 3)) + x <- toolBackcastByReference(trade_filtered, production) getNames(x) <- NULL note <- "dimensions: (Historic Time,Region,value)" From 49eb631158350827f9b0ddc18a74ee48434ef66c Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 12:04:28 +0200 Subject: [PATCH 33/40] fix target years warning for PlTrade output (2) and fix Trade backcasting --- R/calcPlTrade.R | 15 +++++++++++++-- R/fullMFA.R | 12 ++++++------ man/calcPlTrade.Rd | 8 +++++++- 3 files changed, 26 insertions(+), 9 deletions(-) diff --git a/R/calcPlTrade.R b/R/calcPlTrade.R index 11d96d40..2813d888 100644 --- a/R/calcPlTrade.R +++ b/R/calcPlTrade.R @@ -74,16 +74,27 @@ calcPlTrade <- function( # in addition, data is backcasted to 1950 based on reference (and eventually # forecasted if reference covers more recent years) # --------------------------------------------------------------------------- - # reference used for backcasting + # backcast trade data to 1950 based on historic plastic production reference <- calcOutput("PlProduction", aggregate = FALSE, years = target_years) target_years <- getYears(reference, as.integer = TRUE) .customAggregate <- function(x, rel, reference, flow_label) { x <- toolAggregateBilateralTrade(x, rel, flow_label) - # backcast trade data to 1950 based on historic plastic consumption ref <- toolAggregate(reference, rel = rel, from = "country", to = "region") + # the reference (plastics production) may cover more items than the trade data x + # in shared data dimensions (e.g. the reference has type Plastics, Rubber, Fibre + # while plastic waste trade only has type Plastics). Subset the reference to the + # items present in x for every data dimension they share, so backcasting can match + # dimensions. Spatial and temporal dimensions are handled separately below. + xDataSets <- getSets(x, fulldim = TRUE) + xDataSets <- xDataSets[grepl("^d3", names(xDataSets))] + refDataSets <- getSets(ref, fulldim = TRUE) + for (s in intersect(xDataSets, refDataSets)) { + ref <- do.call(mselect, c(list(ref), stats::setNames(list(getItems(x, dim = s)), s))) + } + # if some of the regions are missing in x due to the manual aggregation, # fill with NA to match all the ref regions missingRegions <- setdiff(getItems(ref, dim = 1), getItems(x, dim = 1)) diff --git a/R/fullMFA.R b/R/fullMFA.R index dc02eb57..55f0d7da 100644 --- a/R/fullMFA.R +++ b/R/fullMFA.R @@ -178,12 +178,12 @@ fullMFA <- function(rev = 0, # calcOutput("PlTrade", category = "Manufactured", flow_label = "Imports", data_source = "UNCTAD", file = "pl_manufactured_his_imports.cs4r", years = start_historic:end_historic) # calcOutput("PlWasteTrade", subtype = "export", file = "pl_waste_exports.cs4r", years = start_historic:end_future) # calcOutput("PlWasteTrade", subtype = "import", file = "pl_waste_imports.cs4r", years = start_historic:end_future) - calcOutput("PlTrade", category = "Application", flow_label = "Exports", data_source = "BACI_UNEP", file = "pl_final_his_exports.cs4r", years = start_historic:end_historic) - calcOutput("PlTrade", category = "Application", flow_label = "Imports", data_source = "BACI_UNEP", file = "pl_final_his_imports.cs4r", years = start_historic:end_historic) - calcOutput("PlTrade", category = "Primary", flow_label = "Exports", data_source = "BACI_UNEP", file = "pl_primary_his_exports.cs4r", years = start_historic:end_historic) - calcOutput("PlTrade", category = "Primary", flow_label = "Imports", data_source = "BACI_UNEP", file = "pl_primary_his_imports.cs4r", years = start_historic:end_historic) - calcOutput("PlTrade", category = "Waste", flow_label = "Exports", data_source = "BACI_UNEP", file = "pl_waste_his_exports.cs4r", years = start_historic:end_historic) - calcOutput("PlTrade", category = "Waste", flow_label = "Imports", data_source = "BACI_UNEP", file = "pl_waste_his_imports.cs4r", years = start_historic:end_historic) + calcOutput("PlTrade", category = "Application", flow_label = "Exports", data_source = "BACI_UNEP", file = "pl_final_his_exports.cs4r", target_years = start_historic:end_historic) + calcOutput("PlTrade", category = "Application", flow_label = "Imports", data_source = "BACI_UNEP", file = "pl_final_his_imports.cs4r", target_years = start_historic:end_historic) + calcOutput("PlTrade", category = "Primary", flow_label = "Exports", data_source = "BACI_UNEP", file = "pl_primary_his_exports.cs4r", target_years = start_historic:end_historic) + calcOutput("PlTrade", category = "Primary", flow_label = "Imports", data_source = "BACI_UNEP", file = "pl_primary_his_imports.cs4r", target_years = start_historic:end_historic) + calcOutput("PlTrade", category = "Waste", flow_label = "Exports", data_source = "BACI_UNEP", file = "pl_waste_his_exports.cs4r", target_years = start_historic:end_historic) + calcOutput("PlTrade", category = "Waste", flow_label = "Imports", data_source = "BACI_UNEP", file = "pl_waste_his_imports.cs4r", target_years = start_historic:end_historic) # Parameters calcOutput("PlHVCinput", subtype = "polymerization_yield", aggregate = FALSE, file = "pl_polymerization_yield.cs4r") calcOutput("PlHVCinput", subtype = "HVC_input_ratio", aggregate = FALSE, file = "pl_HVC_input_ratio.cs4r") diff --git a/man/calcPlTrade.Rd b/man/calcPlTrade.Rd index d971dba1..3bddee03 100644 --- a/man/calcPlTrade.Rd +++ b/man/calcPlTrade.Rd @@ -8,7 +8,8 @@ calcPlTrade( category, flow_label = c("Exports", "Imports"), data_source = c("UNCTAD", "BACI_UNCTAD", "BACI_UNEP"), - HS = "92" + HS = "92", + target_years = NULL ) } \arguments{ @@ -40,6 +41,11 @@ calcPlTrade( - 02 - 17 - 22} + +\item{target_years}{integer vector of target years for the output data. +If NULL, all years from reference (plastics production) are included. +Note: the 'years' argument in calcOutput does not work properly for this function, +so 'target years' should be set here instead.} } \description{ Reads plastics trade data and backcasts data to 1950 to fill missing years. From 5b141f64e6a7eb07551c7aacd0a83330ea41c12e Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 12:05:38 +0200 Subject: [PATCH 34/40] fix unknown country codes in BACI --- R/calcPlBACI.R | 3 +++ R/readBACI.R | 5 ++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/calcPlBACI.R b/R/calcPlBACI.R index 4e891715..e3964aa4 100644 --- a/R/calcPlBACI.R +++ b/R/calcPlBACI.R @@ -109,6 +109,9 @@ calcPlBACI <- function(subtype, category, HS) { df$importer[df$importer == "SCG"] <- "SRB" df$exporter[df$exporter == "ANT"] <- "CUW" df$importer[df$importer == "ANT"] <- "CUW" + # ZA1 is the Southern African Customs Union, assigned to South Africa + df$exporter[df$exporter == "ZA1"] <- "ZAF" + df$importer[df$importer == "ZA1"] <- "ZAF" # this mapgie object should actually contain two spatial dimensions "importer" and # "exporter", but since madrat does not support regional aggregation for two spatial diff --git a/R/readBACI.R b/R/readBACI.R index 3c549ff7..4c0e2556 100644 --- a/R/readBACI.R +++ b/R/readBACI.R @@ -141,8 +141,11 @@ readBACI <- function(subtype, subset) { country_codes <- utils::read.csv(file.path(data_path, "country_codes_V202501.csv")) %>% select("country_code", "country_iso3") %>% # country code 490 (country_iso3="S19") is used as a proxy for trade statistics for Taiwan + # country code 849 (country_iso3="PUS", US Misc. Pacific Islands) is assigned to UMI (United States Minor Outlying Islands) # (see https://www.cepii.fr/DATA_DOWNLOAD/baci/doc/baci_webpage.html) - mutate(country_iso3 = case_when(.data$country_iso3 == "S19" ~ "TWN", .default = .data$country_iso3)) + mutate(country_iso3 = case_when(.data$country_iso3 == "S19" ~ "TWN", + .data$country_iso3 == "PUS" ~ "UMI", + .default = .data$country_iso3)) df_all <- NULL From 24807a5986a9586ac64d656445a49036601d3d10 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 12:19:16 +0200 Subject: [PATCH 35/40] fix target years warning for StTrade output --- R/calcStTrade.R | 17 +++++++++++++++-- R/fullMFA.R | 12 ++++++------ man/calcStTrade.Rd | 13 ++++++++++++- 3 files changed, 33 insertions(+), 9 deletions(-) diff --git a/R/calcStTrade.R b/R/calcStTrade.R index 8964a20e..f008e462 100644 --- a/R/calcStTrade.R +++ b/R/calcStTrade.R @@ -16,6 +16,10 @@ #' - 17 #' - 22 #' @param include_intra_regional bool if intra-regional trade should be included +#' @param target_years integer vector of target years for the output data. +#' If NULL, all years from reference are included. +#' Note: the 'years' argument in calcOutput does not work properly for this function, +#' so 'target years' should be set here instead. #' #' @return magpie object of the aggregated trade data #' @@ -33,7 +37,13 @@ #' @importFrom dplyr select filter rename summarize ungroup #' @importFrom magclass as.magpie getComment<- #' -calcStTrade <- function(subtype, category, HS = "92", include_intra_regional = FALSE) { +calcStTrade <- function( + subtype, + category, + HS = "92", + include_intra_regional = FALSE, + target_years = NULL +) { if (category == "indirect") { note <- "dimensions: (Historic Time,Region,Good,value)" } else { @@ -48,7 +58,8 @@ calcStTrade <- function(subtype, category, HS = "92", include_intra_regional = F "direct" = subtype, stop("Unsupported category: ", category) ) - WS_trade <- calcOutput("StTradeWorldsteel", subtype = subtype_WS, aggregate = FALSE) + WS_trade <- calcOutput("StTradeWorldsteel", subtype = subtype_WS, aggregate = FALSE, years = target_years) + target_years <- getYears(WS_trade, as.integer = TRUE) # if intra-regional trade should be included, simply return the Worldsteel trade data if (include_intra_regional == TRUE) { @@ -163,6 +174,8 @@ calcStTrade <- function(subtype, category, HS = "92", include_intra_regional = F } x <- toolBackcastByReference(x, ref) + # cut x to target years + x <- x[, target_years, ] return(x) } diff --git a/R/fullMFA.R b/R/fullMFA.R index 55f0d7da..490daf12 100644 --- a/R/fullMFA.R +++ b/R/fullMFA.R @@ -66,12 +66,12 @@ fullMFA <- function(rev = 0, # calcOutput("StTradeWorldsteel", file = "st_scrap_exports.cs4r", subtype = "scrapExports", years = start_historic:end_historic) # calcOutput("StTradeWorldsteel", file = "st_indirect_imports.cs4r", subtype = "indirectImports", years = start_historic:end_historic) # calcOutput("StTradeWorldsteel", file = "st_indirect_exports.cs4r", subtype = "indirectExports", years = start_historic:end_historic) - calcOutput("StTrade", file = "st_steel_imports.cs4r", subtype = "imports", category = "direct", years = start_historic:end_historic) - calcOutput("StTrade", file = "st_steel_exports.cs4r", subtype = "exports", category = "direct", years = start_historic:end_historic) - calcOutput("StTrade", file = "st_scrap_imports.cs4r", subtype = "imports", category = "scrap", years = start_historic:end_historic) - calcOutput("StTrade", file = "st_scrap_exports.cs4r", subtype = "exports", category = "scrap", years = start_historic:end_historic) - calcOutput("StTrade", file = "st_indirect_imports.cs4r", subtype = "imports", category = "indirect", years = start_historic:end_historic) - calcOutput("StTrade", file = "st_indirect_exports.cs4r", subtype = "exports", category = "indirect", years = start_historic:end_historic) + calcOutput("StTrade", file = "st_steel_imports.cs4r", subtype = "imports", category = "direct", target_years = start_historic:end_historic) + calcOutput("StTrade", file = "st_steel_exports.cs4r", subtype = "exports", category = "direct", target_years = start_historic:end_historic) + calcOutput("StTrade", file = "st_scrap_imports.cs4r", subtype = "imports", category = "scrap", target_years = start_historic:end_historic) + calcOutput("StTrade", file = "st_scrap_exports.cs4r", subtype = "exports", category = "scrap", target_years = start_historic:end_historic) + calcOutput("StTrade", file = "st_indirect_imports.cs4r", subtype = "imports", category = "indirect", target_years = start_historic:end_historic) + calcOutput("StTrade", file = "st_indirect_exports.cs4r", subtype = "exports", category = "indirect", target_years = start_historic:end_historic) # Parameters calcOutput("StCullenFabricationYield", file = "st_fabrication_yield.cs4r", aggregate = FALSE) diff --git a/man/calcStTrade.Rd b/man/calcStTrade.Rd index a5282179..aa8cbaa5 100644 --- a/man/calcStTrade.Rd +++ b/man/calcStTrade.Rd @@ -7,7 +7,13 @@ and aggregate via a custom aggregation function to filter out intra-regional tra (since we don't have a list with all HS codes and corresponding steel shares, BACI trade data cannot be used directly, since it does not cover the full scope)} \usage{ -calcStTrade(subtype, category, HS = "92", include_intra_regional = FALSE) +calcStTrade( + subtype, + category, + HS = "92", + include_intra_regional = FALSE, + target_years = NULL +) } \arguments{ \item{subtype}{Character string specifying the scope @@ -26,6 +32,11 @@ calcStTrade(subtype, category, HS = "92", include_intra_regional = FALSE) - 22} \item{include_intra_regional}{bool if intra-regional trade should be included} + +\item{target_years}{integer vector of target years for the output data. +If NULL, all years from reference are included. +Note: the 'years' argument in calcOutput does not work properly for this function, +so 'target years' should be set here instead.} } \value{ magpie object of the aggregated trade data From 1ae58ec9ba8b0e7d7a37b61bb302ad7fbf00e813 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 14:43:38 +0200 Subject: [PATCH 36/40] enable Plastics MFA historic data until 2022 --- R/calcPlEoL_shares.R | 20 +++++++++++++++----- R/calcPlSectorPolymerSplit.R | 18 +++++++++++++++--- R/calcPlZeroRates.R | 14 ++++---------- R/fullMFA.R | 12 ++++++------ man/calcPlSectorPolymerSplit.Rd | 6 +++++- 5 files changed, 45 insertions(+), 25 deletions(-) diff --git a/R/calcPlEoL_shares.R b/R/calcPlEoL_shares.R index c8c31d18..3c401216 100644 --- a/R/calcPlEoL_shares.R +++ b/R/calcPlEoL_shares.R @@ -125,15 +125,24 @@ calcPlEoL_shares <- function(subtype) { 1 - (x_backcast[, 1950:2000, "Recycled"] + x_backcast[, 1950:2000, "Incinerated"]) ) + # --------------------------------------------------------------------------- + # Forecast EoL rates to 2022 (keep constant) + # --------------------------------------------------------------------------- + x_forecast <- time_interpolate(x_backcast, + interpolated_year = 2019:2022, + integrate_interpolated_years = TRUE, + extrapolation_type = "constant" + ) + # --------------------------------------------------------------------------- # Select data based on subtype # --------------------------------------------------------------------------- x <- switch(subtype, - "Recycled" = mselect(x_backcast, Data1 = "Recycled"), - "Landfilled" = mselect(x_backcast, Data1 = "Landfilled"), - "Incinerated" = mselect(x_backcast, Data1 = "Incinerated"), - "Collected" = mselect(x_backcast, Data1 = "Collected"), - "All" = x_backcast, + "Recycled" = mselect(x_forecast, Data1 = "Recycled"), + "Landfilled" = mselect(x_forecast, Data1 = "Landfilled"), + "Incinerated" = mselect(x_forecast, Data1 = "Incinerated"), + "Collected" = mselect(x_forecast, Data1 = "Collected"), + "All" = x_forecast, stop("Unsupported subtype: ", subtype) ) if (subtype != "All") { @@ -151,6 +160,7 @@ calcPlEoL_shares <- function(subtype) { weight[, , ] <- 0 weight[, seq(2000, 2019, 1)] <- plOECD[, seq(2000, 2019, ), "Total"] weight[, seq(1950, 1999, 1)] <- plOECD[, 2000, "Total"] + weight[, seq(2020, 2022, 1)] <- plOECD[, 2019, "Total"] # --------------------------------------------------------------------------- # Return results diff --git a/R/calcPlSectorPolymerSplit.R b/R/calcPlSectorPolymerSplit.R index d5a3a031..2d65ae74 100644 --- a/R/calcPlSectorPolymerSplit.R +++ b/R/calcPlSectorPolymerSplit.R @@ -18,6 +18,8 @@ #' sector split shares by country, year, type, polymer and sector (1978-2021). #' The weight is the per-type total consumption. Years 2020-2021 rely on #' incomplete Gao trade data. +#' @param target_years integer vector of target years for the output data. +#' Enables forecasting of Gao data to include same years as production data. #' @author Leonie Schweiger #' @seealso \code{\link{readGaoCabrera2025}}, \code{\link{calcPlProduction}} #' @examples @@ -26,16 +28,26 @@ #' } #' @importFrom magclass dimSums #' @export -calcPlSectorPolymerSplit <- function() { +calcPlSectorPolymerSplit <- function(target_years = NULL) { data <- calcOutput("PlGaoCabrera2025", aggregate = FALSE) + # --------------------------------------------------------------------------- + # Forecast to match years of production data + # --------------------------------------------------------------------------- + production <- calcOutput("PlProduction", years = target_years) + data_forecast <- time_interpolate(data, + interpolated_year = getYears(production), + integrate_interpolated_years = TRUE, + extrapolation_type = "constant") + data_forecast <- data_forecast[, getYears(production), ] + # --------------------------------------------------------------------------- # Normalize within type. Each polymer's sector shares sum to 1, so the per-type # total equals that type's summed polymer consumption. # --------------------------------------------------------------------------- - typeTotal <- dimSums(data, dim = c("polymer", "sector")) # (region, year, type) - x <- data / typeTotal # broadcasts typeTotal over polymer.sector via the type subdim + typeTotal <- dimSums(data_forecast, dim = c("polymer", "sector")) # (region, year, type) + x <- data_forecast / typeTotal # broadcasts typeTotal over polymer.sector via the type subdim x[is.na(x)] <- 0 # 0/0 for types with no consumption -> 0 return(list( diff --git a/R/calcPlZeroRates.R b/R/calcPlZeroRates.R index 8966c415..381da6ed 100644 --- a/R/calcPlZeroRates.R +++ b/R/calcPlZeroRates.R @@ -4,22 +4,16 @@ #' @author Leonie Schweiger #' calcPlZeroRates <- function() { - x <- new.magpie( - cells_and_regions = madrat::getISOlist(), - years = 1950:2019, - names = NULL, - fill = 0, - ) - weight <- x - weight[, ] <- 1 + x <- new.magpie(fill = 0) return(list( x = x, - weight = weight, + weight = NULL, unit = "share", + isocountries = FALSE, description = glue::glue("Rates that are historically 0, e.g. chemical recycling \\ rate, bio-based & DAC production rate and emission capture rate"), - note = "dimensions: (Historic Time,Region,value)" + note = "dimensions: (value)" )) } diff --git a/R/fullMFA.R b/R/fullMFA.R index 490daf12..ae82ba62 100644 --- a/R/fullMFA.R +++ b/R/fullMFA.R @@ -156,7 +156,7 @@ fullMFA <- function(rev = 0, # ------------- PLASTIC ----------- if (runSection("plastic")) { start_historic <- 1950 - end_historic <- 2019 + end_historic <- 2022 # common parameters calcOutput("CoPopulation", file = "pl_population.cs4r", scenarios = driverScenarios, collapse = FALSE, smooth = TRUE, years = start_historic:end_future) @@ -164,7 +164,7 @@ fullMFA <- function(rev = 0, # Production calcOutput("PlProduction", file = "pl_production.cs4r", years = start_historic:end_historic) # Consumption - calcOutput("PlSectorPolymerSplit", file = "pl_sector_polymer_split.cs4r", years = start_historic:end_historic) + calcOutput("PlSectorPolymerSplit", file = "pl_sector_polymer_split.cs4r", target_years = start_historic:end_historic) #calcOutput("PlConsumptionByGood", file = "pl_consumption.cs4r") #calcOutput("PlSectorSplit", file = "pl_sector_split.cs4r", aggregate = FALSE) # Trade @@ -199,10 +199,10 @@ fullMFA <- function(rev = 0, calcOutput("PlEoL_shares", subtype = "Recycled", file = "pl_mechanical_recycling_rate.cs4r", years = start_historic:end_historic) calcOutput("PlEoL_shares", subtype = "Incinerated", file = "pl_incineration_rate.cs4r", years = start_historic:end_historic) # Rates that are historically zero - calcOutput("PlZeroRates", file = "pl_chemical_recycling_rate.cs4r", years = start_historic:end_historic) - calcOutput("PlZeroRates", file = "pl_bio_production_rate.cs4r", years = start_historic:end_historic) - calcOutput("PlZeroRates", file = "pl_daccu_production_rate.cs4r", years = start_historic:end_historic) - calcOutput("PlZeroRates", file = "pl_emission_capture_rate.cs4r", years = start_historic:end_historic) + calcOutput("PlZeroRates", file = "pl_chemical_recycling_rate.cs4r", aggregate = FALSE) + calcOutput("PlZeroRates", file = "pl_bio_production_rate.cs4r", aggregate = FALSE) + calcOutput("PlZeroRates", file = "pl_daccu_production_rate.cs4r", aggregate = FALSE) + calcOutput("PlZeroRates", file = "pl_emission_capture_rate.cs4r", aggregate = FALSE) } # nolint end diff --git a/man/calcPlSectorPolymerSplit.Rd b/man/calcPlSectorPolymerSplit.Rd index c67e17f6..b0bf4ee8 100644 --- a/man/calcPlSectorPolymerSplit.Rd +++ b/man/calcPlSectorPolymerSplit.Rd @@ -4,7 +4,11 @@ \alias{calcPlSectorPolymerSplit} \title{Calculate polymer and sector split shares within each plastics type} \usage{ -calcPlSectorPolymerSplit() +calcPlSectorPolymerSplit(target_years = NULL) +} +\arguments{ +\item{target_years}{integer vector of target years for the output data. +Enables forecasting of Gao data to include same years as production data.} } \value{ A list in \code{\link[madrat]{calcOutput}} format with the polymer and From 71ff4fad67d796c0fd571a2fc0847bd3edd0b497 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 15:45:02 +0200 Subject: [PATCH 37/40] fix "value" dimension bug --- R/calcCeTrade.R | 1 + R/calcStTrade.R | 1 + 2 files changed, 2 insertions(+) diff --git a/R/calcCeTrade.R b/R/calcCeTrade.R index e7571214..0d57e903 100644 --- a/R/calcCeTrade.R +++ b/R/calcCeTrade.R @@ -69,6 +69,7 @@ calcCeTrade <- function(subtype, category, HS = "92", target_years = NULL) { x <- as.magpie(df, temporal = 1, spatial = 2, datacol = 4) x <- toolCountryFill(x, fill = NA, verbosity = 2) x <- replace_non_finite(x, replace = 0) + x <- collapseDim(x) # ---------------------------------------------------------------------------- # Aggregation to avoid intra-regional trade diff --git a/R/calcStTrade.R b/R/calcStTrade.R index f008e462..47717159 100644 --- a/R/calcStTrade.R +++ b/R/calcStTrade.R @@ -158,6 +158,7 @@ calcStTrade <- function( x <- as.magpie(df, temporal = "t", spatial = "importer") x <- toolCountryFill(x, fill = NA, verbosity = 2) x <- replace_non_finite(x, replace = 0) + x <- collapseDim(x) .customAggregate <- function(x, rel, reference, flow_label) { # aggregate to regions filtering out intra-regional trade From 5c318b421b036f7524afbbd95146f5d91cd0dc8c Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 15:55:15 +0200 Subject: [PATCH 38/40] fix dimensions in calcPlSectorPolymerSplit output --- R/calcPlSectorPolymerSplit.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/calcPlSectorPolymerSplit.R b/R/calcPlSectorPolymerSplit.R index 2d65ae74..2008ab37 100644 --- a/R/calcPlSectorPolymerSplit.R +++ b/R/calcPlSectorPolymerSplit.R @@ -61,10 +61,7 @@ calcPlSectorPolymerSplit <- function(target_years = NULL) { "(polymer, sector) within each (region, year, type). Multiply by a", "(time, region, type) total to obtain absolute values (done in remind-mfa)." ), - note = paste( - "dimensions: (Time, Region, Type, Polymer, Sector); shares sum to 1 within", - "each (Time, Region, Type). Years 2020-2021 rely on incomplete Gao trade data." - ), + note = "dimensions: (Time, Region, Type, Material, Good)", min = 0, max = 1 )) From 6756b8909dc793c3a940a646677fdd3217e8ae79 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Wed, 29 Jul 2026 16:10:22 +0200 Subject: [PATCH 39/40] plastic flows in t instead of Mt --- R/calcPlBACI.R | 2 +- R/calcPlProduction.R | 5 ++++- R/calcPlSectorPolymerSplit.R | 2 +- R/calcPlTrade.R | 2 +- R/fullMFA.R | 2 +- R/readBACI.R | 4 ++-- 6 files changed, 10 insertions(+), 7 deletions(-) diff --git a/R/calcPlBACI.R b/R/calcPlBACI.R index e3964aa4..dd1ea1f3 100644 --- a/R/calcPlBACI.R +++ b/R/calcPlBACI.R @@ -125,7 +125,7 @@ calcPlBACI <- function(subtype, category, HS) { return(list( x = x, weight = NULL, - unit = "Mt Plastic", + unit = "t Plastic", description = "Plastic trade data from BACI" )) } diff --git a/R/calcPlProduction.R b/R/calcPlProduction.R index 7088a286..71a4a821 100644 --- a/R/calcPlProduction.R +++ b/R/calcPlProduction.R @@ -77,10 +77,13 @@ calcPlProduction <- function() { x <- mbind(fibre, rubber, plastics) names(dimnames(x))[3] <- "type" + # convert Mt -> t + x <- x * 1e6 + return(list( x = x, weight = NULL, - unit = "Mt", + unit = "t", description = paste( "Plastics (Plastics Europe), synthetic fibre (Textile Exchange) and", "synthetic rubber (IRSG) production by country and type, 1950-2024. Each", diff --git a/R/calcPlSectorPolymerSplit.R b/R/calcPlSectorPolymerSplit.R index 2008ab37..d1e65568 100644 --- a/R/calcPlSectorPolymerSplit.R +++ b/R/calcPlSectorPolymerSplit.R @@ -61,7 +61,7 @@ calcPlSectorPolymerSplit <- function(target_years = NULL) { "(polymer, sector) within each (region, year, type). Multiply by a", "(time, region, type) total to obtain absolute values (done in remind-mfa)." ), - note = "dimensions: (Time, Region, Type, Material, Good)", + note = "dimensions: (Time, Region, Type, Material, Good, value)", min = 0, max = 1 )) diff --git a/R/calcPlTrade.R b/R/calcPlTrade.R index 2813d888..2111176d 100644 --- a/R/calcPlTrade.R +++ b/R/calcPlTrade.R @@ -155,7 +155,7 @@ calcPlTrade <- function( list( x = x, weight = NULL, - unit = "Mt Plastic", + unit = "t Plastic", aggregationFunction = aggregationFunction, aggregationArguments = aggregationArguments, description = sprintf( diff --git a/R/fullMFA.R b/R/fullMFA.R index ae82ba62..9b2984e3 100644 --- a/R/fullMFA.R +++ b/R/fullMFA.R @@ -188,7 +188,7 @@ fullMFA <- function(rev = 0, calcOutput("PlHVCinput", subtype = "polymerization_yield", aggregate = FALSE, file = "pl_polymerization_yield.cs4r") calcOutput("PlHVCinput", subtype = "HVC_input_ratio", aggregate = FALSE, file = "pl_HVC_input_ratio.cs4r") calcOutput("PlHVCinput", subtype = "C4_input_ratio", aggregate = FALSE, file = "pl_C4_input_ratio.cs4r") - calcOutput("PlOECD_MGshare", file = "pl_material_shares_in_goods.cs4r") + #calcOutput("PlOECD_MGshare", file = "pl_material_shares_in_goods.cs4r") calcOutput("PlMechReYield", round = 2, file = "pl_mechanical_recycling_yield.cs4r", aggregate = FALSE) # fix 0.79 calcOutput("PlMechLoss", file = "pl_reclmech_loss_uncontrolled_rate.cs4r", aggregate = FALSE) # fix 0.05 calcOutput("PlLifetime", subtype = "Lifetime_mean", aggregate = FALSE, file = "pl_lifetime_mean.cs4r") diff --git a/R/readBACI.R b/R/readBACI.R index 4c0e2556..0ff2bd21 100644 --- a/R/readBACI.R +++ b/R/readBACI.R @@ -156,7 +156,7 @@ readBACI <- function(subtype, subset) { if (key == "plastics_UNCTAD") { # merge UNCTAD codes with BACI data df_filtered <- merge(df, codes, by.x = "k", by.y = "code") %>% - mutate(value = .data$q / 1000000) %>% # report quantity in Mt + mutate(value = .data$q) %>% # report quantity in t select("t", "i", "j", "k", "value") } else if (key == "plastics_UNEP") { # UNEP Codes contain 4 digit and 5/6 digit codes; @@ -167,7 +167,7 @@ readBACI <- function(subtype, subset) { # merge filtered data with 4 and 6 digit codes, calculate plastics content df_filtered <- rbind(df_plastics_k6, df_plastics_k4) %>% rename(k = "code") %>% - mutate(q_plastic = .data$plastic_percentage * .data$q / 1000000) %>% # report quantity in Mt + mutate(q_plastic = .data$plastic_percentage * .data$q) %>% # report quantity in t group_by(.data$t, .data$i, .data$j, .data$k, .data$polymer, .data$sector) %>% summarize(value = sum(.data$q_plastic, na.rm = TRUE), .groups = "drop_last") %>% ungroup() From 86d68e609b7f58e1fc54aba742d40c03af8c9071 Mon Sep 17 00:00:00 2001 From: Leonie Schweiger Date: Thu, 30 Jul 2026 09:25:51 +0200 Subject: [PATCH 40/40] fix zero weight in calcPlSectorPolymerSplit --- NAMESPACE | 1 + R/calcPlSectorPolymerSplit.R | 35 ++++++++++++++++++++++++++++----- man/calcPlSectorPolymerSplit.Rd | 5 ++++- 3 files changed, 35 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 736ba305..0f6aa81c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -46,6 +46,7 @@ importFrom(magclass,magpiesort) importFrom(magclass,mbind) importFrom(magclass,mselect) importFrom(magclass,new.magpie) +importFrom(magclass,setItems) importFrom(magclass,setNames) importFrom(magclass,setYears) importFrom(magclass,where) diff --git a/R/calcPlSectorPolymerSplit.R b/R/calcPlSectorPolymerSplit.R index d1e65568..73b91f7b 100644 --- a/R/calcPlSectorPolymerSplit.R +++ b/R/calcPlSectorPolymerSplit.R @@ -9,14 +9,17 @@ #' Multiplying the result with a \code{(time, region, type)} total - e.g. the #' output of \code{\link{calcPlProduction}} - yields absolute values per #' \code{(time, region, type, polymer, sector)}. That multiplication happens in -#' remind-mfa, not here. The three fibre polymers form type \code{Fibre}, +#' remind-mfa, not here. Countries with no consumption of a type (so a locally +#' undefined split) fall back to the global \code{(polymer, sector)} split of +#' that type and year, so the shares always sum to 1 and the multiplication +#' conserves mass. The three fibre polymers form type \code{Fibre}, #' \code{Rubbers} forms type \code{Rubber}, and the remaining polymers form type #' \code{Plastics}, matching the \code{type} dimension of #' \code{\link{calcPlProduction}}. #' #' @return A list in \code{\link[madrat]{calcOutput}} format with the polymer and #' sector split shares by country, year, type, polymer and sector (1978-2021). -#' The weight is the per-type total consumption. Years 2020-2021 rely on +#' The weight is the per-type Gao consumption total. Years 2020-2021 rely on #' incomplete Gao trade data. #' @param target_years integer vector of target years for the output data. #' Enables forecasting of Gao data to include same years as production data. @@ -26,7 +29,7 @@ #' \dontrun{ #' a <- calcOutput("PlSectorPolymerSplit") #' } -#' @importFrom magclass dimSums +#' @importFrom magclass dimSums setItems #' @export calcPlSectorPolymerSplit <- function(target_years = NULL) { @@ -48,11 +51,33 @@ calcPlSectorPolymerSplit <- function(target_years = NULL) { # --------------------------------------------------------------------------- typeTotal <- dimSums(data_forecast, dim = c("polymer", "sector")) # (region, year, type) x <- data_forecast / typeTotal # broadcasts typeTotal over polymer.sector via the type subdim - x[is.na(x)] <- 0 # 0/0 for types with no consumption -> 0 + + # Where a country has no consumption of a type (typeTotal == 0) the local split + # is undefined (0/0) and would collapse to all-zeros. Multiplying that by a + # non-zero production total in remind-mfa would lose mass. Fall back to the + # global (polymer, sector) split of that type and year, which sums to 1 and + # hence conserves mass; countries that do have data keep their own split. + globalByType <- dimSums(data_forecast, dim = "region") # (GLO, year, type.polymer.sector) + globalShare <- globalByType / dimSums(globalByType, dim = c("polymer", "sector")) + globalShare[is.na(globalShare)] <- 0 # type absent even globally -> genuinely 0 + globalShare <- setItems(globalShare, dim = 1, "GLO") # mark global so it broadcasts over region + + missing <- typeTotal == 0 # (region, year, type) + x[is.na(x)] <- 0 # start the undefined blocks from 0 ... + x <- x + missing * globalShare # ... then fill only those blocks with the global split + + # Weight the shares by Gao consumption, but floor the zero weights of fallback + # (region, year, type) blocks to a negligible positive value. Otherwise a model + # region whose countries all lack Gao data for a type sums to zero weight and + # its aggregated share becomes NaN (mass loss). The floor is tiny relative to + # real consumption, so it does not shift data-rich regions; where it does apply + # every country carries the same global split, so the region resolves to it. + weight <- typeTotal + weight[weight == 0] <- 1e-9 * max(weight) return(list( x = x, - weight = typeTotal, + weight = weight, unit = "share", description = paste( "Share of each polymer and end-use sector within total Fibre/Rubber/Plastics", diff --git a/man/calcPlSectorPolymerSplit.Rd b/man/calcPlSectorPolymerSplit.Rd index b0bf4ee8..576dc8ee 100644 --- a/man/calcPlSectorPolymerSplit.Rd +++ b/man/calcPlSectorPolymerSplit.Rd @@ -25,7 +25,10 @@ sectors is normalized within each type (\code{Fibre}, \code{Rubber}, Multiplying the result with a \code{(time, region, type)} total - e.g. the output of \code{\link{calcPlProduction}} - yields absolute values per \code{(time, region, type, polymer, sector)}. That multiplication happens in -remind-mfa, not here. The three fibre polymers form type \code{Fibre}, +remind-mfa, not here. Countries with no consumption of a type (so a locally +undefined split) fall back to the global \code{(polymer, sector)} split of +that type and year, so the shares always sum to 1 and the multiplication +conserves mass. The three fibre polymers form type \code{Fibre}, \code{Rubbers} forms type \code{Rubber}, and the remaining polymers form type \code{Plastics}, matching the \code{type} dimension of \code{\link{calcPlProduction}}.