# 1. Daten simulieren --------------------------------------------------
# Heterogenitätstest eignes Beispiel
set.seed(42)
n <- 2000
# Zufällige Gruppenzuteilung
banner_side <- sample(c("left", "right"), n, replace = TRUE)
handedness <- sample(c("left", "right"), n, replace = TRUE)
# Dummy-Variablen
banner_right <- ifelse(banner_side == "right", 1, 0)
is_right_handed <- ifelse(handedness == "right", 1, 0)
# Logit: Nur Rechtshänder mit Banner rechts bekommen Vorteil
logit <- -2.2 + 1.0 * banner_right * is_right_handed
# Wahrscheinlichkeit berechnen
p <- 1 / (1 + exp(-logit))
# Conversion simulieren
conversion <- rbinom(n, 1, p)
# Dataframe zusammenbauen
df <- data.frame(conversion, banner_right, is_right_handed)
# 2. Logistische Regression ---------------------------------------------
model <- glm(conversion ~ banner_right * is_right_handed, data = df, family = binomial)
# 3. Modellzusammenfassung ---------------------------------------------
summary(model) # Log-Odds (β-Koeffizienten)
##
## Call:
## glm(formula = conversion ~ banner_right * is_right_handed, family = binomial,
## data = df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.20149 0.14613 -15.065 < 2e-16 ***
## banner_right -0.09017 0.21280 -0.424 0.671768
## is_right_handed 0.22049 0.20080 1.098 0.272181
## banner_right:is_right_handed 0.96702 0.27449 3.523 0.000427 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1612.6 on 1999 degrees of freedom
## Residual deviance: 1552.5 on 1996 degrees of freedom
## AIC: 1560.5
##
## Number of Fisher Scoring iterations: 4
exp(coef(model)) # Odds Ratios
## (Intercept) banner_right
## 0.1106383 0.9137786
## is_right_handed banner_right:is_right_handed
## 1.2466843 2.6300845
#Ergebnis: sowohl "banner_right" als auch "is_right_handed" sind laut p<Wert nicht signifikant jedoch aber
# der Interaktionskoeffizient -> bedeutet: Wenn jemand die Werbung rechts gesehen hat und rechts händer
# ist, macht er ehr eine conversation -> Heterogenität für "rechts rechts". Die odds wahrscheinlichkeit
# für "rechts rechts" ist mehr als 2,6 mal so groß als für links Händer auf der linken Seite
# 4. Konfidenzintervalle für Odds Ratios -------------------------------
exp(confint(model)) # 95%-CI für Odds Ratios (optional: confint.default())
## Waiting for profiling to be done...
## 2.5 % 97.5 %
## (Intercept) 0.08212602 0.1458125
## banner_right 0.60056207 1.3863003
## is_right_handed 0.84154708 1.8523469
## banner_right:is_right_handed 1.53877017 4.5194012
# 5. Wahrscheinlichkeit manuell berechnen ------------------------------
summary(df)
## conversion banner_right is_right_handed
## Min. :0.000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.000 Median :0.0000 Median :0.0000
## Mean :0.139 Mean :0.4915 Mean :0.4885
## 3rd Qu.:0.000 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :1.000 Max. :1.0000 Max. :1.0000
head(df)
## conversion banner_right is_right_handed
## 1 0 0 0
## 2 1 0 1
## 3 0 0 0
## 4 0 0 0
## 5 0 1 1
## 6 0 1 1
a <- table(df$conversion, df$banner_right)
a
##
## 0 1
## 0 905 817
## 1 112 166
prop.table(a, margin = 1)
##
## 0 1
## 0 0.5255517 0.4744483
## 1 0.4028777 0.5971223
b <-table(df$conversion, df$is_right_handed)
b
##
## 0 1
## 0 925 797
## 1 98 180
prop.table(b, margin = 1)
##
## 0 1
## 0 0.5371661 0.4628339
## 1 0.3525180 0.6474820
c <- mean(df$conversion[df$banner_right == 1])
c
## [1] 0.1688708
d <- mean(df$conversion[df$banner_right == 0])
d
## [1] 0.1101278
ATE <- c-d
ATE
## [1] 0.05874298
Nullhypothese <- glm(conversion ~ banner_right, family = binomial, data = df)
summary(Nullhypothese)
##
## Call:
## glm(formula = conversion ~ banner_right, family = binomial, data = df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.0894 0.1002 -20.860 < 2e-16 ***
## banner_right 0.4958 0.1315 3.771 0.000162 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1612.6 on 1999 degrees of freedom
## Residual deviance: 1598.1 on 1998 degrees of freedom
## AIC: 1602.1
##
## Number of Fisher Scoring iterations: 4
exp(coef(Nullhypothese))
## (Intercept) banner_right
## 0.1237569 1.6417861
#Ergebnis: Da der Banner auf der rechten Seite die Klickrate um ca. 5.87
# Prozentpunkte erhöht und der Effekt statistisch signifikant ist (p < 0.001),
# empfehle ich, den Banner auf die rechte Seite zu verschieben, sofern keine Umstellungskosten bestehen.
# Die Chancen (Odds) auf Klick sind bei rechtem Banner 64% höher als bei linkem Banner
f <- mean(c(df$conversion[df$banner_right == 1 & df$is_right_handed == 1]))
f
## [1] 0.2489627
g <- mean(c(df$conversion[df$banner_right == 1 & df$is_right_handed == 0]))
g
## [1] 0.09181637
h <- mean(c(df$conversion[df$banner_right == 0 & df$is_right_handed == 0]))
h
## [1] 0.09961686