Statistik 3: Übung

Lineare und polynomische Regression

Aufgabenbeschreibung

In R gibt es zahlreiche eingebaute Datensätze. Diese sind direkt in R verfügbar und können ohne zusätzliche Downloads oder Installationen genutzt werden. In dieser Übung verwenden wir den Datensatz LifeCycleSavings. Du kannst den Datensatz z.B. mit folgendem Befehl als Objekt laden:

DataUebung3 <- LifeCycleSavings

Der Datensatz enthält Informationen über die Sparquoten in 50 Ländern:

  • sr Sparquote (Savings Ratio; Anteil des Einkommens der gespart wird in Prozent)

  • pop15 Prozentsatz der Bevölkerung unter 15 Jahren

  • pop75 Prozentsatz der Bevölkerung über 75 Jahren

  • dpi Pro-Kopf-Einkommen

Du sollst nun untersuchen, ob und wie Sparquote von den anderen drei Variablen abhängt. Teste für jede erklärende Variable einzeln auf lineare und quadratische Zusammenhänge. Stelle die Ergebnisse grafisch dar und verfasse einen ausformulierten Methoden- und Ergebnisteil.

Lösung Übung 3

Demoscript herunterladen (.R)

Demoscript herunterladen (.qmd)

R-Session vorbereiten

library(ggplot2)
library(patchwork)

Daten anschauen

p1 <- ggplot(LifeCycleSavings, aes(x = pop15, y = sr)) +
  geom_point()
p2 <- ggplot(LifeCycleSavings, aes(x = pop75, y = sr)) +
  geom_point()
p3 <- ggplot(LifeCycleSavings, aes(x = dpi, y = sr)) +
  geom_point()

p1+p2+p3

-> Zusammenhänge sind zu erahnen, aber die Streuung ist gross.

Modelle erstellen

lm_pop15 <- lm(sr ~ pop15 , data = LifeCycleSavings ) # Einfaches lineares Modell
lm_q_pop15 <- lm(sr ~ pop15 + I(pop15^2),  data = LifeCycleSavings) # Modell mit quadratischem Term


lm_pop75 <- lm(sr ~ pop75, data = LifeCycleSavings ) # Einfaches lineares Modell
lm_q_pop75 <- lm(sr ~ pop75 + I(pop75^2),  data = LifeCycleSavings) # Modell mit quadratischem Term

lm_dpi <- lm(sr ~ dpi , data = LifeCycleSavings ) # Einfaches lineares Modell
lm_q_dpi <- lm(sr ~ dpi + I(dpi^2),  data = LifeCycleSavings) # Modell mit quadratischem Term

Modell-Outputs anschauen

lm_pop15 |> summary()

Call:
lm(formula = sr ~ pop15, data = LifeCycleSavings)

Residuals:
   Min     1Q Median     3Q    Max 
-8.637 -2.374  0.349  2.022 11.155 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 17.49660    2.27972   7.675 6.85e-10 ***
pop15       -0.22302    0.06291  -3.545 0.000887 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.03 on 48 degrees of freedom
Multiple R-squared:  0.2075,    Adjusted R-squared:  0.191 
F-statistic: 12.57 on 1 and 48 DF,  p-value: 0.0008866
lm_q_pop15 |> summary()

Call:
lm(formula = sr ~ pop15 + I(pop15^2), data = LifeCycleSavings)

Residuals:
    Min      1Q  Median      3Q     Max 
-8.2918 -2.6062  0.2732  1.8186 11.0642 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)
(Intercept) 22.399363  13.358692   1.677    0.100
pop15       -0.522473   0.806247  -0.648    0.520
I(pop15^2)   0.004268   0.011455   0.373    0.711

Residual standard error: 4.067 on 47 degrees of freedom
Multiple R-squared:  0.2098,    Adjusted R-squared:  0.1762 
F-statistic: 6.241 on 2 and 47 DF,  p-value: 0.003946

-> Ein linearer negativer Zusammenhang ist vorhanden.

-> Kein quadratischer Zusammenhang.

lm_pop75 |> summary() 

Call:
lm(formula = sr ~ pop75, data = LifeCycleSavings)

Residuals:
    Min      1Q  Median      3Q     Max 
-9.2657 -3.2295  0.0543  2.3336 11.8498 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   7.1517     1.2475   5.733  6.4e-07 ***
pop75         1.0987     0.4753   2.312   0.0251 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.294 on 48 degrees of freedom
Multiple R-squared:  0.1002,    Adjusted R-squared:  0.08144 
F-statistic: 5.344 on 1 and 48 DF,  p-value: 0.02513
lm_q_pop75 |> summary() 

Call:
lm(formula = sr ~ pop75 + I(pop75^2), data = LifeCycleSavings)

Residuals:
    Min      1Q  Median      3Q     Max 
-9.6125 -3.2081  0.1644  2.2641 11.5023 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)  
(Intercept)   5.9658     2.4752   2.410   0.0199 *
pop75         2.3997     2.3879   1.005   0.3201  
I(pop75^2)   -0.2608     0.4690  -0.556   0.5808  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.325 on 47 degrees of freedom
Multiple R-squared:  0.1061,    Adjusted R-squared:  0.06803 
F-statistic: 2.788 on 2 and 47 DF,  p-value: 0.07172

-> Ein linearer postiviver Zusammenhang ist vorhanden.

-> Kein quadratischer Zusammenhang.

lm_dpi |> summary()

Call:
lm(formula = sr ~ dpi, data = LifeCycleSavings)

Residuals:
    Min      1Q  Median      3Q     Max 
-9.1915 -3.6215  0.4418  2.8304 11.2790 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 8.5682306  0.9414690   9.101 5.04e-12 ***
dpi         0.0009964  0.0006366   1.565    0.124    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.416 on 48 degrees of freedom
Multiple R-squared:  0.04856,   Adjusted R-squared:  0.02874 
F-statistic:  2.45 on 1 and 48 DF,  p-value: 0.1241
lm_q_dpi |> summary() 

Call:
lm(formula = sr ~ dpi + I(dpi^2), data = LifeCycleSavings)

Residuals:
    Min      1Q  Median      3Q     Max 
-10.663  -2.488   0.032   2.535  11.071 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  6.786e+00  1.207e+00   5.623 9.98e-07 ***
dpi          5.263e-03  2.008e-03   2.620   0.0118 *  
I(dpi^2)    -1.344e-06  6.028e-07  -2.230   0.0305 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.243 on 47 degrees of freedom
Multiple R-squared:  0.1396,    Adjusted R-squared:  0.103 
F-statistic: 3.813 on 2 and 47 DF,  p-value: 0.02919

-> Kein einfacher linearer Zusammenhang.

-> Ein quadratischer Zusammenhang ist vorhanden.

Modeldiagnostik

# Residualplots
par(mfrow = c(2, 2))
plot(lm_pop15)

plot(lm_q_pop15)

plot(lm_q_dpi)

Darstellung der Ergebnisse

# Erstellen der Plots
p1 <- ggplot(LifeCycleSavings, aes(x = pop15, y = sr)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
  labs(x = "% der Bevölkerung < 15 Jahre",
       y = "Sparquote") +
  theme_classic()

p2 <- ggplot(LifeCycleSavings, aes(x = pop75, y = sr)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
  labs(x = "% der Bevölkerung > 75 Jahren",
       y = "Sparquote") +
  theme_classic()

p3 <- ggplot(LifeCycleSavings, aes(x = dpi, y = sr)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x + I(x^2), se = FALSE) +
  labs(x = "Pro-Kopf-Einkommen",
       y = "Sparquote") +
  theme_classic()

p1 + p2 + p3