Zeitreihenanalyse: Bike-Sharing Nachfrage

Portfolio-Arbeit zur Datenanalyse und Vorhersagemodellierung

1 Einleitung

1.1 Zielsetzung der Analyse

Dieser Arbeit analysiere ich den Bike-Sharing Datensatz mittels Zeitreihenanalyse. Ziel ist es, Nutzungsmuster zu identifizieren und Vorhersagemodelle für die zukünftige Nachfrage zu entwickeln.

1.2 Forschungsfragen

1. Welche zeitlichen Muster zeigt die Bike-Sharing Nachfrage?
2. Wie beeinflussen Wetterfaktoren die Nutzung?
3. Welche Forecasting-Methoden eignen sich am besten für die Vorhersage?

2 Datenaufbereitung

Die Chunks für datenimport, setup und test habe ich mit include=FALSE ausgeblendet, damit die Endpräsentation sauberer wirkt – daher beschreibe ich hier meinen Datenimport.

Beim Datenimport in mein R-Studio-Umfeld bin ich in folgenden Schritten vorgegangen:

1. Verbindung zur MySQL-Datenbank aufbauen Zunächst habe ich das Paket RMySQL verwendet, um eine Verbindung zu meiner lokalen MySQL-Datenbank „bike_sharing“ aufzubauen. Mit dbConnect() stelle ich Verbindung über Host, Port, Datenbankname und Anmeldedaten her.

2. Tabelleninhalt einlesen Mittels dbReadTable(con, "bike_sharing") habe ich die gesamte Tabelle „bike_sharing“ in einen Data Frame namens bike_data geladen. Anschließend habe ich die Verbindung mit dbDisconnect(con) geschlossen, um Ressourcen freizugeben.

3. Kurze Daten-Übersicht erzeugen In einem weiteren R-Chunk ermittele ich mit nrow() und ncol(), wie viele Beobachtungen und Variablen im Data Frame enthalten sind, und bestimme mit min() und max() den zeitlichen Bereich (Spalte datetime).

4. Erste Datensätze anzeigen Zur qualitativen Kontrolle zeige ich mit kable(head(bike_data, 5)) die ersten fünf Zeilen des Datensatzes in tabellarischer Form an.

5. Struktur- und Qualitätsprüfung Im abschließenden Setup-Chunk nutze ich erst str(bike_data), um Datentypen und Aufbau der Variablen zu prüfen. Danach berechne ich fehlende Werte pro Spalte mit colSums(is.na(bike_data)). Werden keine NA gefunden, gebe ich eine Erfolgsmeldung aus.

So stelle ich sicher, dass die Daten verlässlich aus der Datenbank geladen werden.

3 Explorative Datenanalyse

3.1 Deskriptive Statistiken

# Zusammenfassende Statistiken für numerische Variablen
numeric_vars <- bike_data %>% 
  select(temp, atemp, humidity, windspeed, casual, registered, count)

summary_stats <- summary(numeric_vars)

kable(summary_stats, caption = "Deskriptive Statistiken der numerischen Variablen") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
                full_width = F,
                position = "center") %>%
  row_spec(0, bold = T, color = "white", background = "#2c3e50") %>%
  kable_styling(font_size = 14)

Deskriptive Statistiken der numerischen Variablen

	temp	atemp	humidity	windspeed	casual	registered	count
	Min. :0.0082	Min. :0.0076	Min. : 2.00	Min. :0.0000000	Min. : 0.00	Min. : 0.0	Min. : 1.0
	1st Qu.:0.1394	1st Qu.:0.1692	1st Qu.: 52.00	1st Qu.:0.0006615	1st Qu.: 4.00	1st Qu.: 36.0	1st Qu.: 43.0
	Median :0.1968	Median :0.2349	Median : 66.00	Median :0.0011001	Median : 12.00	Median : 74.0	Median : 88.0
	Mean :0.2006	Mean :0.2351	Mean : 64.87	Mean :0.0012222	Mean : 26.94	Mean :119.7	Mean :146.7
	3rd Qu.:0.2624	3rd Qu.:0.3068	3rd Qu.: 78.35	3rd Qu.:0.0016998	3rd Qu.: 28.00	3rd Qu.:157.0	3rd Qu.:198.0
	Max. :0.4100	Max. :0.4546	Max. :100.00	Max. :0.0031992	Max. :367.00	Max. :886.0	Max. :977.0

Interpretation: - Die durchschnittliche Anzahl der Fahrten liegt bei 146.7 pro Stunde - Registrierte Nutzer machen den Großteil der Fahrten aus - Die Temperatur variiert zwischen 0.01 und 0.41.

3.2 Zeitreihen-Visualisierung

# Tägliche Aggregation mit saisonalen Features
daily_data <- bike_data %>% 
  mutate(date = as.Date(datetime)) %>% 
  group_by(date) %>% 
  summarise(
    total_count = sum(count),
    avg_temp = mean(temp),
    avg_humidity = mean(humidity),
    .groups = 'drop'
  ) %>%
  mutate(
    # Saisonale Kategorien
    season = case_when(
      month(date) %in% c(12, 1, 2) ~ "Winter",
      month(date) %in% 3:5 ~ "Frühling", 
      month(date) %in% 6:8 ~ "Sommer",
      month(date) %in% 9:11 ~ "Herbst"
    ),
    year = year(date)
  )

# Erweiterte Zeitreihen-Visualisierung
ggplot(daily_data, aes(x = date, y = total_count)) +
  # Saisonale Hintergrund-Bereiche
  geom_rect(data = daily_data %>% 
              filter(season == "Winter") %>%
              summarise(xmin = min(date), xmax = max(date), .by = c(year, season)),
            aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = "Winter"),
            alpha = 0.4, inherit.aes = FALSE) +
  
  geom_rect(data = daily_data %>% 
              filter(season == "Frühling") %>%
              summarise(xmin = min(date), xmax = max(date), .by = c(year, season)),
            aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = "Frühling"),
            alpha = 0.4, inherit.aes = FALSE) +
  
  geom_rect(data = daily_data %>% 
              filter(season == "Sommer") %>%
              summarise(xmin = min(date), xmax = max(date), .by = c(year, season)),
            aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = "Sommer"),
            alpha = 0.4, inherit.aes = FALSE) +
  
  geom_rect(data = daily_data %>% 
              filter(season == "Herbst") %>%
              summarise(xmin = min(date), xmax = max(date), .by = c(year, season)),
            aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = "Herbst"),
            alpha = 0.4, inherit.aes = FALSE) +
  
  # Stärkere saisonale Farbpalette
  scale_fill_manual(
    name = "Jahreszeiten",
    values = c("Winter" = "#B8E0FF",    # Stärkeres Hellblau
               "Frühling" = "#C8F7C5",  # Stärkeres Hellgrün
               "Sommer" = "#FFE135",     # Stärkeres Gelb
               "Herbst" = "#E6C2A6"),    # Stärkeres Sandbraun
    breaks = c("Frühling", "Sommer", "Herbst", "Winter")
  ) +
  
  # Hauptlinie
  geom_line(alpha = 0.8, color = "darkblue", size = 0.6) +
  
  # Trend-Linie
  geom_smooth(method = "loess", se = TRUE, color = "darkred", size = 1.2, alpha = 0.7) +
  
  labs(
    title = "Tägliche Bike-Sharing Nutzung nach Jahreszeiten",
    subtitle = "Saisonale Muster mit Trend-Analyse",
    x = "Datum",
    y = "Anzahl Fahrten pro Tag"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 16, face = "bold"),
    plot.subtitle = element_text(size = 12),
    axis.title = element_text(size = 12),
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "bottom",
    legend.title = element_text(face = "bold")
  ) +
  scale_x_date(date_breaks = "3 months", date_labels = "%b %Y")

Tägliche Bike-Sharing Nutzung über Zeit

Befunde:

• Klaren Saisoneffekt: Tief in Winter (unter 1 000 Fahrten), Frühjahr-Aufschwung, Sommer-Spitzen (5 000–7 500) und Herbst-Rückgang.
• Wachsender Trend: Winter 2012 fast doppelt so viele Fahrten wie Winter 2011; auch Sommerhöchstwerte 2012 liegen spürbar über 2011.
• Hohe Tages-Variabilität, vermutlich wetter- oder eventgetrieben.

3.3 Saisonalitätsanalyse

# Monatliche Analyse mit saisonalen Features
monthly_usage <- bike_data %>% 
  mutate(
    month = month(datetime, label = TRUE),
    season = case_when(
      month(datetime) %in% c(12, 1, 2) ~ "Winter",
      month(datetime) %in% 3:5 ~ "Frühling", 
      month(datetime) %in% 6:8 ~ "Sommer",
      month(datetime) %in% 9:11 ~ "Herbst"
    )
  ) %>% 
  group_by(month, season) %>% 
  summarise(avg_count = mean(count), .groups = 'drop')

# Saisonale Farbpalette 
season_colors <- c("Winter" = "#B8E0FF", "Frühling" = "#C8F7C5", 
                   "Sommer" = "#FFE135", "Herbst" = "#E6C2A6")

p1 <- ggplot(monthly_usage, aes(x = month, y = avg_count, fill = season)) +
  geom_col(alpha = 0.8, color = "white", size = 0.8) +
  scale_fill_manual(values = season_colors, name = "Jahreszeit") +
  
  # Werte auf den Balken anzeigen
  geom_text(aes(label = round(avg_count, 0)), 
            vjust = -0.5, size = 3.5, fontface = "bold") +
  
  labs(
    title = "Durchschnittliche Nutzung nach Monaten",
    subtitle = "Farbkodiert nach Jahreszeiten mit Werten",
    x = "Monat",
    y = "Ø Fahrten pro Stunde"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "top",
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank()
  ) +
  
  # Y-Achse etwas erweitern für die Labels
  scale_y_continuous(expand = expansion(mult = c(0, 0.1)))

# Plots anzeigen
p1

Saisonale Muster in der Nutzung

Interpretation der Saisonalität: - Peak: Peak-Season von Mai bis September, niedrigste Nutzung im Winter - Low: Tiefpunkt im Winter: Jan 66, Feb 79

Herbstlicher Rückgang bis Dez 146

3.4 Wettereinfluss-Analyse

# Hexagonal Binning für bessere Darstellung der Datendichte
bike_data_temp <- bike_data %>%
  mutate(temp_celsius = temp * (39 - (-8)) + (-8))

ggplot(bike_data_temp, aes(x = temp_celsius, y = count)) +
  stat_bin_hex(bins = 25, alpha = 0.8) +
  geom_smooth(method = "lm", se = TRUE, color = "darkred", size = 1.5) +
  scale_fill_viridis_c(name = "Anzahl\nBeobachtungen", trans = "log10") +
  labs(
    title = "Temperatur vs. Bike-Sharing Nutzung (Dichteplot)",
    subtitle = paste("Korrelation:", round(cor(bike_data$temp, bike_data$count), 3)),
    x = "Temperatur (°C)",
    y = "Anzahl Fahrten"
  ) +
  theme_minimal()

Zusammenhang zwischen Wetter und Bike-Sharing Nutzung

Wettereinfluss-Befunde: Der Hexbin-Plot verdeutlicht eine moderat positive Beziehung zwischen Temperatur und Bike-Sharing-Nutzung (r ≈ 0.36):

• Bei sehr niedrigen Temperaturen (< 0 °C) sind Fahrten meist gering (< 200 pro Tag).
• Mit steigender Temperatur verschiebt sich das dichteste Feld (gelb/grün) nach oben: im Bereich 5–10 °C liegen viele Tage bei 200–400 Fahrten.
• Die Regressionslinie zeigt, dass höhere Temperaturen tendenziell mit mehr Fahrten einhergehen, auch wenn die Streuung – etwa um 0 °C oder über 8 °C – relativ groß bleibt.

4 Zeitreihenmodellierung

4.1 Datenaufbereitung für Modellierung

# Prüfe Datenumfang
cat("Verfügbare tägliche Beobachtungen:", nrow(daily_data), "\n")

Verfügbare tägliche Beobachtungen: 719 

# Zeitreihe erstellen - angepasste Frequenz basierend auf Datenmenge
n_days <- nrow(daily_data)

if(n_days < 730) {  # Weniger als 2 Jahre
  ts_daily <- ts(daily_data$total_count, frequency = 7)
  cat("Verwende wöchentliche Frequenz (7 Tage)\n")
} else {
  ts_daily <- ts(daily_data$total_count, 
                 start = c(year(min(daily_data$date)), 1), 
                 frequency = 365.25)
  cat("Verwende jährliche Frequenz (365.25 Tage)\n")
}

Verwende wöchentliche Frequenz (7 Tage)

# Train/Test Split (70/30)
train_size <- floor(0.7 * length(ts_daily))
train_data <- window(ts_daily, end = time(ts_daily)[train_size])
test_data <- window(ts_daily, start = time(ts_daily)[train_size + 1])

cat("Training-Daten:", length(train_data), "Beobachtungen (70%)\n")

Training-Daten: 503 Beobachtungen (70%)

cat("Test-Daten:", length(test_data), "Beobachtungen (30%)\n")

Test-Daten: 216 Beobachtungen (30%)

# Für Random Forest: Dataframe mit Features erstellen
train_df <- daily_data[1:train_size, ]
test_df <- daily_data[(train_size + 1):nrow(daily_data), ]

cat("Random Forest Training-Set:", nrow(train_df), "Tage\n")

Random Forest Training-Set: 503 Tage

cat("Random Forest Test-Set:", nrow(test_df), "Tage\n")

Random Forest Test-Set: 216 Tage

1. Datenumfang und Zeitraum ermitteln Zuerst schau ich, wie viele tägliche Beobachtungen in daily_data vorliegen und welcher Datumsbereich abgedeckt ist.

2. Zeitreihe mit dynamischer Frequenz erstellen Anschließend wird geprüft, ob weniger als zwei Jahre an Daten vorhanden sind.

• Bei unter 730 Tagen setzt der Code die Frequenz auf 7 und interpretiert die Werte als wöchentliche Serie.
• Bei 730 Tagen oder mehr wird eine Jahresfrequenz von 365,25 Tagen verwendet und die Zeitreihe auf das Kalenderjahr des ersten Datums gestartet.

3. Aufteilen in Trainings- und Test-Daten (70/30) Dann splitte ich die Zeitreihe in 70 % für das Training und die restlichen 30 % für den Test.

4. Datenframes für Random Forest vorbereiten Zu letzt wird aus den ursprünglichen Data Frame die gleichen 70 % der Zeilen als Trainings-Set und die verbleibenden 30 % als Test-Set extrahiert, um sie später als Feature-Sets im Random-Forest-Modell zu verwenden.

4.2 Zeitreihen-Diagnose

# Zeitreihen-Plot
plot(train_data, main = "Training-Zeitreihe", ylab = "Tägliche Fahrten")

Zeitreihen-Diagnose

# Saisonalität prüfen - nur wenn genügend Perioden vorhanden
if(length(train_data) >= 2 * frequency(train_data)) {
  
  # Decomposition nur wenn möglich
  tryCatch({
    decomposition <- decompose(train_data)
    plot(decomposition)
  }, error = function(e) {
    cat("Dekomposition nicht möglich:", e$message, "\n")
    cat("Verwende alternative STL-Dekomposition...\n")
    
    # Alternative: STL Decomposition
    if(length(train_data) >= 24) {  # Mindestens 24 Beobachtungen für STL
      stl_decomp <- stl(train_data, s.window = "periodic")
      plot(stl_decomp)
    } else {
      cat("Zu wenige Daten für Saisonalitäts-Analyse\n")
      
      # Einfache Trend-Analyse
      trend_line <- lm(as.numeric(train_data) ~ seq_along(train_data))
      plot(train_data, main = "Zeitreihe mit Trend")
      abline(trend_line, col = "", lwd = 2)
    }
  })
} else {
  cat("Zu wenige Perioden für Dekomposition. Zeige einfachen Plot.\n")
  
  # Einfache Trend-Analyse
  trend_line <- lm(as.numeric(train_data) ~ seq_along(train_data))
  plot(train_data, main = "Zeitreihe mit Trend")
  abline(trend_line, col = "", lwd = 2)
  
  cat("Trend-Koeffizient:", round(coef(trend_line)[2], 4), "\n")
}

Zeitreihen-Diagnose

Zeitreihen-Eigenschaften: - Klarer Trend und saisonale Komponente vorhanden - Varianz scheint über die Zeit zu steigen - Mögliche Transformation erforderlich

4.3 Modellvergleich

5 Modellvergleich: Zeitreihen vs. Machine Learning

5.1 Klassische Zeitreisenmodelle

# Verschiedene Forecasting-Modelle (wie vorher)
h <- length(test_data)

if(h > 0) {
  
  # 1. Naive Forecast
  naive_model <- naive(train_data, h = h)
  
  # 2. Seasonal Naive
  if(frequency(train_data) > 1) {
    snaive_model <- snaive(train_data, h = h)
  } else {
    snaive_model <- naive_model
  }
  
  # 3. ETS Modell
  ets_model <- ets(train_data)
  ets_forecast <- forecast(ets_model, h = h)
  
  # 4. ARIMA Modell
  arima_model <- auto.arima(train_data)
  arima_forecast <- forecast(arima_model, h = h)
  
  cat("✅ Klassische Zeitreisenmodelle erstellt\n")
  
} else {
  cat("⚠️ Keine Test-Daten für klassische Modelle\n")
}

✅ Klassische Zeitreisenmodelle erstellt

5.2 Random Forest Modell

# Einfache Features für Random Forest erstellen
train_simple <- train_df %>%
  mutate(
    month = month(date),
    day_of_week = wday(date),
    day_of_year = yday(date),
    year = year(date)
  ) %>%
  select(total_count, month, day_of_week, day_of_year, year, avg_temp, avg_humidity) %>%
  na.omit()

test_simple <- test_df %>%
  mutate(
    month = month(date),
    day_of_week = wday(date),
    day_of_year = yday(date),
    year = year(date)
  ) %>%
  select(total_count, month, day_of_week, day_of_year, year, avg_temp, avg_humidity) %>%
  na.omit()

# Features für Modell auswählen (ohne Target)
feature_cols <- setdiff(colnames(train_simple), "total_count")

cat("Random Forest Features:", length(feature_cols), "\n")

Random Forest Features: 6 

cat("Training-Samples:", nrow(train_simple), "\n")

Training-Samples: 503 

cat("Test-Samples:", nrow(test_simple), "\n")

Test-Samples: 216 

# Random Forest trainieren
set.seed(123)
rf_model <- randomForest(
  x = train_simple[, feature_cols],
  y = train_simple$total_count,
  ntree = 500,
  importance = TRUE,
  na.action = na.omit
)

# Vorhersagen
rf_predictions <- predict(rf_model, test_simple[, feature_cols])

# Model Summary
print(rf_model)

Call:
 randomForest(x = train_simple[, feature_cols], y = train_simple$total_count,      ntree = 500, importance = TRUE, na.action = na.omit) 
               Type of random forest: regression
                     Number of trees: 500
No. of variables tried at each split: 2

          Mean of squared residuals: 572660.9
                    % Var explained: 81.55

cat("Out-of-Bag Error:", round(tail(rf_model$mse, 1), 2), "\n")

Out-of-Bag Error: 572660.9 

5.3 Feature Importance Analyse

  # Feature Importance extrahieren
  importance_df <- importance(rf_model) %>%
    as.data.frame() %>%
    rownames_to_column("feature") %>%
    arrange(desc(`%IncMSE`)) %>%
    head(15)
  
  # Tabelle der wichtigsten Features
  kable(importance_df[1:10, c("feature", "%IncMSE", "IncNodePurity")], 
        caption = "Top 10 wichtigste Features",
        digits = 2)

Top 10 wichtigste Features

	feature	%IncMSE	IncNodePurity
1	avg_humidity	61.04	349687016
2	day_of_year	47.79	370056935
3	avg_temp	44.53	393019999
4	year	43.56	158541006
5	month	30.30	177675831
6	day_of_week	-8.16	43726437
NA	NA	NA	NA
NA.1	NA	NA	NA
NA.2	NA	NA	NA
NA.3	NA	NA	NA

Feature Importance des Random Forest Modells

5.4 Bestes Modell und Vorhersage

5.5 Umfassender Modellvergleich

# Alle Modelle vergleichen
if(exists("rf_predictions") && exists("naive_model") && length(test_data) > 0) {
  
  # Test-Daten für Vergleich
  actual_values <- as.numeric(test_data)
  
  # Sicherstellen, dass alle Vorhersagen gleiche Länge haben
  min_length <- min(length(actual_values), length(rf_predictions))
  
  if(min_length > 0) {
    
    # Vorhersagen auf gleiche Länge bringen
    actual_test <- actual_values[1:min_length]
    rf_pred <- rf_predictions[1:min_length]
    
    # Klassische Modell-Vorhersagen
    naive_pred <- as.numeric(naive_model$mean)[1:min_length]
    ets_pred <- as.numeric(ets_forecast$mean)[1:min_length]
    arima_pred <- as.numeric(arima_forecast$mean)[1:min_length]
    
    # RMSE und MAE berechnen
    calculate_metrics <- function(pred, actual) {
      rmse <- sqrt(mean((pred - actual)^2, na.rm = TRUE))
      mae <- mean(abs(pred - actual), na.rm = TRUE)
      mape <- mean(abs((actual - pred) / actual) * 100, na.rm = TRUE)
      return(data.frame(RMSE = rmse, MAE = mae, MAPE = mape))
    }
    
    # Alle Modelle bewerten
    final_comparison <- rbind(
      data.frame(Model = "Random Forest", calculate_metrics(rf_pred, actual_test)),
      data.frame(Model = "ARIMA", calculate_metrics(arima_pred, actual_test)),
      data.frame(Model = "ETS", calculate_metrics(ets_pred, actual_test)),
      data.frame(Model = "Naive", calculate_metrics(naive_pred, actual_test))
    )
    
    # Sortieren nach RMSE
    final_comparison <- final_comparison[order(final_comparison$RMSE), ]
    
    kable(final_comparison, 
          caption = "Finaler Modellvergleich (70/30 Split)",
          digits = 2)
    
    # Bestes Modell identifizieren
    best_model_final <- final_comparison$Model[1]
    best_rmse_final <- final_comparison$RMSE[1]
    
    cat("Bestes Modell:", best_model_final, "\n")
    cat("Beste Test-RMSE:", round(best_rmse_final, 2), "\n")
    
  } else {
    cat("Keine vergleichbaren Vorhersagen sind verfügbar")
  }
  
} else {
  cat("Modellvergleich nicht möglich - fehlende Komponenten\n")
}

Bestes Modell: Random Forest 
Beste Test-RMSE: 1898.44 

5.6 Trend-Visualisierung und Validierung

if(exists("final_comparison") && exists("best_model_final")) {
  
  # Daten für Plotting vorbereiten
  plot_data <- data.frame(
    date = test_df$date[1:min_length],
    actual = actual_test,
    rf_pred = rf_pred,
    arima_pred = arima_pred,
    ets_pred = ets_pred,
    naive_pred = naive_pred
  )
  
  # Trend-Plot: Actual vs. Predictions
  p1 <- ggplot(plot_data, aes(x = date)) +
    geom_line(aes(y = actual, color = "Tatsächlich"), size = 1.2) +
    geom_line(aes(y = rf_pred, color = "Random Forest"), size = 1) +
    geom_line(aes(y = arima_pred, color = "ARIMA"), size = 1) +
    geom_line(aes(y = ets_pred, color = "ETS"), size = 1) +
    scale_color_manual(values = c(
      "Tatsächlich" = "darkgrey",
      "Random Forest" = "black",
      "ARIMA" = "blue", 
      "ETS" = "darkred"
    )) +
    labs(
      title = "Modellvergleich: Vorhersagen vs. Tatsächliche Werte",
      subtitle = paste("Bestes Modell:", best_model_final),
      x = "Datum",
      y = "Anzahl Fahrten pro Tag",
      color = "Modell"
    ) +
    theme_minimal() +
    theme(legend.position = "bottom")
  
  print(p1)
  
  # Residuen-Analyse für bestes Modell
  if(best_model_final == "Random Forest") {
    residuals <- actual_test - rf_pred
  } else if(best_model_final == "ARIMA") {
    residuals <- actual_test - arima_pred
  } else if(best_model_final == "ETS") {
    residuals <- actual_test - ets_pred
  } else {
    residuals <- actual_test - naive_pred
  }
  
  # Residuen-Statistiken
  cat("Residuen-Statistiken für", best_model_final, ":\n")
  cat("Mittelwert:", round(mean(residuals, na.rm = TRUE), 2), "\n")
  cat("Standardabweichung:", round(sd(residuals, na.rm = TRUE), 2), "\n")
  cat("Min:", round(min(residuals, na.rm = TRUE), 2), "\n")
  cat("Max:", round(max(residuals, na.rm = TRUE), 2), "\n")
  
} else {
  cat("🚫 Trend-Validierung nicht möglich\n")
}

Vorhersage vs. Tatsächliche Werte - Trend-Validierung

Residuen-Statistiken für Random Forest :
Mittelwert: -19.68 
Standardabweichung: 1902.75 
Min: -4222.86 
Max: 3158.62 

5.7 Modell-Limitationen

• Kurze Zeitspanne: Nur 2 Jahre Daten (2011-2012) Fehlende Faktoren: Events, Infrastrukturänderungen, Feiertage nicht berücksichtigt
• Hohe Residualvarianz: Standardabweichung 1.902 deutet auf unerfasste Einflüsse
• Black Box: Random Forest bietet begrenzte Interpretierbarkeit

6 Ergebnisse und Interpretation

Wichtigste Einflussfaktoren

• Luftfeuchtigkeit: (61,04%) - Stärkster Prädiktor
• Tag des Jahres: (47,79%) - Saisonale Komponente
• Temperatur: (44,53%) - Wettereinfluss
• Jahr: (43,56%) - Langzeittrend

Saisonale Dynamik

• Sommer: Höchste Nutzung (Juni-August)
• Winter: Drastischer Rückgang (50% weniger als Sommer)
• Temperaturkorrelation: r = 0.361 (moderate positive Korrelation)

6.1 Zusammenfassung

Das Modell bestätigt die dominante Rolle von Wetter und Saisonalität. Mit RMSE 1.898 ist es für operative Planung geeignet, zeigt aber noch Verbesserungspotential. Das Random Forest Modell erzielte die beste Performance mit RMSE 1.898 und 81,55% Varianzaufklärung.

---