Grafische Analyse

gf_point(Purchase ~ Price, data = Milk)

Die grafische Analyse über das Streudiagramm zeigt einen fallenden Verlauf (je höher der Preis, desto geringer der Anteil der Leute, die das Produkt kaufen würden) als auch Sprungstellen.

Kennzahlen

Die Korrelationskoeffizienten nach Pearson und auch Spearman bestätigen den optischen Eindruck, wobei die Rangkorrelation (Spearman) größer ist:

cor(Purchase ~ Price, data = Milk, method ="pearson")

## [1] -0.9399529

cor(Purchase ~ Price, data = Milk, method ="spearman")

## [1] -0.9847357

Linear

Über den ganzen Wertebereich ist eine lineare Modellierung nicht sinnvoll:

linear1 <- lm(Purchase ~ Price, data = Milk)
gf_point(Purchase ~ Price, data = Milk) %>%
  gf_line(fitted(linear1) ~ Milk$Price)

Hinweis: Die über den gesamten Wertebereich von \(x\) nicht angemessene lineare Modellierung erkennt man auch am Muster im Residualplot:

gf_point(resid(linear1) ~ fitted(linear1))

Eine lokale Anpassung für den Bereich von \(0.89\) bis \(1.59\):

Milk2 <- Milk %>%
  filter(0.89<=Price & Price<=1.59)

linear2 <- lm(Purchase ~ Price, data = Milk2)
gf_point(Purchase ~ Price, data = Milk2) %>%
  gf_line(fitted(linear2) ~ Milk2$Price)

summary(linear2)

## 
## Call:
## lm(formula = Purchase ~ Price, data = Milk2)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -4.000 -1.896  0.375  1.771  4.417 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  183.358      6.183   29.66 9.75e-08 ***
## Price       -105.833      4.903  -21.59 6.45e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.178 on 6 degrees of freedom
## Multiple R-squared:  0.9873, Adjusted R-squared:  0.9852 
## F-statistic: 465.9 on 1 and 6 DF,  p-value: 6.454e-07

Innerhalb des Wertebereiches zwischen \(0.89\)€ und \(1.59\)€ gilt als Schätzgleichung:

\[\hat{y}=183.36 - 105.83\cdot x\]

D. h., pro \(0.10\)€ wird in diesem Wertebereich ein Rückgang des Mittelwertes der Zahlungsbereitschaft um 10.58\(\%\) beobachtet. Eine Extrapolation sollte nicht erfolgen. Allerdings ist in diesem Bereich die Anpassung sehr gut: \(R^2=0.987\).

Die Nullhypothese “Es gibt keinen linearen Zusammenhang zwischen Preis und Absatz”, d. h. \(H_0: \beta_P=0\) wird mit einem P-Wert von \(6.4541138\times 10^{-7}\) verworfen (\(\alpha=0.001\)).

Multiplikativ

Über den ganzen Wertebereich ist auch eine multiplikative Modellierung nicht sinnvoll:

multi1 <- lm(log(Purchase) ~ log(Price), data = Milk)
gf_point(Purchase ~ Price, data = Milk) %>%
  gf_line(exp(fitted(multi1)) ~ Milk$Price)

Eine Anpassung im Wertebereich \(1.09\) bis \(2.99\) sieht wie folgt aus:

Milk2 <- Milk %>%
  filter(1.09<=Price & Price<=2.99)

multi2 <- lm(log(Purchase) ~ log(Price), data = Milk2)
gf_point(Purchase ~ Price, data = Milk2) %>%
  gf_line(exp(fitted(multi2)) ~ Milk2$Price)

summary(multi2)

## 
## Call:
## lm(formula = log(Purchase) ~ log(Price), data = Milk2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.9922 -0.3535  0.1002  0.3392  0.6059 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   5.0154     0.2580   19.44 1.57e-13 ***
## log(Price)   -5.1324     0.3514  -14.61 2.01e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4722 on 18 degrees of freedom
## Multiple R-squared:  0.9222, Adjusted R-squared:  0.9179 
## F-statistic: 213.3 on 1 and 18 DF,  p-value: 2.012e-11

In diesem Bereich gilt in diesem Modell:

\[\hat{y}=e^{5.02}\cdot x^{-5.13}\] D. h., die geschätzte Preiselastizität der Nachfrage liegt hier bei \(-5.13\). Auch hier ist die Anpassung gut: in diesem Bereich werden auf logarithmischer Skala \(R^2=0.922\) der Variation der Nachfrage modelliert¹ und \(H_0: \beta_P=0\) wird verworfen (\(\alpha=0.001\)).

Ausblick

Eine flexible Alternative ist die Spline Regression. Hier wird der Wertebereich von \(x\) in Intervalle aufgeteilt und innerhalb dieser Intervalle werden Polynome angepasst, wobei die Übergänge geglättet werden, siehe z. B. (James et al. 2013).

# Paket laden
library(splines)

splines <- lm(Purchase ~ bs(Price, 
                            knots=quantile(Price, probs=c(0.25, 0.50, 0.75)), 
                            degree=3), 
              data=Milk)

gf_point(Purchase ~ Price, data = Milk) %>%
  gf_line(fitted(splines) ~ Milk$Price)

Die Interpretation der Koeffizienten (vgl. summary(splines)) ist schwierig. Aber man kann erkennen, dass die Anpassung über den ganzen Wertebereich gut ist: \(R^2=0.997\).