Σε αυτή την εργασία εξετάζουμε αν μια νέα διαφημιστική καμπάνια αυξάνει πραγματικά τις μετατροπές (conversions) ή αν οποιαδήποτε διαφορά που παρατηρούμε είναι απλώς τυχαία. Για να το απαντήσουμε αυτό χρησιμοποιούμε A/B testing — μια μέθοδο που μας επιτρέπει να συγκρίνουμε δύο ομάδες χρηστών υπό ελεγχόμενες συνθήκες.
Ξεκινάμε δημιουργώντας φανταστικά δεδομένα όπου γνωρίζουμε εκ των προτέρων την αλήθεια: η νέα διαφήμιση αυξάνει το conversion rate κατά 2 ποσοστιαίες μονάδες (από 8% σε 10%). Στόχος είναι να δούμε αν η στατιστική ανάλυση καταφέρνει να το ανιχνεύσει.
# Μεγέθη ομάδων και πιθανότητες μετατροπής
n_ctrl <- 8000
n_trt <- 8000
p_ctrl <- 0.08
p_trt <- 0.10
# Δημιουργία dataset με rbinom για 0/1 αποτελέσματα
sim_data <- tibble(
user_id = seq_len(n_ctrl + n_trt),
group = c(rep("control", n_ctrl), rep("treatment", n_trt)),
converted = c(
rbinom(n_ctrl, size = 1, prob = p_ctrl),
rbinom(n_trt, size = 1, prob = p_trt)
)
)
glimpse(sim_data)## Rows: 16,000
## Columns: 3
## $ user_id <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 1…
## $ group <chr> "control", "control", "control", "control", "control", "cont…
## $ converted <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, …
Κάθε χρήστης παράγει ένα αποτέλεσμα 0 ή 1 (αγόρασε ή όχι). Χρησιμοποιούμε
rbinom(n, 1, p)γιατί μοντελοποιεί ακριβώς αυτή την κατάσταση — n ανεξάρτητες δοκιμές με πιθανότητα επιτυχίας p.
stats_sim <- sim_data |>
group_by(group) |>
summarise(
n = n(),
conversions = sum(converted),
rate = mean(converted),
se = sqrt(rate * (1 - rate) / n),
lower_95 = rate - 1.96 * se,
upper_95 = rate + 1.96 * se,
.groups = "drop"
)
knitr::kable(stats_sim, digits = 4,
caption = "Πίνακας 1: Αποτελέσματα Simulated A/B Test")| group | n | conversions | rate | se | lower_95 | upper_95 |
|---|---|---|---|---|---|---|
| control | 8000 | 677 | 0.0846 | 0.0031 | 0.0785 | 0.0907 |
| treatment | 8000 | 764 | 0.0955 | 0.0033 | 0.0891 | 0.1019 |
ggplot(stats_sim, aes(x = group, y = rate, fill = group)) +
geom_col(width = 0.45, alpha = 0.8) +
geom_errorbar(aes(ymin = lower_95, ymax = upper_95),
width = 0.12, linewidth = 1) +
geom_label(aes(label = percent(rate, accuracy = 0.01)),
vjust = -0.5, size = 4.5, fill = "white") +
scale_y_continuous(labels = percent, limits = c(0, 0.15)) +
scale_fill_manual(values = c("control" = "#94a3b8",
"treatment" = "#0ea5e9")) +
labs(x = NULL, y = "Conversion Rate",
title = "Simulated A/B Test",
subtitle = "95% Διαστήματα Εμπιστοσύνης") +
theme_minimal(base_size = 12) +
theme(legend.position = "none",
plot.title = element_text(face = "bold"))Σχήμα 1: Conversion rate ανά ομάδα (προσομοίωση)
Χρησιμοποιούμε prop.test() για να ελέγξουμε αν η διαφορά
μεταξύ των δύο ομάδων είναι στατιστικά σημαντική.
res_sim <- prop.test(
x = c(stats_sim$conversions[stats_sim$group == "control"],
stats_sim$conversions[stats_sim$group == "treatment"]),
n = c(stats_sim$n[stats_sim$group == "control"],
stats_sim$n[stats_sim$group == "treatment"]),
correct = FALSE
)
res_sim##
## 2-sample test for equality of proportions without continuity correction
##
## data: c(stats_sim$conversions[stats_sim$group == "control"], stats_sim$conversions[stats_sim$group == "treatment"]) out of c(stats_sim$n[stats_sim$group == "control"], stats_sim$n[stats_sim$group == "treatment"])
## X-squared = 5.7725, df = 1, p-value = 0.01628
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.019744875 -0.002005125
## sample estimates:
## prop 1 prop 2
## 0.084625 0.095500
Υπολογίζουμε χειρωνακτικά το διάστημα εμπιστοσύνης για τη διαφορά των
δύο αναλογιών, για να επαληθεύσουμε το αποτέλεσμα του
prop.test().
conv_c <- stats_sim$conversions[stats_sim$group == "control"]
conv_t <- stats_sim$conversions[stats_sim$group == "treatment"]
n_c <- stats_sim$n[stats_sim$group == "control"]
n_t <- stats_sim$n[stats_sim$group == "treatment"]
r_c <- stats_sim$rate[stats_sim$group == "control"]
r_t <- stats_sim$rate[stats_sim$group == "treatment"]
# Pooled εκτίμηση
p_hat <- (conv_c + conv_t) / (n_c + n_t)
se_hat <- sqrt(p_hat * (1 - p_hat) * (1/n_c + 1/n_t))
d <- r_t - r_c
me <- 1.96 * se_hat
cat("--- Χειρωνακτικός Υπολογισμός ---\n")## --- Χειρωνακτικός Υπολογισμός ---
## Pooled p̂ = 0.09006
## Pooled SE = 0.00453
## δ = 0.01087
## 95% CI = [0.00200, 0.01975]
##
## --- Από prop.test() ---
## 95% CI = [0.00201, 0.01974]
Τα δύο CI ταυτίζονται, όπως αναμένεται. Η μικρή διαφορά κατεύθυνσης (πρόσημο) οφείλεται στο ότι το
prop.test()υπολογίζει p_control − p_treatment, ενώ εμείς p_treatment − p_control.
h <- ES.h(p1 = p_trt, p2 = p_ctrl)
pwr_result <- pwr.2p.test(
h = h,
sig.level = 0.05,
power = 0.80,
alternative = "two.sided"
)
pwr_result##
## Difference of proportion power calculation for binomial distribution (arcsine transformation)
##
## h = 0.069988
## n = 3204.715
## sig.level = 0.05
## power = 0.8
## alternative = two.sided
##
## NOTE: same sample sizes
##
## Cohen's h = 0.0700
## Απαιτούμενο n = 3205 ανά ομάδα
## Τρέξαμε = 8000 ανά ομάδα
# Επιτευχθέν power
ach <- pwr.2p.test(h = h, n = n_ctrl, sig.level = 0.05)$power
cat(sprintf("Επιτευχθέν power = %.1f%%\n", ach * 100))## Επιτευχθέν power = 99.3%
Για να ανιχνεύσουμε διαφορά 2% με power 80%, χρειαζόμαστε περίπου 3205 άτομα ανά ομάδα. Τρέξαμε 8.000 — δηλαδή το πείραμα ήταν αρκετά overpowered, με επιτευχθέν power ~100%. Αυτό σημαίνει σχεδόν μηδενική πιθανότητα να χάσουμε ένα πραγματικό effect.
ads <- read_csv("marketing_AB.csv") |>
clean_names() |>
mutate(
group = factor(test_group, levels = c("psa", "ad")),
converted = as.integer(converted)
)
glimpse(ads)## Rows: 588,101
## Columns: 8
## $ x1 <dbl> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16…
## $ user_id <dbl> 1069124, 1119715, 1144181, 1435133, 1015700, 1137664, 11…
## $ test_group <chr> "ad", "ad", "ad", "ad", "ad", "ad", "ad", "ad", "ad", "a…
## $ converted <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,…
## $ total_ads <dbl> 130, 93, 21, 355, 276, 734, 264, 17, 21, 142, 209, 47, 6…
## $ most_ads_day <chr> "Monday", "Tuesday", "Tuesday", "Tuesday", "Friday", "Sa…
## $ most_ads_hour <dbl> 20, 22, 18, 10, 14, 10, 13, 18, 19, 14, 11, 13, 20, 13, …
## $ group <fct> ad, ad, ad, ad, ad, ad, ad, ad, ad, ad, ad, ad, ad, ad, …
Πριν εξετάσουμε τα αποτελέσματα, ελέγχουμε αν η κατανομή των χρηστών στις ομάδες είναι λογική.
# Αναλογία ομάδων
ads |>
count(group) |>
mutate(ποσοστό = percent(n / sum(n), accuracy = 0.1)) |>
knitr::kable(caption = "Πίνακας 2: Μέγεθος ομάδων")| group | n | ποσοστό |
|---|---|---|
| psa | 23524 | 4.0% |
| ad | 564577 | 96.0% |
Οι ομάδες είναι πολύ ανισόρροπες: ~96% “ad” και ~4% “psa”. Αυτό δεν ακυρώνει την ανάλυση αλλά σημαίνει ότι οι εκτιμήσεις για την ομάδα psa έχουν μεγαλύτερο σφάλμα λόγω μικρού δείγματος.
day_lvls <- c("Monday","Tuesday","Wednesday","Thursday",
"Friday","Saturday","Sunday")
ads |>
mutate(most_ads_day = factor(most_ads_day, levels = day_lvls)) |>
count(group, most_ads_day) |>
group_by(group) |>
mutate(pct = n / sum(n)) |>
ggplot(aes(x = most_ads_day, y = pct, fill = group)) +
geom_col(position = "dodge", alpha = 0.8) +
scale_y_continuous(labels = percent) +
scale_fill_manual(values = c("psa" = "#94a3b8", "ad" = "#0ea5e9")) +
labs(title = "Invariant Check: Κατανομή ανά ημέρα",
x = NULL, y = "% εντός ομάδας", fill = NULL) +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 35, hjust = 1))Σχήμα 2: Κατανομή ανά ημέρα — έλεγχος τυχαιοποίησης
Η κατανομή ανά ημέρα είναι παρόμοια μεταξύ ομάδων — η τυχαιοποίηση φαίνεται να λειτούργησε σωστά.
ads_sum <- ads |>
group_by(group) |>
summarise(
n = n(),
conversions = sum(converted),
rate = mean(converted),
se = sqrt(rate * (1 - rate) / n),
lower_95 = rate - 1.96 * se,
upper_95 = rate + 1.96 * se,
.groups = "drop"
)
knitr::kable(ads_sum, digits = 5,
caption = "Πίνακας 3: Conversion Rate ανά ομάδα (πραγματικά δεδομένα)")| group | n | conversions | rate | se | lower_95 | upper_95 |
|---|---|---|---|---|---|---|
| psa | 23524 | 420 | 0.01785 | 0.00086 | 0.01616 | 0.01955 |
| ad | 564577 | 14423 | 0.02555 | 0.00021 | 0.02513 | 0.02596 |
test_ads <- prop.test(
x = ads_sum$conversions,
n = ads_sum$n,
correct = FALSE
)
broom::tidy(test_ads) |>
select(estimate1, estimate2, statistic, p.value, conf.low, conf.high) |>
knitr::kable(digits = 6,
caption = "Πίνακας 4: Αποτελέσματα prop.test()")| estimate1 | estimate2 | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|
| 0.017854 | 0.025547 | 54.31805 | 0 | -0.009434 | -0.005951 |
ads_day <- ads |>
mutate(most_ads_day = factor(most_ads_day, levels = day_lvls)) |>
group_by(most_ads_day, group) |>
summarise(
n = n(),
rate = mean(converted),
se = sqrt(rate * (1 - rate) / n),
.groups = "drop"
)
ggplot(ads_day, aes(x = most_ads_day, y = rate,
color = group, group = group)) +
geom_ribbon(aes(ymin = rate - 1.96*se,
ymax = rate + 1.96*se,
fill = group),
alpha = 0.12, color = NA) +
geom_line(linewidth = 1.3) +
geom_point(size = 3.5) +
scale_y_continuous(labels = percent_format(accuracy = 0.1)) +
scale_color_manual(values = c("psa" = "#94a3b8", "ad" = "#0ea5e9")) +
scale_fill_manual(values = c("psa" = "#94a3b8", "ad" = "#0ea5e9")) +
labs(title = "Conversion Rate ανά ημέρα εβδομάδας",
subtitle = "Με 95% διαστήματα εμπιστοσύνης",
x = NULL, y = "Conversion Rate",
color = NULL, fill = NULL) +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 35, hjust = 1))Σχήμα 3: Conversion rate ανά ημέρα με 95% CI
ads_day |>
select(most_ads_day, group, rate) |>
pivot_wider(names_from = group, values_from = rate) |>
mutate(διαφορά = ad - psa) |>
arrange(desc(διαφορά)) |>
knitr::kable(digits = 4,
caption = "Πίνακας 5: Διαφορά conversion rate ανά ημέρα")| most_ads_day | psa | ad | διαφορά |
|---|---|---|---|
| Tuesday | 0.0144 | 0.0304 | 0.0160 |
| Monday | 0.0226 | 0.0332 | 0.0107 |
| Wednesday | 0.0158 | 0.0254 | 0.0096 |
| Saturday | 0.0140 | 0.0213 | 0.0073 |
| Friday | 0.0163 | 0.0225 | 0.0062 |
| Sunday | 0.0206 | 0.0246 | 0.0040 |
| Thursday | 0.0202 | 0.0216 | 0.0014 |
Η μεγαλύτερη διαφορά μεταξύ των ομάδων εμφανίζεται Τρίτη και Δευτέρα. Αυτό υποδηλώνει ότι η διαφήμιση αποδίδει καλύτερα στις αρχές της εβδομάδας.
d_min <- 0.005
p_ad <- ads_sum$rate[ads_sum$group == "ad"]
p_psa <- ads_sum$rate[ads_sum$group == "psa"]
abs_lift <- p_ad - p_psa
rel_lift <- abs_lift / p_psa * 100
tidy_ads <- broom::tidy(test_ads)
ci_lo <- -tidy_ads$conf.high
ci_hi <- -tidy_ads$conf.low
cat("===========================================\n")## ===========================================
## ΕΠΙΧΕΙΡΗΜΑΤΙΚΗ ΑΠΟΦΑΣΗ
## ===========================================
## Conv. rate PSA (control): 1.7854%
## Conv. rate AD (treatment): 2.5547%
## Absolute lift: +0.7692 pp
## Relative lift: +43.1%
## 95% CI για διαφορά: [0.00595, 0.00943]
## p-value: 1.71e-13
## Κατώφλι επιχ. ουσίας: 0.005
## -------------------------------------------
## Περίπτωση A: CI εξ ολοκλήρου > δ_min
## ✅ ΣΥΣΤΑΣΗ: Υλοποιήστε την καμπάνια!
Το p-value των πραγματικών δεδομένων είναι 1.71 × 10⁻¹³ — εξαιρετικά μικρό. Απορρίπτουμε την H₀ σε επίπεδο α = 0.05. Η διαφήμιση αυξάνει στατιστικά σημαντικά τις μετατροπές.
Τα δύο CI ταυτίζονται πλήρως όταν χρησιμοποιούμε
correct = FALSE. Η μόνη διαφορά είναι στο πρόσημο λόγω
διαφορετικής κατεύθυνσης υπολογισμού (p₁−p₂ vs p₂−p₁). Αν
χρησιμοποιούσαμε correct = TRUE (Yates correction), το CI
θα ήταν ελαφρώς ευρύτερο — η correction είναι όμως περιττή για τόσο
μεγάλα δείγματα.
Για να ανιχνεύσουμε διαφορά 2% (8%→10%) με power 80% χρειαζόμαστε ~3205 άτομα ανά ομάδα. Τρέξαμε 8.000 — πολύ παραπάνω από το απαραίτητο. Το πλεονέκτημα: μηδενικός κίνδυνος Type II error. Το μειονέκτημα: σπατάλη πόρων.
Η ανάλυση δείχνει ξεκάθαρα ότι η διαφήμιση αυξάνει τις μετατροπές κατά +0.77 ποσοστιαίες μονάδες (relative lift +43%). Το αποτέλεσμα είναι τόσο στατιστικά σημαντικό (p < 0.001) όσο και επιχειρηματικά ουσιαστικό (CI εξ ολοκλήρου πάνω από το κατώφλι 0.5pp). Επιπλέον, η segmentation ανέδειξε ότι η διαφήμιση αποδίδει καλύτερα τις αρχές της εβδομάδας, κάτι που μπορεί να αξιοποιηθεί για βελτιστοποίηση του budget.
Σύσταση: Προχωρήστε με την καμπάνια, με έμφαση στις ημέρες Δευτέρα–Τρίτη.
Εργασία 010 — A/B Testing & Causal Inference