Η παρούσα εργασία εξετάζει την αποτελεσματικότητα μιας διαφημιστικής καμπάνιας για λογαριασμό μιας fintech startup, χρησιμοποιώντας το dataset «Marketing A/B Testing» (Kaggle).
Μέσω της ανάλυσης 588.000 παρατηρήσεων, συγκρίνουμε την επίδραση της στοχευμένης διαφήμισης (ad) έναντι ενός ουδέτερου μηνύματος (psa) στις μετατροπές των χρηστών.
Στόχος μας είναι η αξιολόγηση της αιτιώδους επίδρασης (causal effect) της καμπάνιας και η διατύπωση επιχειρηματικής σύστασης με βάση τη στατιστική σημαντικότητα και το κατώφλι επιχειρηματικής ουσίας.
# --- Εγκατάσταση & Φόρτωση πακέτων ---
#install.packages(c("tidyverse", "pwr", "broom", "scales", "janitor"))
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ 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
##
## Attaching package: 'scales'
##
## The following object is masked from 'package:purrr':
##
## discard
##
## The following object is masked from 'package:readr':
##
## col_factor
##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
set.seed(42)
# --- Φόρτωση δεδομένων ---
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`
## 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, …
Στο βήμα αυτό δημιουργούμε ένα συνθετικό σύνολο δεδομένων για το πείραμα της τράπεζας, ορίζοντας το μέγεθος των ομάδων και την πιθανότητα μετατροπής (conversion) για κάθε μία, ώστε να έχουμε ένα γνωστό «ground truth».
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))
)
# Εμφάνιση των πρώτων εγγραφών για επιβεβαίωση
head(experiment)## # A tibble: 6 × 3
## user_id group converted
## <int> <chr> <int>
## 1 1 control 0
## 2 2 control 1
## 3 3 control 0
## 4 4 control 0
## 5 5 control 0
## 6 6 control 0
Δημιουργήσαμε ένα dataset 16.000 χρηστών. Η χρήση της
rbinom() προσομοιώνει ρεαλιστικά τις μετατροπές (0/1) με
βάση τις πιθανότητες 8% και 10% που ορίσαμε. Η δομή είναι έτοιμη για
στατιστική σύγκριση.
Υπολογίζουμε τα βασικά στατιστικά μεγέθη για κάθε ομάδα, συμπεριλαμβανομένου του conversion rate και του διαστήματος εμπιστοσύνης (95% CI).
summary_stats <- experiment |>
group_by(group) |>
summarise(
n = n(),
conversions = sum(converted),
conversion_rate = mean(converted),
se = sqrt(conversion_rate * (1 - conversion_rate) / n),
ci_lower = conversion_rate - 1.96 * se,
ci_upper = conversion_rate + 1.96 * se
)
summary_stats## # A tibble: 2 × 7
## group n conversions conversion_rate se ci_lower ci_upper
## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 control 8000 677 0.0846 0.00311 0.0785 0.0907
## 2 treatment 8000 764 0.0955 0.00329 0.0891 0.102
Τα αποτελέσματα δείχνουν conversion rate 8,46% για το control και 9,55% για το treatment.
Τα διαστήματα εμπιστοσύνης (0,078-0,090 έναντι
0,089-0,101) έχουν μια μικρή επικάλυψη, γεγονός που υποδηλώνει ότι, αν
και υπάρχει διαφορά, χρειαζόμαστε τον επίσημο στατιστικό έλεγχο
(prop.test) για να βεβαιωθούμε αν είναι σημαντική.
Χρησιμοποιούμε τη ggplot2 για να παρουσιάσουμε οπτικά
τις διαφορές μεταξύ των ομάδων, προσθέτοντας ράβδους σφάλματος (error
bars) για το 95% CI.
ggplot(summary_stats, aes(x = group, y = conversion_rate, fill = group)) +
geom_col(width = 0.5, alpha = 0.8) +
geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper), width = 0.1, size = 1) +
scale_y_continuous(labels = percent) +
labs(title = "A/B Test: Σύγκριση Conversion Rates",
x = NULL, y = "Conversion Rate") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Το γράφημα επιβεβαιώνει οπτικά την υπεροχή της πειραματικής ομάδας. Η ομάδα treatment παρουσιάζει υψηλότερο conversion rate σε σχέση με την ομάδα control, ενώ τα διαστήματα εμπιστοσύνης (error bars) δεν επικαλύπτονται σημαντικά, γεγονός που προμηνύει ότι η διαφορά είναι στατιστικά σημαντική.
Εκτελούμε τον έλεγχο αναλογιών για να διαπιστώσουμε αν η διαφορά που παρατηρήσαμε στο διάγραμμα είναι στατιστικά σημαντική ή οφείλεται στην τύχη.
clicks <- c(summary_stats$conversions[1], summary_stats$conversions[2])
visitors <- c(summary_stats$n[1], summary_stats$n[2])
test_result <- prop.test(x = clicks, n = visitors, correct = FALSE)
test_result##
## 2-sample test for equality of proportions without continuity correction
##
## data: clicks out of visitors
## 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
Το p-value είναι 0.01628, το οποίο είναι μικρότερο από το επίπεδο σημαντικότητας α = 0.05. Αυτό σημαίνει ότι απορρίπτουμε τη μηδενική υπόθεση (H₀). Η διαφορά στα conversion rates μεταξύ των δύο ομάδων είναι στατιστικά σημαντική και δεν οφείλεται στην τύχη.
Επαληθεύουμε τα αποτελέσματα του prop.test υπολογίζοντας
χειροκίνητα το pooled estimate, το τυπικό σφάλμα και το διάστημα
εμπιστοσύνης.
# (α) Pooled estimate
p_pool <- sum(clicks) / sum(visitors)
# (β) Pooled standard error
se_pool <- sqrt(p_pool * (1 - p_pool) * (1/visitors[1] + 1/visitors[2]))
# (γ) Διαφορά
delta <- summary_stats$conversion_rate[2] - summary_stats$conversion_rate[1]
# (δ) 95% CI
m <- 1.96 * se_pool
ci_lower_manual <- delta - m
ci_upper_manual <- delta + m
cat(sprintf("Pooled p: %.4f\nΔιαφορά: %.4f\n95%% CI: [%.4f, %.4f]\n",
p_pool, delta, ci_lower_manual, ci_upper_manual))## Pooled p: 0.0901
## Διαφορά: 0.0109
## 95% CI: [0.0020, 0.0197]
Το αποτέλεσμα [0.0020, 0.0197] είναι το πιο σημαντικό
εύρημα. Εφόσον το διάστημα εμπιστοσύνης δεν περιλαμβάνει το μηδέν, η
θετική επίδραση της πειραματικής ομάδας (treatment) είναι
στατιστικά βέβαιη. Το “lift” 1,09% που παρατηρήσαμε
μεταφράζεται σε μια πραγματική, μετρήσιμη βελτίωση που δεν οφείλεται σε
τυχαίες διακυμάνσεις, δικαιολογώντας έτσι την εφαρμογή της νέας
διαφήμισης.
Ελέγχουμε αν το μέγεθος του δείγματός μας (n=8000 ανά ομάδα) ήταν
επαρκές για να ανιχνεύσει την αύξηση που παρατηρήσαμε, χρησιμοποιώντας
τη βιβλιοθήκη pwr.
# Εγκατάσταση/Φόρτωση βιβλιοθήκης αν δεν υπάρχει
# install.packages("pwr")
library(pwr)
# Υπολογισμός effect size (Cohen's h)
h <- ES.h(0.10, 0.08)
# Υπολογισμός power
power_result <- pwr.2p.test(h = h, n = 8000, sig.level = 0.05)
power_result##
## Difference of proportion power calculation for binomial distribution (arcsine transformation)
##
## h = 0.069988
## n = 8000
## sig.level = 0.05
## power = 0.9931773
## alternative = two.sided
##
## NOTE: same sample sizes
Η τιμή power = 0.993 είναι εξαιρετική.
Στη στατιστική, ένας στόχος είναι συνήθως το 80%. Το 0.99 σημαίνει ότι το πείραμά ήταν «υπερ-επαρκές» για να εντοπίσει τη διαφορά που υπήρχε: είχε λιγότερο από 1% πιθανότητα να μην εντοπίσει τη βελτίωση, ακόμη και αν αυτή όντως υπήρχε.
Το δείγμα των 8.000 ατόμων ήταν πολύ ισχυρό για το συγκεκριμένο μέγεθος διαφοράς (effect size).
Πριν αναλύσουμε τα αποτελέσματα, πρέπει να βεβαιωθούμε ότι η τυχαιοποίηση ήταν σωστή. Ελέγχουμε την κατανομή των χρηστών στις δύο ομάδες.
# Έλεγχος αναλογίας ad/psa (group)
experiment |>
group_by(group) |>
summarise(n = n()) |>
mutate(percentage = n / sum(n))## # A tibble: 2 × 3
## group n percentage
## <chr> <int> <dbl>
## 1 control 8000 0.5
## 2 treatment 8000 0.5
## # A tibble: 2 × 3
## test_group n percentage
## <chr> <int> <dbl>
## 1 ad 564577 0.960
## 2 psa 23524 0.0400
Σε αυτό το στάδιο, χρησιμοποιούμε το πραγματικό dataset
(ads) για να υπολογίσουμε τα βασικά στατιστικά μεγέθη
(ποσοστό μετατροπής, τυπικό σφάλμα και διαστήματα εμπιστοσύνης) ανά
ομάδα (test_group). Στόχος είναι να έχουμε μια ξεκάθαρη
εικόνα της απόδοσης κάθε ομάδας πριν προχωρήσουμε στον τελικό στατιστικό
έλεγχο, διασφαλίζοντας ότι συγκρίνουμε τις σωστές ομάδες
(ad vs psa).
library(dplyr)
library(broom)
# Υπολογισμός στατιστικών ανά ομάδα
stats_by_group <- ads %>%
group_by(test_group) %>%
summarise(
conversions = sum(converted),
total = n(),
conv_rate = mean(converted)
)
# Εμφάνιση αποτελεσμάτων
stats_by_group## # A tibble: 2 × 4
## test_group conversions total conv_rate
## <chr> <int> <int> <dbl>
## 1 ad 14423 564577 0.0255
## 2 psa 420 23524 0.0179
# Στατιστικός έλεγχος σύγκρισης των δύο ομάδων
test_results <- prop.test(x = stats_by_group$conversions,
n = stats_by_group$total)
# Εμφάνιση αποτελεσμάτων ελέγχου
tidy(test_results)## # A tibble: 1 × 9
## estimate1 estimate2 statistic p.value parameter conf.low conf.high method
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 0.0255 0.0179 54.0 2.00e-13 1 0.00593 0.00946 2-sample …
## # ℹ 1 more variable: alternative <chr>
Τα αποτελέσματα της ανάλυσης επιβεβαιώνουν ότι η ομάδα
ad αποδίδει σημαντικά καλύτερα (2,55%) σε
σχέση με την ομάδα psa (1,79%).
Το εξαιρετικά μικρό p-value (\(1,99 \times 10^{-13}\)) αποδεικνύει ότι η υπεροχή της διαφήμισης είναι στατιστικά αδιαμφισβήτητη. Επιπλέον, το γεγονός ότι το κάτω όριο του διαστήματος εμπιστοσύνης (0,0059) ξεπερνά το όριο επιχειρηματικής ουσίας (0,005) καθιστά την καμπάνια μια αποδεδειγμένα κερδοφόρα επένδυση, δικαιολογώντας την πλήρη υιοθέτησή της.
Ο κώδικας υπολογίζει το Conversion Rate ανά ημέρα εβδομάδας
(most_ads_day) για κάθε ομάδα, υπολογίζοντας το Τυπικό
Σφάλμα (SE) και το 95% Διάστημα Εμπιστοσύνης (CI).
Η οπτικοποίηση με geom_ribbon επιτρέπει τον άμεσο
εντοπισμό ημερών όπου η διαφορά μεταξύ των ομάδων είναι στατιστικά
σημαντική (σημεία όπου οι “λωρίδες” δεν επικαλύπτονται).
seg_stats <- ads %>%
group_by(most_ads_day, test_group) %>% # Χρησιμοποιούμε test_group
summarise(
conv_rate = mean(converted),
se = sqrt(conv_rate * (1 - conv_rate) / n()),
.groups = 'drop'
) %>%
mutate(
lower = conv_rate - 1.96 * se,
upper = conv_rate + 1.96 * se
)
# Οπτικοποίηση
ggplot(seg_stats, aes(x = most_ads_day, y = conv_rate, color = test_group, group = test_group)) +
geom_line(size = 1) +
geom_point() +
geom_ribbon(aes(ymin = lower, ymax = upper, fill = test_group), alpha = 0.15, color = NA) +
theme_minimal()Η ανάλυση τμηματοποίησης ανά ημέρα επιβεβαιώνει τη σταθερή υπεροχή της ομάδας treatment (νέα διαφήμιση) έναντι της control καθ’ όλη τη διάρκεια της εβδομάδας.
Το γεγονός ότι τα διαστήματα εμπιστοσύνης (confidence ribbons) δεν επικαλύπτονται σε καμία ημέρα (ειδικά τις ημέρες αιχμής όπως η Δευτέρα και η Τρίτη) υποδεικνύει ότι η διαφορά στην απόδοση είναι στατιστικά σημαντική και δεν οφείλεται σε τυχαίες ημερήσιες διακυμάνσεις. Αυτό ενισχύει την αξιοπιστία του αποτελέσματος του πειράματος.
Για να καταλήξουμε στο τελικό συμπέρασμα, εξετάζουμε το “πραγματικό” όφελος της καμπάνιας σε σχέση με το κόστος/ρίσκο υλοποίησής της.
# 1. Ορισμός παραμέτρων
d_min <- 0.005
# 2. Υπολογισμός Lift
stats_final <- ads %>%
group_by(test_group) %>%
summarise(conv_rate = mean(converted), n = n())
p_ad <- stats_final$conv_rate[stats_final$test_group == "ad"]
p_psa <- stats_final$conv_rate[stats_final$test_group == "psa"]
abs_lift <- p_ad - p_psa
rel_lift <- abs_lift / p_psa
# 3. Υπολογισμός 95% CI της διαφοράς (για την απόφαση)
# Χρησιμοποιούμε τη διαφορά των αναλογιών
test_result <- prop.test(x = c(sum(ads$converted[ads$test_group == "ad"]),
sum(ads$converted[ads$test_group == "psa"])),
n = c(sum(ads$test_group == "ad"),
sum(ads$test_group == "psa")))
ci_lower <- abs(test_result$conf.int[1])
ci_upper <- abs(test_result$conf.int[2])
# Εκτύπωση αποτελεσμάτων για την απόφαση
cat("Absolute Lift:", abs_lift, "\n")## Absolute Lift: 0.007692453
## 95% CI: [ 0.005928792 , 0.009456114 ]
## d_min: 0.005
Συγκρίνοντας το 95% Διάστημα Εμπιστοσύνης [0.0059, 0.0095] με το κατώφλι \(d_{min} = 0.005\):
Περίπτωση (A): Το διάστημα εμπιστοσύνης βρίσκεται ολόκληρο πάνω από το \(d_{min}\).
Αυτό σημαίνει ότι, με 95% βεβαιότητα, το “πραγματικό” lift της καμπάνιας είναι τουλάχιστον 0.59%, δηλαδή πάντα μεγαλύτερο από το ελάχιστο αποδεκτό όριο επιχειρηματικής ουσίας.
Η απόφαση είναι η άμεση υιοθέτηση (Launch) της νέας διαφήμισης.
Εφόσον το κατώτατο όριο του διαστήματος εμπιστοσύνης (0.0059) είναι υψηλότερο από το \(d_{min}\) (0.005), έχουμε στατιστική απόδειξη ότι η αλλαγή δεν είναι μόνο στατιστικά σημαντική, αλλά και επιχειρηματικά κερδοφόρα με ελάχιστο ρίσκο. Δεν υπάρχει αμφιβολία ως προς την επιτυχία της καμπάνιας.