From c0383f512f4c156828fb6a569a209a925746e574 Mon Sep 17 00:00:00 2001 From: Alois Dirnaichner Date: Wed, 15 Sep 2021 20:42:31 +0200 Subject: [PATCH 1/2] Copy acea files and add some processing logic (unfinished) --- R/generateEDGEdata.R | 3 ++ inst/Rmd/report.Rmd | 70 +++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 72 insertions(+), 1 deletion(-) diff --git a/R/generateEDGEdata.R b/R/generateEDGEdata.R index e35e1cf9..cccf330a 100644 --- a/R/generateEDGEdata.R +++ b/R/generateEDGEdata.R @@ -433,6 +433,9 @@ generateEDGEdata <- function(input_folder, output_folder, saveRDS(POP, file = level2path("POP.RDS")) saveRDS(IEAbal_comparison$IEA_dt2plot, file = level2path("IEAcomp.RDS")) + ## copy ACEA data for comparison + acea_files <- list.files(file.path(input_folder, "ACEA"), pattern="*.csv", full.names=T) + file.copy(acea_files, level2path(""), overwrite = T) md_template = level2path("report.Rmd") ## ship and run the file in the output folder file.copy(system.file("Rmd", "report.Rmd", package = "edgeTransport"), diff --git a/inst/Rmd/report.Rmd b/inst/Rmd/report.Rmd index fad275d8..c829e699 100644 --- a/inst/Rmd/report.Rmd +++ b/inst/Rmd/report.Rmd @@ -1751,7 +1751,7 @@ plotCost(costs = techcost, vt = "Passenger Rail_tmp_vehicletype") ``` # ES validation for selected categories and regions -## Passenger transport in DEU 2018 +## Passenger transport in DEU 2018 - Verkehr-in-Zahlen ```{r, echo=FALSE, warning=FALSE, message=FALSE} @@ -1786,3 +1786,71 @@ ViZ,LDV, 913.3 es_deu_verkehrinzahlen(demandkm) ``` + +## Vehicle numbers in the EU - ACEA + +```{r, echo=FALSE, warning=FALSE, message=FALSE} +vn_eu_acea <- function(demand_km, loadFactor, annual_mileage){ + + all_eu <- c(EU_regions, NEU_regions) + + ## vkm + demand_vkm <- merge(demand_km, loadFactor, + by=colnames(demand_km)[2:ncol(demand_km)]) + demand_vkm[, demandVKM := demand_F/loadFactor] + nas <- demand_vkm[is.na(demandVKM)] + if(length(nas)){ + warning(sprintf("Missing demand for %s", unique(nas$vehicle_type))) + } + demand_vkm <- demand_vkm[!is.na(demandVKM)] + + ## mileage + demand_vkm <- merge(demand_vkm, annual_mileage, + by=colnames(demand_km)[2:ncol(demand_km)]) + no_mileage <- demand_vkm[is.na(vkm.veh) | vkm.veh == 0] + if(length(no_mileage)){ + warning(sprintf("Missing demand for %s", unique(no_mileage$vehicle_type))) + } + demand_vkm[, veh_num := demandVKM/vkm.veh] + + aceadt <- rbindlist(list( + fread("acea_cars.csv")[, group:="cars"], + fread("acea_lcm.csv")[, group:="lcv"], + fread("acea_trucks.csv")[, group:="trucks"] + )) + + mapping_TRACCS_iso= fread( + system.file( + "extdata", "mapping_countries_EU.csv", package="edgeTransport"), skip=0) + aceadt <- merge(aceadt, mapping_TRACCS_iso, by.x="country", by.y="country_name") + + demand_eu <- demand_vkm[region %in% aceadt$iso] + + + demand_deu <- rmndt::approx_dt(demand_deu, c(2015, 2018, 2020), "year", "demand_F", + idxcols=colnames(demand_deu)[3:9])[year == 2018] + toplot <- demand_deu[, .(model="EDGE-T", demand=1e-3*sum(demand_F)), by=c("subsector_L2")] # millions -> billions + toplot[, subsector_L2 := gsub("_tmp_subsector_L2", "", subsector_L2)] + toplot[, subsector_L2 := gsub("trn_pass_road_", "", subsector_L2)] + + ## Verkehr-in-Zahlen 2020, https://www.bmvi.de/SharedDocs/DE/Artikel/G/verkehr-in-zahlen.html, p224-225 + vkiz <- fread(text=" +model,subsector_L2,demand +ViZ,Cycle, 39.8 +ViZ,Domestic Aviation, 70.4 +ViZ,Passenger Rail, 98.2 +ViZ,Walk, 35.9 +ViZ,Bus, 80.1, +ViZ,LDV, 913.3 +")[, demand := demand] + + toplot <- rbind(toplot, vkiz) + + p <- ggplot(toplot, aes(x=model, y=demand)) + + geom_bar(stat="identity", fill="blue") + + facet_wrap(~subsector_L2, scales="free_y") + + labs(y="Transport Demand 2018 [billion pkm]") + + theme_plot + return(p) +} +``` From 98d29f6bd9c6e70ea6dcc7a12e3e420ed0fc7c5d Mon Sep 17 00:00:00 2001 From: Alois Dirnaichner Date: Thu, 16 Sep 2021 17:18:58 +0200 Subject: [PATCH 2/2] Apply some ACEA classifications to the EU data. --- inst/Rmd/report.Rmd | 28 ++++------------------------ 1 file changed, 4 insertions(+), 24 deletions(-) diff --git a/inst/Rmd/report.Rmd b/inst/Rmd/report.Rmd index c829e699..952ee658 100644 --- a/inst/Rmd/report.Rmd +++ b/inst/Rmd/report.Rmd @@ -1825,32 +1825,12 @@ vn_eu_acea <- function(demand_km, loadFactor, annual_mileage){ aceadt <- merge(aceadt, mapping_TRACCS_iso, by.x="country", by.y="country_name") demand_eu <- demand_vkm[region %in% aceadt$iso] - - - demand_deu <- rmndt::approx_dt(demand_deu, c(2015, 2018, 2020), "year", "demand_F", - idxcols=colnames(demand_deu)[3:9])[year == 2018] - toplot <- demand_deu[, .(model="EDGE-T", demand=1e-3*sum(demand_F)), by=c("subsector_L2")] # millions -> billions - toplot[, subsector_L2 := gsub("_tmp_subsector_L2", "", subsector_L2)] - toplot[, subsector_L2 := gsub("trn_pass_road_", "", subsector_L2)] - ## Verkehr-in-Zahlen 2020, https://www.bmvi.de/SharedDocs/DE/Artikel/G/verkehr-in-zahlen.html, p224-225 - vkiz <- fread(text=" -model,subsector_L2,demand -ViZ,Cycle, 39.8 -ViZ,Domestic Aviation, 70.4 -ViZ,Passenger Rail, 98.2 -ViZ,Walk, 35.9 -ViZ,Bus, 80.1, -ViZ,LDV, 913.3 -")[, demand := demand] + ## apply ACEA classification + demand_eu[subsector_L2 == "trn_pass_road_LDV", group := "cars"] + demand_eu[subsector_L3 == "trn_freight_road" & vehicle_type == "Truck (0-3.5t)", group := "lcv"] + demand_eu[subsector_L3 == "trn_freight_road" & vehicle_type != "Truck (0-3.5t)", group := "trucks"] - toplot <- rbind(toplot, vkiz) - p <- ggplot(toplot, aes(x=model, y=demand)) + - geom_bar(stat="identity", fill="blue") + - facet_wrap(~subsector_L2, scales="free_y") + - labs(y="Transport Demand 2018 [billion pkm]") + - theme_plot - return(p) } ```