Η παρούσα εργασία έχει ως στόχο την αξιολόγηση της αποτελεσματικότητας μιας νέας διαφημιστικής καμπάνιας για μια startup εταιρεία στον κλάδο του Fintech, μέσω της στατιστικής μεθοδολογίας των A/B Ελέγχων (A/B Testing). Το βασικό επιχειρηματικό ερώτημα που καλούμαστε να απαντήσουμε είναι αν η νέα διαφήμιση επιφέρει μια πραγματική, ουσιαστική αύξηση στο ποσοστό μετατροπών (conversion rate) των χρηστών ή αν η παρατηρούμενη διαφορά οφείλεται σε τυχαία διακύμανση του δείγματος.
Για την ανάλυση χρησιμοποιήθηκαν πραγματικά δεδομένα από το σύνολο δεδομένων Marketing A/B Testing (διαθέσιμο μέσω της πλατφόρμας Kaggle). Το dataset περιλαμβάνει συνολικά 588.101 εγγραφές χρηστών, οι οποίοι έχουν τυχαιοποιηθεί σε δύο διακριτές ομάδες:
Ομάδα Ελέγχου (Control Group / “psa”): Οι χρήστες αυτοί είδαν ένα ουδέτερο, δημόσιο μήνυμα (Public Service Announcement).
Πειραματική Ομάδα (Treatment Group / “ad”): Οι χρήστες αυτοί εκτέθηκαν στη νέα διαφημιστική καμπάνια της εταιρείας.
##* Φόρτωση Δεδομένων*
set.seed(71)
# --- Φόρτωση δεδομένων ---
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 = factor(c(rep("control", n_control), rep("treatment", n_treatment)),
levels = c("control", "treatment")),
converted = c(rbinom(n_control, 1, p_control), rbinom(n_treatment, 1, p_treatment))
)
summary_stats <- experiment |>
group_by(group) |>
summarize(
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
)
print(summary_stats)
## # A tibble: 2 × 7
## group n conversions conversion_rate se ci_lower ci_upper
## <fct> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 control 8000 667 0.0834 0.00309 0.0773 0.0894
## 2 treatment 8000 820 0.102 0.00339 0.0959 0.109
ggplot(summary_stats, aes(x = group, y = conversion_rate, fill = group)) +
geom_col(width = 0.5, show.legend = FALSE) +
geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper), width = 0.1, color = "black", size = 0.8) +
scale_y_continuous(labels = percent) +
labs(
title = "Σύγκριση Ποσοστών Μετατροπής (Simulated A/B Test)",
subtitle = "Τα σφάλματα αναπαριστούν το 95% Διάστημα Εμπιστοσύνης (CI)",
x = "Ομάδα Πειράματος (Group)",
y = "Conversion Rate (%)"
) +
theme_minimal(base_size = 13) +
scale_fill_manual(values = c("control" = "#90D5FF", "treatment" = "#FFC5D3"))
## 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 group) πέτυχε υψηλότερο ποσοστό μετατροπής σε σχέση με την ομάδα ελέγχου (control group). Τα διαστήματα εμπιστοσύνης των δύο ομάδων δεν επικαλύπτονται καθόλου, γεγονός που αποτελεί μια πρώτη ισχυρή ένδειξη ότι η διαφορά τους είναι στατιστικά σημαντική και όχι τυχαία.
conversions_vec <- c(
summary_stats |> filter(group == "treatment") |> pull(conversions),
summary_stats |> filter(group == "control") |> pull(conversions)
)
n_vec <- c(
summary_stats |> filter(group == "treatment") |> pull(n),
summary_stats |> filter(group == "control") |> pull(n)
)
test_result <- prop.test(conversions_vec, n_vec, correct = FALSE)
print(test_result)
##
## 2-sample test for equality of proportions without continuity correction
##
## data: conversions_vec out of n_vec
## X-squared = 17.355, df = 1, p-value = 3.1e-05
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## 0.01013217 0.02811783
## sample estimates:
## prop 1 prop 2
## 0.102500 0.083375
Η συνάρτηση prop.test() επιστρέφει ένα εξαιρετικά χαμηλό p-value, γεγονός, που επιτρέπει να απορρίψουμε τη μηδενική υπόθεση Η0 και να συμπεράνουμε ότι η νέα διαφήμιση έχει πραγματικό θετικό αντίκτυπο.
n_t <- summary_stats |> filter(group == "treatment") |> pull(n)
n_c <- summary_stats |> filter(group == "control") |> pull(n)
x_t <- summary_stats |> filter(group == "treatment") |> pull(conversions)
x_c <- summary_stats |> filter(group == "control") |> pull(conversions)
p_t <- summary_stats |> filter(group == "treatment") |> pull(conversion_rate)
p_c <- summary_stats |> filter(group == "control") |> pull(conversion_rate)
# (α) pooled estimate
p_pool <- (x_t + x_c) / (n_t + n_c)
# (β) pooled SE
se_pool <- sqrt(p_pool * (1 - p_pool) * (1/n_t + 1/n_c))
# (γ) δ = p_treatment - p_control
delta <- p_t - p_c
# (δ) 95% CI για τη διαφορά δ
z_value <- qnorm(0.975) # ~1.96
ci_diff_lower <- delta - z_value * se_pool
ci_diff_upper <- delta + z_value * se_pool
cat("\n=== Χειρωνακτική Επαλήθευση ===\n")
##
## === Χειρωνακτική Επαλήθευση ===
cat("Pooled Estimate (p̂_pool):", round(p_pool, 4), "\n")
## Pooled Estimate (p̂_pool): 0.0929
cat("Pooled SE:", round(se_pool, 4), "\n")
## Pooled SE: 0.0046
cat("Διαφορά Αναλογιών (δ):", round(delta, 4), "\n")
## Διαφορά Αναλογιών (δ): 0.0191
cat("Manual 95% CI: [", round(ci_diff_lower, 4), ",", round(ci_diff_upper, 4), "]\n")
## Manual 95% CI: [ 0.0101 , 0.0281 ]
cat("prop.test() 95% CI: [", round(test_result$conf.int[1], 4), ",", round(test_result$conf.int[2], 4), "]\n")
## prop.test() 95% CI: [ 0.0101 , 0.0281 ]
Με τον χειρωνακτικό υπολογισμό των βασικών στατιστικών μεγεθών του A/B ελέγχου, επαληθεύουμε τα αποτελέσματα της συνάρτησης prop.test(). Η απειροελάχιστη διαφορά οφείλεται στο ότι η prop.test() χρησιμοποιεί το unpooled standard error για τα όρια του διαστήματος εμπιστοσύνης, ενώ ο κλασικός χειροκίνητος τύπος βασίζεται στο pooled estimate.
cohens_h <- ES.h(p1 = p_treatment, p2 = p_control)
power_result <- pwr.2p.test(h = cohens_h, sig.level = 0.05, power = 0.80)
print(power_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("\nΑπαιτούμενο δείγμα ανά ομάδα για Power = 80%:", ceiling(power_result$n), "χρήστες.\n")
##
## Απαιτούμενο δείγμα ανά ομάδα για Power = 80%: 3205 χρήστες.
Το Cohen’s η χρησιμοποιήθηκε για τη μέτρηση του μεγέθους επίδρασης effect size μεταξύ των δύο αναλογιών. Με βάση το Power Analysis (στατιστική ισχύς 80% και επίπεδο σημαντικότητας 5%), το απαιτούμενο δείγμα ήταν 3.220 χρήστες ανά ομάδα. Επειδή στο πείραμα χρησιμοποιήθηκαν 8.000 χρήστες ανά ομάδα, το δείγμα ήταν υπεραρκετό. Αυτό εξασφάλισε μέγιστη σιγουριά για τον εντοπισμό της διαφοράς του +2% και ελαχιστοποίησε την πιθανότητα Σφάλματος Τύπου ΙΙ.
# Προετοιμασία των πραγματικών δεδομένων
days_order <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
ads <- ads |>
mutate(most_ads_day = factor(most_ads_day, levels = days_order))
# (α) Αναλογία ad/psa
group_counts <- ads |>
count(group) |>
mutate(percentage = n / sum(n))
print("=== Κατανομή χρηστών ανά ομάδα ===")
## [1] "=== Κατανομή χρηστών ανά ομάδα ==="
print(group_counts)
## # A tibble: 2 × 3
## group n percentage
## <fct> <int> <dbl>
## 1 psa 23524 0.0400
## 2 ad 564577 0.960
# (β) Οπτικοποίηση κατανομής ανά ημέρα εβδομάδας για έλεγχο ανισορροπιών
ggplot(ads, aes(x = most_ads_day, fill = group)) +
geom_bar(position = "fill") +
scale_y_continuous(labels = percent) +
labs(
title = "Έλεγχος Ισορροπίας: Αναλογία Ομάδων ανά Ημέρα",
x = "Ημέρα Εβδομάδας",
y = "Ποσοστό (%) χρηστών",
fill = "Ομάδα"
) +
theme_minimal() +
scale_fill_manual(values = c("psa" = "#90D5FF", "ad" = "#FFC5D3"))
Από τα αποτελέσματα προκύπτει ότι η κατανομή δεν είναι 50/50, καθώς
περίπου το 96% των χρηστών είδε τη διαφήμιση (ad) και μόλις το 4% είδε
το ουδέτερο μήνυμα (psa).
real_summary <- ads |>
group_by(group) |>
summarize(
n = n(),
conversions = sum(converted),
conversion_rate = mean(converted)
)
# Προετοιμασία διανυσμάτων για το prop.test
real_conv <- c(real_summary |> filter(group == "ad") |> pull(conversions),
real_summary |> filter(group == "psa") |> pull(conversions))
real_n <- c(real_summary |> filter(group == "ad") |> pull(n),
real_summary |> filter(group == "psa") |> pull(n))
# Έλεγχος υποθέσεων και μορφοποίηση με broom::tidy
real_test <- prop.test(real_conv, real_n, correct = FALSE) |>
broom::tidy()
print("=== Αποτελέσματα Στατιστικού Ελέγχου Πραγματικών Δεδομένων ===")
## [1] "=== Αποτελέσματα Στατιστικού Ελέγχου Πραγματικών Δεδομένων ==="
print(real_test)
## # 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.3 1.71e-13 1 0.00595 0.00943 2-sample …
## # ℹ 1 more variable: alternative <chr>
Η prop.test() επιστρέφει ένα p-value εξαιρετικά κοντά στο μηδέν. Η διαφορά ανάμεσα στα conversion rates είναι στατιστικά σημαντική. Η νέα διαφημιστική καμπάνια πράγματι αυξάνει τις μετατροπές και η διαφορά αυτή δεν οφείλεται σε τυχαία διακύμανση του δείγματος.
daily_stats <- ads |>
group_by(group, most_ads_day) |>
summarize(
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,
.groups = "drop"
)
# Line plot με ribbon (95% CI)
ggplot(daily_stats, aes(x = most_ads_day, y = conversion_rate, color = group, group = group)) +
geom_ribbon(aes(ymin = ci_lower, ymax = ci_upper, fill = group), color = NA, alpha = 0.15) +
geom_line(size = 1.2) +
geom_point(size = 2) +
scale_y_continuous(labels = percent) +
labs(
title = "Ποσοστό Μετατροπής ανά Ημέρα και Ομάδα",
subtitle = "Τα σκιασμένα ribbons αναπαριστούν το 95% Διάστημα Εμπιστοσύνης",
x = "Ημέρα Εβδομάδας",
y = "Conversion Rate (%)",
color = "Ομάδα",
fill = "Ομάδα"
) +
theme_minimal() +
scale_color_manual(values = c("psa" = "#007bcc", "ad" = "#ff4d6d")) +
scale_fill_manual(values = c("psa" = "#007bcc", "ad" = "#ff4d6d"))
Το line plot δείχνει ότι η ομάδα ad κυριαρχεί σταθερά έναντι της psa καθ’ όλη τη διάρκεια της εβδομάδας.
Η Δευτέρα (Monday) παρουσιάζει την καθαρότερη οπτική διαφορά και τη μεγαλύτερη απόσταση ανάμεσα στις δύο γραμμές. Αντίθετα, τις ημέρες του Σαββατοκύριακου τα διαστήματα εμπιστοσύνης τείνουν να πλησιάσουν, καθώς η καταναλωτική συμπεριφορά αλλάζει.
p_ad <- real_summary |> filter(group == "ad") |> pull(conversion_rate)
p_psa <- real_summary |> filter(group == "psa") |> pull(conversion_rate)
abs_lift <- p_ad - p_psa
rel_lift <- abs_lift / p_psa
d_min <- 0.005
cat("\n=== Επιχειρηματικές Μετρικές ===\n")
##
## === Επιχειρηματικές Μετρικές ===
cat("Conversion Rate (Ad):", round(p_ad * 100, 3), "%\n")
## Conversion Rate (Ad): 2.555 %
cat("Conversion Rate (PSA):", round(p_psa * 100, 3), "%\n")
## Conversion Rate (PSA): 1.785 %
cat("Absolute Lift (δ):", round(abs_lift * 100, 4), "%\n")
## Absolute Lift (δ): 0.7692 %
cat("Relative Lift:", round(rel_lift * 100, 2), "%\n")
## Relative Lift: 43.09 %
cat("Όριο Επιχειρηματικής Ουσίας (δ_min):", d_min * 100, "%\n")
## Όριο Επιχειρηματικής Ουσίας (δ_min): 0.5 %
cat("95% CI Διαφοράς από prop.test(): [", round(real_test$conf.low * 100, 4), "%,", round(real_test$conf.high * 100, 4), "% ]\n")
## 95% CI Διαφοράς από prop.test(): [ 0.5951 %, 0.9434 % ]
Καθώς το προκαθορισμένο όριο επιχειρηματικής ουσίας είναι δmin0.005 και το 95% Διάστημα Εμπιστοσύνης της διαφοράς βρίσκεται ολόκληρο πάνω από το δmin 0.006 > 0.005$, βρισκόμαστε στην Περίπτωση Α (Statistically Significant & Professionally Significant).
ΑΠΟΦΑΣΗ: Να γίνει η καμπάνια. Η νέα διαφήμιση δεν πέτυχε απλώς στατιστική σημαντικότητα λόγω του τεράστιου δείγματος , αλλά ξεπέρασε ξεκάθαρα και το αυστηρό οικονομικό κατώφλι δmin0.005 που έθεσε η fintech startup. Η σχετική αύξηση των μετατροπών κατά 43% δικαιολογεί απόλυτα το κόστος της διαφημιστικής δαπάνης. Προτείνεται η μόνιμη υιοθέτηση της καμπάνιας, με έμφαση στην προβολή της κατά τις πρώτες ημέρες της εβδομάδας (ιδίως Δευτέρα), όπου καταγράφεται η μέγιστη απόδοση.