From 3a219d38c62c7521530e4bf037ca8f3244c604d8 Mon Sep 17 00:00:00 2001 From: schlenther Date: Thu, 5 Sep 2024 16:15:47 +0200 Subject: [PATCH] further improvements in R summary plotting scripts --- src/main/R/drtAnalysis/plotRunSummaries.R | 67 ++++++++++--- .../drtAnalysis/readValuesFromRunSummaries.R | 20 +++- ...sFromRunSummaries_v3.0.1-fareExperiments.R | 98 ++++++++++++++----- 3 files changed, 144 insertions(+), 41 deletions(-) diff --git a/src/main/R/drtAnalysis/plotRunSummaries.R b/src/main/R/drtAnalysis/plotRunSummaries.R index ef53500..485050d 100644 --- a/src/main/R/drtAnalysis/plotRunSummaries.R +++ b/src/main/R/drtAnalysis/plotRunSummaries.R @@ -4,18 +4,33 @@ library(tidyr) mainDir <- "E:/matsim-kelheim/v3.1.1/output-KEXI-2.45-AV--0.0/" -transposed_result <- read.csv(paste(mainDir, "results-deutsch.csv", sep=""), check.names = FALSE) +transposed_result <- read.csv(paste(mainDir, "results-deutsch.csv", sep=""), check.names = FALSE, sep =";") #names(transposed_result) <- make.names(names(transposed_result), unique = TRUE, allow_ = FALSE) # Betriebszeiten umschreiben -transposed_result$Betriebszeiten <- ifelse(transposed_result$Betriebszeiten == TRUE, "0h - 24h", "9h - 16h") +transposed_result$Betriebszeiten <- factor(ifelse(transposed_result$Betriebszeiten == TRUE, "0h - 24h", "9h - 16h"), + levels = c("9h - 16h", "0h - 24h")) + + +### +#in Realität haben wir eine avg gruppengr0eße von 1.7 gemessen, diese aber nicht simuliert. +# wir rechnen die jetzt im nachhinein wieder drauf. +## --> machen wir jetzt im skript, dass die daten rausschreibt (readValuesFromRunSammaries.R) + +#transposed_result <- transposed_result %>% +# mutate(`Anzahl Passagiere` = `Bediente Anfragen` * 1.7, +# `Gesamt Passagierkilometer [km]` = `Gesamt Passagierkilometer [km]` * 1.7) %>% +# mutate(`Passagiere pro Fahrzeug` = `Anzahl Passagiere` / Fahrzeuge, +# `Passagiere pro Fahrzeugkilometer` = `Anzahl Passagiere` / `Summe Fahrzeugkilometer [km]`, +# `Passagiere pro Fahrzeugstunde` = `Anzahl Passagiere` / `Summe Fzg.-Betriebsstunden`, +# `Besetzungsgrad [pax-km/v-km]` = `Gesamt Passagierkilometer [km]` / `Summe Fahrzeugkilometer [km]`)# results <- transposed_result %>% gather(key = "parameter", value = "mean", -Geschwindigkeit, -Bediengebiet, -Flottengroeße, -Intermodal, -Betriebszeiten) -plotByConfiguration <- function(parameterStr){ +plotByConfiguration <- function(parameterStr, scales = "free"){ # Filtern der Daten für die gewünschten Parameter plot_data <- results %>% @@ -24,7 +39,7 @@ plotByConfiguration <- function(parameterStr){ # Funktion zum Anpassen der Facet-Labels label_function <- function(value) { - paste(value, "m/s") + paste(round(as.numeric(value) * 3.6, 0), "km/h") } # Erstellen des Facet-Plots @@ -35,9 +50,9 @@ plotByConfiguration <- function(parameterStr){ ) + facet_wrap(~ Geschwindigkeit, labeller = labeller(Geschwindigkeit = label_function) - ,scales = "free" + ,scales = scales ) + - labs(title = paste(parameterStr, "nach Geschwindigkeit, Flottengröße, Bediengebiet und Betriebszeiten"), + labs(title = paste(parameterStr, "nach Geschwindigkeit, Flottengröße,\nBediengebiet und Betriebszeiten"), x = "Flottengröße", y = parameterStr, color = "Bediengebiet", @@ -57,11 +72,39 @@ plotByConfiguration <- function(parameterStr){ } +save <- function(fileName){ + ggsave(filename = paste(mainDir, "plots/", fileName, ".png", sep = ""), + dpi = 600, width = 32, height = 18, units = "cm") +} + unique(results$parameter) + +###nachfrage plotByConfiguration("Bediente Anfragen") -plotByConfiguration("Mittl. Wartezeit") -plotByConfiguration("Avg. ride distance [km]") -plotByConfiguration("Empty ratio") -plotByConfiguration("Total vehicle mileage [km]") -plotByConfiguration("Avg. fare [MoneyUnit]" ) -plotByConfiguration("Pax per veh-km") \ No newline at end of file +save("bedienteAnfragen") +plotByConfiguration("Anzahl Passagiere", "fixed") +save("passagiere") +plotByConfiguration("Mittl. Wartezeit [s]", "fixed") +save("wartezeit") +plotByConfiguration("Umwegfaktor", "fixed") +plotByConfiguration("Mittl. Reiseweite [km]", "fixed") +save("reiseweite") +plotByConfiguration("Anteil Leerkilometer", "fixed") +save("leerkilometer") + + +###betrieb +plotByConfiguration("Summe Fahrzeugkilometer [km]") +save("fahrzeugkilometer") +plotByConfiguration("Besetzungsgrad [pax-km/v-km]") +save("besetzungsgrad") +plotByConfiguration("Passagiere pro Fahrzeugkilometer", "fixed") +save("paxPerKM") +plotByConfiguration("Passagiere pro Fahrzeugstunde") +plotByConfiguration("Passagiere pro Fahrzeugstunde", "fixed") +x^xsave("paxPerVehHour") + + +plotByConfiguration("Gesamt Passagierkilometer [km]") +plotByConfiguration("Gesamt Passagierkilometer [km]", "fixed") + diff --git a/src/main/R/drtAnalysis/readValuesFromRunSummaries.R b/src/main/R/drtAnalysis/readValuesFromRunSummaries.R index 778a570..348f80a 100644 --- a/src/main/R/drtAnalysis/readValuesFromRunSummaries.R +++ b/src/main/R/drtAnalysis/readValuesFromRunSummaries.R @@ -24,6 +24,7 @@ extract_parameters <- function(folder_name, speed) { # Funktion zum Einlesen der CSV-Datei und Extrahieren der "mean"-Werte read_stats <- function(folder_path, file_name) { + print(paste("reading", folder_path)) csv_path <- file.path(folder_path, "analysis/drt-drt-av", file_name) if (file.exists(csv_path)) { @@ -99,12 +100,26 @@ for (speed in speeds) { results <- bind_rows(results) - +##### # Transponiere die Tabelle, um Parameter als Spalten zu setzen transposed_result <- results %>% select(speed, area, fleetSize, intermodal, allDay, parameter, mean) %>% spread(key = parameter, value = mean) +### +#in Realität haben wir eine avg gruppengr0eße von 1.7 gemessen, diese aber nicht simuliert. +# wir rechnen die jetzt im nachhinein wieder drauf. +transposed_result <- transposed_result %>% + mutate(`Passengers (Pax)` = `Handled Requests` * 1.7, + `Total pax distance [km]` = `Total pax distance [km]` * 1.7) %>% + mutate(`Pax per veh` = `Passengers (Pax)` / Vehicles, + `Pax per veh-km` = `Passengers (Pax)` / `Total vehicle mileage [km]`, + `Pax per veh-h` = `Passengers (Pax)` / `Total service hours`, + `Occupancy rate [pax-km/v-km]` = `Total pax distance [km]` / `Total vehicle mileage [km]`) + +#transponiere zurück +results <- transposed_result %>% + gather(key = "parameter", value = "mean", -speed, -area, -fleetSize, -intermodal, -allDay) # Ergebnisse ausgeben print(results) @@ -112,7 +127,6 @@ print(transposed_result) write_csv(transposed_result, paste(mainDir, "results.csv", sep="")) - ##################################################################### ######PLOTS#### @@ -138,6 +152,7 @@ plotByConfiguration <- function(parameterStr){ labeller = labeller(speed = label_function) ,scales = "free" ) + + geom_text(aes(label = fleetSize), vjust = -1, hjust = 0.5, size = 3, color = "black") + labs(title = paste(parameterStr, "by Fleet Size, Speed, Area and Service Hours"), x = "Fleet Size", y = parameterStr, @@ -213,4 +228,5 @@ plotByConfiguration("Pax per veh-km") # Plot anzeigen print(facet_plot) + \ No newline at end of file diff --git a/src/main/R/drtAnalysis/readValuesFromRunSummaries_v3.0.1-fareExperiments.R b/src/main/R/drtAnalysis/readValuesFromRunSummaries_v3.0.1-fareExperiments.R index acc5a56..46902b2 100644 --- a/src/main/R/drtAnalysis/readValuesFromRunSummaries_v3.0.1-fareExperiments.R +++ b/src/main/R/drtAnalysis/readValuesFromRunSummaries_v3.0.1-fareExperiments.R @@ -67,6 +67,7 @@ process_folders <- function(main_folder) { ############# mainDir <- "D:/Projekte/KelRide/runs/v3.0.1-fare-experiments/output-KEXI-kexi" +mainDir <- "E:/matsim-kelheim/v3.0.1-fare-experiments/output-KEXI-kexi/" #speeds <- list(3.3, 5, 8.3) #results <- list() @@ -95,6 +96,11 @@ write_csv(transposed_result, paste(mainDir, "results.csv", sep="")) +save <- function(fileName){ + ggsave(filename = paste(mainDir, "plots/", fileName, ".png", sep = ""), + dpi = 600, width = 32, height = 18, units = "cm") +} + ########################### plotByConfiguration <- function(parameterStr){ @@ -119,27 +125,26 @@ plotByConfiguration <- function(parameterStr){ #linetype = "All Day" #,shape = "Intermodal" ) + - theme_dark() + + #theme_dark() + theme( - plot.title = element_text(size = 16, face = "bold"), # Titelgröße anpassen - axis.title.x = element_text(size = 14), # X-Achsentitelgröße anpassen - axis.title.y = element_text(size = 14), # Y-Achsentitelgröße anpassen - axis.text = element_text(size = 12), # Achsentextgröße anpassen - legend.title = element_text(size = 14), # Legendentitelgröße anpassen - legend.text = element_text(size = 12), # Legendtextgröße anpassen - strip.text = element_text(size = 12) # Facet-Textgröße anpassen + plot.title = element_text(size = 20, face = "bold"), # Titelgröße anpassen + axis.title.x = element_text(size = 18), # X-Achsentitelgröße anpassen + axis.title.y = element_text(size = 18), # Y-Achsentitelgröße anpassen + axis.text = element_text(size = 14), # Achsentextgröße anpassen + legend.title = element_text(size = 18), # Legendentitelgröße anpassen + legend.text = element_text(size = 14), # Legendtextgröße anpassen + strip.text = element_text(size = 18, face = "bold") # Facet-Textgröße anpassen ) - } unique(results$parameter) plotByConfiguration("Rides") plotByConfiguration("Avg. wait time") -plotByConfiguration("Avg. ride distance [km]") -plotByConfiguration("Empty ratio") -plotByConfiguration("Total vehicle mileage [km]") -plotByConfiguration("Avg. fare [MoneyUnit]" ) -plotByConfiguration("Pax per veh-km") +#plotByConfiguration("Avg. ride distance [km]") +#plotByConfiguration("Empty ratio") +#plotByConfiguration("Total vehicle mileage [km]") +#plotByConfiguration("Avg. fare [MoneyUnit]" ) +#plotByConfiguration("Pax per veh-km") ##################### ##Zusammenhang wait time und Nachfrage @@ -155,7 +160,7 @@ avg_wait_time_data <- results %>% rename(avg_wait_time = mean) # Zusammenführen der Daten -plot_data <- left_join(handled_requests_data, avg_wait_time_data, by = c("fares")) + plot_data <- left_join(handled_requests_data, avg_wait_time_data, by = c("fares")) # Erstellen des Facet-Plots facet_plot <- ggplot(plot_data, aes(x = avg_wait_time, y = handled_requests)) + @@ -163,26 +168,65 @@ facet_plot <- ggplot(plot_data, aes(x = avg_wait_time, y = handled_requests)) + geom_point(size = 3 #,aes(shape = as.factor(intermodal)) ) + - geom_text(aes(label = fares), vjust = -1, hjust = 0.5, size = 3, color = "white") + + geom_text(aes(label = fares), vjust = -1, hjust = 0.5, size = 6, color = "black") + #facet_wrap(~ speed, scales = "free") + - labs(title = "Handled Requests by Avg. Wait Time and Fare System (conv. KEXI)", - x = "Avg. Wait Time", - y = "Handled Requests", + labs(title = "Anzahl Passagiere nach durchschn. Wartezeit und Preisschema", + x = "Durchschn. Wartezeit [s]", + y = "# Passagiere", #color = "Area", #linetype = "All Day" #,shape = "Intermodal" ) + - theme_dark() + + #theme_dark() + theme( - plot.title = element_text(size = 16, face = "bold"), # Titelgröße anpassen - axis.title.x = element_text(size = 14), # X-Achsentitelgröße anpassen - axis.title.y = element_text(size = 14), # Y-Achsentitelgröße anpassen - axis.text = element_text(size = 12), # Achsentextgröße anpassen - legend.title = element_text(size = 14), # Legendentitelgröße anpassen - legend.text = element_text(size = 12), # Legendtextgröße anpassen - strip.text = element_text(size = 12) # Facet-Textgröße anpassen + plot.title = element_text(size = 20, face = "bold"), # Titelgröße anpassen + axis.title.x = element_text(size = 18), # X-Achsentitelgröße anpassen + axis.title.y = element_text(size = 18), # Y-Achsentitelgröße anpassen + axis.text = element_text(size = 14), # Achsentextgröße anpassen + legend.title = element_text(size = 18), # Legendentitelgröße anpassen + legend.text = element_text(size = 14), # Legendtextgröße anpassen + strip.text = element_text(size = 18, face = "bold") # Facet-Textgröße anpassen ) # Plot anzeigen print(facet_plot) +save("pax-over-avg-wait-time") + +##################### +##Zusammenhang Durchschnittspreis und Nachfrage + +# Filter für die beiden relevanten Parameter +rides_data <- results %>% + filter(parameter == "Rides") %>% + select(fares, mean) %>% + rename(rides = mean) + +avg_fare_data <- results %>% + filter(parameter == "Avg. fare [MoneyUnit]") %>% + select(fares, mean) %>% + rename(avg_fare = mean) + +# Zusammenführen der Daten +plot_data <- left_join(rides_data, avg_fare_data, by = c("fares")) + +# Erstellen des Plots +fare_vs_rides_plot <- ggplot(plot_data, aes(x = avg_fare, y = rides)) + + geom_point(size = 3) + + geom_text(aes(label = fares), vjust = -1, hjust = 0.5, size = 6, color = "black") + + labs(title = "Anzahl Passagiere nach Durchschnittspreis", + x = "Durchschnittlicher Preis pro Fahrt [€]", + y = "# Passagiere") + + theme( + plot.title = element_text(size = 20, face = "bold"), + axis.title.x = element_text(size = 18), + axis.title.y = element_text(size = 18), + axis.text = element_text(size = 14), + legend.title = element_text(size = 18), + legend.text = element_text(size = 14), + strip.text = element_text(size = 18, face = "bold") + ) + +# Plot anzeigen +print(fare_vs_rides_plot) +save("pax-over-avg-fare")