Ένας data analysts σε startup fintech αποφάσισε να τεστάρει μια νέα διαφημιστική καμπάνια.
Η ομάδα marketing θέλει να μάθει: η νέα διαφήμιση αυξάνει πραγματικά τις μετατροπές (conversions) ή η διαφορά είναι τυχαία;
Έτρεξε ένα A/B test: μέρος των χρηστών είδε τη νέα διαφήμιση (treatment: “ad”), οι υπόλοιποι είδαν ένα ουδέτερο μήνυμα (control: “psa”).
Η δουλειά απαιτεί την ανάλυση των αποτελεσμάτων με στατιστική αυστηρότητα και με επιχειρηματικά τεκμηριωμένη σύσταση.
# --- Εγκατάσταση & Φόρτωση πακέτων ---
#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, …
# --- Παράμετροι πειράματος ---
n_control <- 8000 # μέγεθος ομάδας ελέγχου
n_treatment <- 8000 # μέγεθος πειραματικής ομάδας
p_control <- 0.08 # baseline conversion rate
p_treatment <- 0.10 # μετά την αλλαγή (true effect = +2%)
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, …
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
| 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(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] ⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.
# 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%) είναι αρκετά μικρή. Επομένως, για να μπορεί το στατιστικό τεστ να ανιχνεύσει αξιόπιστα μια τόσο μικρή διαφορά, απαιτείται πολύ μεγάλο δείγμα. Αυτό υποδηλώνει ότι μικρές επιδράσεις χρειάζονται σημαντικά περισσότερα δεδομένα ώστε να εντοπιστούν με επαρκή στατιστική ισχύ.
# 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 είναι έντονα μη ισορροπημένο.
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
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)
Ποια ημέρα έχει τη μεγαλύτερη διαφορά μεταξύ ομάδων;
# 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).
📊 Ποιο είναι το p-value του ελέγχου; Απορρίπτουμε την H₀ σε επίπεδο α = 0.05;
🔎 Συμπίπτει το χειρωνακτικό CI με αυτό του
prop.test(); Αν όχι, γιατί;
prop.test(), αλλά όχι ακριβώς ίδιο. Η
διαφορά οφείλεται στο ότι το prop.test()
χρησιμοποιεί correction methods (όπως continuity correction και πιο
ακριβείς προσεγγίσεις για proportions), ενώ ο χειρωνακτικός υπολογισμός
βασίζεται στον απλό κανονικό προσεγγιστικό τύπο. Για μεγάλα δείγματα,
όμως, τα δύο αποτελέσματα συνήθως είναι αρκετά παρόμοια.💡 Πόσα άτομα χρειαζόντουσαν για power 80%; Πόσα τρέξαμε; Τι συνεπάγεται αυτό;
Fin