A/B Testing & Causal Inference

🏦 Brief

Ένας data analysts σε startup fintech αποφάσισε να τεστάρει μια νέα διαφημιστική καμπάνια.

Η ομάδα marketing θέλει να μάθει: η νέα διαφήμιση αυξάνει πραγματικά τις μετατροπές (conversions) ή η διαφορά είναι τυχαία;

Έτρεξε ένα A/B test: μέρος των χρηστών είδε τη νέα διαφήμιση (treatment: “ad”), οι υπόλοιποι είδαν ένα ουδέτερο μήνυμα (control: “psa”).

Η δουλειά απαιτεί την ανάλυση των αποτελεσμάτων με στατιστική αυστηρότητα και με επιχειρηματικά τεκμηριωμένη σύσταση.


Setup of the database

# --- Εγκατάσταση & Φόρτωση πακέτων ---
#install.packages(c("tidyverse", "pwr", "broom", "scales", "janitor"))

library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.5.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.0     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.2     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(pwr)
## Warning: package 'pwr' was built under R version 4.5.3
library(broom)
## Warning: package 'broom' was built under R version 4.5.3
library(scales)
## Warning: package 'scales' was built under R version 4.5.3
## 
## Attaching package: 'scales'
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## The following object is masked from 'package:readr':
## 
##     col_factor
library(janitor)
## Warning: package 'janitor' was built under R version 4.5.3
## 
## Attaching package: 'janitor'
## 
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test
set.seed(68)

# --- Φόρτωση δεδομένων ---
ads <- read_csv("marketing_AB.csv") |>
  janitor::clean_names() |>
  mutate(
    group     = factor(test_group, levels = c("psa", "ad")),
    converted = as.integer(converted)
  )
## New names:
## Rows: 588101 Columns: 7
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (2): test group, most ads day dbl (4): ...1, user id, total ads, most ads hour
## lgl (1): converted
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`
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, …

🔬 Μέρος Α — Βασικός A/B Έλεγχος (Simulated Experiment)

# --- Παράμετροι πειράματος ---
n_control   <- 8000      # μέγεθος ομάδας ελέγχου
n_treatment <- 8000      # μέγεθος πειραματικής ομάδας
p_control   <- 0.08      # baseline conversion rate
p_treatment <- 0.10      # μετά την αλλαγή (true effect = +2%)

Δημιουργία tibble experiment

experiment <- tibble(
  user_id = 1:(n_control + n_treatment),
  group   = c(rep("control", n_control),
              rep("treatment", n_treatment)),
  converted = c(rbinom(n_control,   1, p_control),
              rbinom(n_treatment, 1, p_treatment))
)

glimpse(experiment)
## 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> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …

Υπολογισμοί μετρικών και δημιουργία tible “summary_stats”

summary_stats <- experiment |>
  group_by(group) |>
  summarise(
    n         = n(),
    conversion    = sum(converted),
    ctp       = mean(converted),
    se        = sqrt(ctp * (1 - ctp) / n),
    ci_lower  = ctp - 1.95 * se,
    ci_upper  = ctp + 1.95 * se
  )

summary_stats
## # A tibble: 2 × 7
##   group         n conversion    ctp      se ci_lower ci_upper
##   <chr>     <int>      <int>  <dbl>   <dbl>    <dbl>    <dbl>
## 1 control    8000        674 0.0842 0.00311   0.0782   0.0903
## 2 treatment  8000        749 0.0936 0.00326   0.0873   0.1000

Αποτελέσματα summary_stats :

group

n

<int>

conversion

<int>

ctp

<dbl>

se

<dbl>

ci_lower

<dbl>

ci_upper

<dbl>

control 8000 674 0.084250 0.003105478 0.07819432 0.09030568
treatment 8000 749 0.093625 0.003256903 0.08727404 0.09997596

Οπτικοποίηση με ggplot

ggplot(summary_stats, aes(x = group, y = ctp, fill = group)) +
  geom_col(width = 0.5, alpha = 0.85) +
  geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper),
                width = 0.15, linewidth = 0.8) +
  geom_text(aes(label = percent(ctp, accuracy = 0.1)),
            vjust = -1.5, size = 5, fontface = "bold") +
  scale_y_continuous(labels = percent, limits = c(0, 0.16)) +
  scale_fill_manual(values = c("control" = "#6b7280",
                                "treatment" = "#3b82f6")) +
  labs(
    title    = "A/B Test: Πιθανότητα μετατροπής ανά ομάδα",
    subtitle = "Με 95% διαστήματα εμπιστοσύνης",
    x = NULL, y = "Conversion probability"
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "none")

Από το ggplot παρατηρούμε ότι μεγαλύτερο conversion rate έχει η κατηγορία “treatment” με 9.4%, ενώ η κατηγορία “control” δεν απέχει πάρα πολύ, με conversion rate 8.4%.

Έλεγχος υποθέσεων

conversion   <- c(summary_stats$conversion[1], summary_stats$conversion[2])
visitors <- c(summary_stats$n[1],      summary_stats$n[2])

test_result <- prop.test(
  x           = conversion,
  n           = visitors,
  conf.level  = 0.95,
  correct     = FALSE   # χωρίς Yates correction (ταιριάζει με τον τύπο μας)
)

test_result
## 
##  2-sample test for equality of proportions without continuity correction
## 
## data:  conversion out of visitors
## X-squared = 4.3388, df = 1, p-value = 0.03725
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.0181951454 -0.0005548546
## sample estimates:
##   prop 1   prop 2 
## 0.084250 0.093625
sample estimates:   prop 1   prop 2  0.084250 0.093625  

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

# 1. Pooled estimate
p_pool <- sum(conversion) / sum(visitors)

# 2. Pooled standard error
se_pool <- sqrt(p_pool * (1 - p_pool) *
                  (1/visitors[1] + 1/visitors[2]))

# 3. Διαφορά και διάστημα εμπιστοσύνης
delta  <- summary_stats$ctp[2] - summary_stats$ctp[1]
m      <- 1.95 * se_pool

cat(sprintf("Pooled p̂ = %.4f\n", p_pool))
## Pooled p̂ = 0.0889
cat(sprintf("Pooled SE = %.4f\n", se_pool))
## Pooled SE = 0.0045
cat(sprintf("δ = %.4f\n", delta))
## δ = 0.0094
cat(sprintf("95%% CI for δ: [%.4f, %.4f]\n", delta - m, delta + m))
## 95% CI for δ: [0.0006, 0.0182]
# Επιχειρηματική απόφαση
delta_min <- 0.01   # κατώφλι επιχειρηματικής ουσίας

if (delta - m > delta_min) {
  cat("✅ ΣΥΜΠΕΡΑΣΜΑ: Υλοποιήστε την αλλαγή!\n")
} else {
  cat("⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.\n")
}
## ⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.

Αποτελέσματα χειρωνακτικής επαλήθευσης:

α) pooled estimate p̂_pool = 0.0889, β) pooled SE = 0.0045, γ) δ = p_treatment - p_control = 0.0094, δ) 95% CI για τη διαφορά δ - [0.0006, 0.0182].

Pooled p̂ = 0.0889 Pooled SE = 0.0045 δ = 0.0094 95% CI for δ: [0.0006, 0.0182] ⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.

Power analysis

# h = Cohen's effect size για δύο αναλογίες
effect_size <- ES.h(p1 = 0.10, p2 = 0.08)
cat(sprintf("Cohen's h = %.4f\n", effect_size))
## Cohen's h = 0.0700
# Υπολογισμός απαιτούμενου μεγέθους δείγματος ανά ομάδα
sample_size_calc <- pwr.2p.test(
  h           = effect_size,
  sig.level   = 0.05,
  power       = 0.80,
  alternative = "two.sided"
)

sample_size_calc
## 
##      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

Το Power Analysis έδειξε ότι για να επιτευχθεί στατιστική ισχύς (power) 80% με επίπεδο σημαντικότητας α = 0.05, θα απαιτούνταν περίπου 3205 παρατηρήσεις ανά ομάδα. Το αποτέλεσμα αυτό προέκυψε με βάση πολύ μικρό effect size (Cohen’s h = 0.07), το οποίο δείχνει ότι η διαφορά μεταξύ των δύο ποσοστών (10% και 8%) είναι αρκετά μικρή. Επομένως, για να μπορεί το στατιστικό τεστ να ανιχνεύσει αξιόπιστα μια τόσο μικρή διαφορά, απαιτείται πολύ μεγάλο δείγμα. Αυτό υποδηλώνει ότι μικρές επιδράσεις χρειάζονται σημαντικά περισσότερα δεδομένα ώστε να εντοπιστούν με επαρκή στατιστική ισχύ.

📊 Μέρος Β — Πραγματικά Δεδομένα (Kaggle Marketing AB)

Invariants check

# 1. Αναλογία στις ομάδες
ads |>
  count(group) |>
  mutate(psa = n / sum(n))
## # A tibble: 2 × 3
##   group      n    psa
##   <fct>  <int>  <dbl>
## 1 psa    23524 0.0400
## 2 ad    564577 0.960
# 2. Κατανομή ανά ημέρα εβδομάδας — πρέπει να είναι παρόμοια
ads |>
  count(group, most_ads_day) |>
  group_by(group) |>
  mutate(psa = n / sum(n)) |>
  ggplot(aes(x = most_ads_day, y = psa, fill = group)) +
  geom_col(position = "dodge") +
  scale_y_continuous(labels = percent) +
  labs(title = "Invariant check: κατανομή ανά ημέρα",
       x = NULL, y = "% της ομάδας") +
  theme_minimal()

Ο έλεγχος της τυχαιοποίησης έδειξε σημαντική ανισορροπία μεταξύ των δύο ομάδων. Συγκεκριμένα, η ομάδα ad περιλάμβανε περίπου το 96% των παρατηρήσεων, ενώ η ομάδα psa μόλις το 4%. Επομένως, η κατανομή δεν ήταν κοντά στο αναμενόμενο 50/50, γεγονός που υποδηλώνει ότι η τυχαιοποίηση είτε δεν εφαρμόστηκε ισομερώς είτε το dataset είναι έντονα μη ισορροπημένο.

Υπολογισμός μετρικών και χρήση “broom::tidy” function

ads_summary <- ads |>
  group_by(group) |>
  summarise(
    n              = n(),
    conversions2    = sum(converted),
    conversion_rate = mean(converted),
    se             = sqrt(conversion_rate * (1 - conversion_rate) / n)
  ) |>
  mutate(
    ci_lower = conversion_rate - 1.95 * se,
    ci_upper = conversion_rate + 1.95 * se
  )

ads_summary
## # A tibble: 2 × 7
##   group      n conversions2 conversion_rate       se ci_lower ci_upper
##   <fct>  <int>        <int>           <dbl>    <dbl>    <dbl>    <dbl>
## 1 psa    23524          420          0.0179 0.000863   0.0162   0.0195
## 2 ad    564577        14423          0.0255 0.000210   0.0251   0.0260

Αποτελέσματα υπολογισμών

group

conversions2

<int>

conversion_rate

<dbl>

se

<dbl>

ci_lower

<dbl>

ci_upper

<dbl>

psa 420 0.01785411 0.0008633790 0.01617052 0.01953770
ad 14423 0.02554656 0.0002099835 0.02513709 0.02595603
test <- prop.test(
  x = ads_summary$conversions2,
  n = ads_summary$n,
  correct = FALSE
)

# tidy output — πολύ καλύτερο από το σκέτο print()
broom::tidy(test) |>
  select(estimate1, estimate2, statistic, p.value,
         conf.low, conf.high)
## # A tibble: 1 × 6
##   estimate1 estimate2 statistic  p.value conf.low conf.high
##       <dbl>     <dbl>     <dbl>    <dbl>    <dbl>     <dbl>
## 1    0.0179    0.0255      54.3 1.71e-13 -0.00943  -0.00595

Aποτελέσματα “broom::tidy”

estimate1

<dbl>

estimate2

<dbl>

statistic

<dbl>

p.value

<dbl>

conf.low

<dbl>

conf.high

<dbl>

0.01785411 0.02554656 54.31805 1.705281e-13 -0.009433974 -0.005950932

TODO 9: Segmentation — conversion rate ανά ημέρα εβδομάδας

Φτιάξε line plot με ribbon (95% CI) για κάθε ομάδα

Hint: geom_ribbon(aes(ymin = …, ymax = …), alpha = 0.15)

Ποια ημέρα έχει τη μεγαλύτερη διαφορά μεταξύ ομάδων;

Segmentation & line plot

# Conversion rate ανά ημέρα και ομάδα
ads_by_day <- ads |>
  group_by(most_ads_day, group) |>
  summarise(
    n = n(),
    conversion_rate = mean(converted),
    se = sqrt(conversion_rate * (1 - conversion_rate) / n),
    .groups = "drop"
  )

ggplot(ads_by_day, aes(x = most_ads_day,
                        y = conversion_rate,
                        color = group, group = group)) +
  geom_line(linewidth = 1.2) +
  geom_point(size = 3) +
  geom_ribbon(aes(ymin = conversion_rate - 1.95 * se,
                  ymax = conversion_rate + 1.95 * se,
                  fill = group),
              alpha = 0.15, color = NA) +
  scale_y_continuous(labels = percent_format(accuracy = 0.1)) +
  scale_color_manual(values = c("psa" = "#6b7280", "ad" = "#3b82f6")) +
  scale_fill_manual(values = c("psa" = "#6b7280", "ad" = "#3b82f6")) +
  labs(title = "Conversion rate ανά ημέρα εβδομάδας",
       subtitle = "Με 95% διαστήματα εμπιστοσύνης",
       x = NULL, y = "Conversion rate") +
  theme_minimal(base_size = 13)

Από το διάγραμμα παρατηρείται ότι η μεγαλύτερη διαφορά μεταξύ των ομάδων ad και psa εμφανίζεται την Τρίτη (Tuesday). Η ομάδα ad παρουσιάζει σημαντικά υψηλότερο conversion rate σε σχέση με την ομάδα psa, γεγονός που υποδηλώνει ότι εκείνη την ημέρα η διαφημιστική προσέγγιση της ad είχε την ισχυρότερη επίδραση στις μετατροπές (conversions).

TODO 10 (BONUS): Επιχειρηματική απόφαση

Όρισε δ_min = 0.005 (κατώφλι επιχειρηματικής ουσίας)

Υπολόγισε το absolute lift και το relative lift

Ποια από τις 6 περιπτώσεις CI ισχύει; (A/B/C/D/E/F)

Ποια η τελική σύστασή σου;

Επιχειρηματική απόφαση

# CI για τη διαφορά (lift)
conf_int <- broom::tidy(test)
lift_pct <- (conf_int$estimate1 - conf_int$estimate2) /
             conf_int$estimate2 * 100

cat(sprintf("Absolute lift: %.2f ποσοστ. μονάδες\n",
            (conf_int$estimate1 - conf_int$estimate2) * 100))
## Absolute lift: -0.77 ποσοστ. μονάδες
cat(sprintf("Relative lift: %+.1f%%\n", lift_pct))
## Relative lift: -30.1%
cat(sprintf("95%% CI for difference: [%.4f, %.4f]\n",
            conf_int$conf.low, conf_int$conf.high))
## 95% CI for difference: [-0.0094, -0.0060]

Τα αποτελέσματα δείχνουν ότι όλο το confidence interval είναι αρνητικό και δεν περιλαμβάνει το 0 άρα η διαφορά είναι στατιστικά σημαντική. Η ομάδα treatment / ad είχε χειρότερη απόδοση από την control / psa.

Αυτό αντιστοιχεί στην περίπτωση όπου υπάρχει statistically significant decrease.

Άρα πιθανότατα είναι η περίπτωση F (αρνητική και στατιστικά σημαντική επίδραση).

Τελική σύσταση

Το confidence interval δεν περιλαμβάνει το μηδέν και είναι εξ ολοκλήρου αρνητικό, γεγονός που δείχνει ότι η νέα προσέγγιση (ad) μείωσε σημαντικά το conversion rate σε σχέση με την ομάδα ελέγχου (psa). Το absolute lift ήταν -0.77 ποσοστιαίες μονάδες και το relative lift περίπου -30%, υποδηλώνοντας σημαντική πτώση στην απόδοση.

Επομένως, η τελική σύσταση είναι να μην εφαρμοστεί η νέα διαφημιστική στρατηγική (ad), καθώς φαίνεται να αποδίδει χειρότερα από την υπάρχουσα προσέγγιση (psa).

Συμπεράσματα

  1. 📊 Ποιο είναι το p-value του ελέγχου; Απορρίπτουμε την H₀ σε επίπεδο α = 0.05;

    • Το p-value του ελέγχου ήταν μικρότερο από 0.05, επομένως απορρίπτουμε τη μηδενική υπόθεση Η0​. Αυτό σημαίνει ότι υπάρχει στατιστικά σημαντική διαφορά μεταξύ των δύο ομάδων (ad και psa) ως προς το conversion rate και η διαφορά αυτή δεν φαίνεται να οφείλεται σε τυχαία διακύμανση.
  2. 🔎 Συμπίπτει το χειρωνακτικό CI με αυτό του prop.test(); Αν όχι, γιατί;

    • Το χειρωνακτικό confidence interval ήταν πολύ κοντά σε αυτό του prop.test(), αλλά όχι ακριβώς ίδιο. Η διαφορά οφείλεται στο ότι το prop.test() χρησιμοποιεί correction methods (όπως continuity correction και πιο ακριβείς προσεγγίσεις για proportions), ενώ ο χειρωνακτικός υπολογισμός βασίζεται στον απλό κανονικό προσεγγιστικό τύπο. Για μεγάλα δείγματα, όμως, τα δύο αποτελέσματα συνήθως είναι αρκετά παρόμοια.
  3. 💡 Πόσα άτομα χρειαζόντουσαν για power 80%; Πόσα τρέξαμε; Τι συνεπάγεται αυτό;

    • Το power analysis έδειξε ότι απαιτούνταν περίπου 3205 παρατηρήσεις ανά ομάδα ώστε το τεστ να έχει power 80% με επίπεδο σημαντικότητας α = 0.05. Στην πράξη, το dataset περιείχε πολύ περισσότερες παρατηρήσεις, επομένως το πείραμα είχε υπεραρκετή στατιστική ισχύ. Αυτό σημαίνει ότι το τεστ είχε πολύ μεγάλη πιθανότητα να εντοπίσει ακόμη και μικρές διαφορές μεταξύ των ομάδων, κάνοντας τα αποτελέσματα πιο αξιόπιστα και στατιστικά σταθερά.

Fin