Εισαγωγή

Σε αυτή την εργασία εξετάζουμε αν μια νέα διαφημιστική καμπάνια αυξάνει πραγματικά τις μετατροπές (conversions) ή αν οποιαδήποτε διαφορά που παρατηρούμε είναι απλώς τυχαία. Για να το απαντήσουμε αυτό χρησιμοποιούμε A/B testing — μια μέθοδο που μας επιτρέπει να συγκρίνουμε δύο ομάδες χρηστών υπό ελεγχόμενες συνθήκες.

library(tidyverse)
library(pwr)
library(broom)
library(scales)
library(janitor)

set.seed(42)

Μέρος Α — Προσομοίωση Πειράματος

Δημιουργία δεδομένων

Ξεκινάμε δημιουργώντας φανταστικά δεδομένα όπου γνωρίζουμε εκ των προτέρων την αλήθεια: η νέα διαφήμιση αυξάνει το 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")
Πίνακας 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 ανά ομάδα (προσομοίωση)

Σχήμα 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

Χειρωνακτική επαλήθευση CI

Υπολογίζουμε χειρωνακτικά το διάστημα εμπιστοσύνης για τη διαφορά των δύο αναλογιών, για να επαληθεύσουμε το αποτέλεσμα του 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")
## --- Χειρωνακτικός Υπολογισμός ---
cat(sprintf("Pooled p̂  = %.5f\n", p_hat))
## Pooled p̂  = 0.09006
cat(sprintf("Pooled SE  = %.5f\n", se_hat))
## Pooled SE  = 0.00453
cat(sprintf("δ          = %.5f\n", d))
## δ          = 0.01087
cat(sprintf("95%% CI    = [%.5f, %.5f]\n", d - me, d + me))
## 95% CI    = [0.00200, 0.01975]
cat("\n--- Από prop.test() ---\n")
## 
## --- Από prop.test() ---
cat(sprintf("95%% CI    = [%.5f, %.5f]\n",
            -res_sim$conf.int[2], -res_sim$conf.int[1]))
## 95% CI    = [0.00201, 0.01974]

Τα δύο CI ταυτίζονται, όπως αναμένεται. Η μικρή διαφορά κατεύθυνσης (πρόσημο) οφείλεται στο ότι το prop.test() υπολογίζει p_control − p_treatment, ενώ εμείς p_treatment − p_control.

Power Analysis

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
cat(sprintf("\nCohen's h        = %.4f\n", h))
## 
## Cohen's h        = 0.0700
cat(sprintf("Απαιτούμενο n    = %.0f ανά ομάδα\n", ceiling(pwr_result$n)))
## Απαιτούμενο n    = 3205 ανά ομάδα
cat(sprintf("Τρέξαμε          = %d ανά ομάδα\n", n_ctrl))
## Τρέξαμε          = 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, …

Έλεγχος τυχαιοποίησης (Invariants Check)

Πριν εξετάσουμε τα αποτελέσματα, ελέγχουμε αν η κατανομή των χρηστών στις ομάδες είναι λογική.

# Αναλογία ομάδων
ads |>
  count(group) |>
  mutate(ποσοστό = percent(n / sum(n), accuracy = 0.1)) |>
  knitr::kable(caption = "Πίνακας 2: Μέγεθος ομάδων")
Πίνακας 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: Κατανομή ανά ημέρα — έλεγχος τυχαιοποίησης

Σχήμα 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 ανά ομάδα (πραγματικά δεδομένα)")
Πίνακας 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()")
Πίνακας 4: Αποτελέσματα prop.test()
estimate1 estimate2 statistic p.value conf.low conf.high
0.017854 0.025547 54.31805 0 -0.009434 -0.005951

Segmentation ανά ημέρα

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

Σχήμα 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 ανά ημέρα")
Πίνακας 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")
## ===========================================
cat("          ΕΠΙΧΕΙΡΗΜΑΤΙΚΗ ΑΠΟΦΑΣΗ\n")
##           ΕΠΙΧΕΙΡΗΜΑΤΙΚΗ ΑΠΟΦΑΣΗ
cat("===========================================\n")
## ===========================================
cat(sprintf("Conv. rate PSA (control):   %.4f%%\n", p_psa * 100))
## Conv. rate PSA (control):   1.7854%
cat(sprintf("Conv. rate AD (treatment):  %.4f%%\n", p_ad  * 100))
## Conv. rate AD (treatment):  2.5547%
cat(sprintf("Absolute lift:              %+.4f pp\n", abs_lift * 100))
## Absolute lift:              +0.7692 pp
cat(sprintf("Relative lift:              %+.1f%%\n",  rel_lift))
## Relative lift:              +43.1%
cat(sprintf("95%% CI για διαφορά:        [%.5f, %.5f]\n", ci_lo, ci_hi))
## 95% CI για διαφορά:        [0.00595, 0.00943]
cat(sprintf("p-value:                    %.2e\n", tidy_ads$p.value))
## p-value:                    1.71e-13
cat(sprintf("Κατώφλι επιχ. ουσίας:      %.3f\n", d_min))
## Κατώφλι επιχ. ουσίας:      0.005
cat("-------------------------------------------\n")
## -------------------------------------------
cat("Περίπτωση A: CI εξ ολοκλήρου > δ_min\n")
## Περίπτωση A: CI εξ ολοκλήρου > δ_min
cat("✅ ΣΥΣΤΑΣΗ: Υλοποιήστε την καμπάνια!\n")
## ✅ ΣΥΣΤΑΣΗ: Υλοποιήστε την καμπάνια!

Απαντήσεις Ερωτήσεων

❶ P-value & H₀

Το p-value των πραγματικών δεδομένων είναι 1.71 × 10⁻¹³ — εξαιρετικά μικρό. Απορρίπτουμε την H₀ σε επίπεδο α = 0.05. Η διαφήμιση αυξάνει στατιστικά σημαντικά τις μετατροπές.

❷ Χειρωνακτικό CI vs prop.test()

Τα δύο CI ταυτίζονται πλήρως όταν χρησιμοποιούμε correct = FALSE. Η μόνη διαφορά είναι στο πρόσημο λόγω διαφορετικής κατεύθυνσης υπολογισμού (p₁−p₂ vs p₂−p₁). Αν χρησιμοποιούσαμε correct = TRUE (Yates correction), το CI θα ήταν ελαφρώς ευρύτερο — η correction είναι όμως περιττή για τόσο μεγάλα δείγματα.

❸ Power Analysis

Για να ανιχνεύσουμε διαφορά 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