Εβδομαδιαία εργασία 10

Marketing A/B Testing Dataset

Το Marketing A/B Testing Dataset χρησιμεύει για την αξιολόγηση της αποτελεσματικότητας μιας διαφημιστικής καμπάνιας μέσω ενός πειράματος A/B Testing.

1. Σύγκριση συμπεριφοράς:

• Ομάδα ad: Βλέπει την κανονική διαφήμιση.
• Ομάδα PSA: Βλέπει ένα κοινωνικό μήνυμα ή τίποτα.

Στόχος: Το dataset δείχνει ποια από τις δύο ομάδες είχε τις περισσότερες αγορές ή αλληλεπιδράσεις.

2. Μεταβλητές Dataset:

#ΔΗΜΙΟΥΡΓΙΑ ΠΙΝΑΚΑ ΜΕΤΑΒΛΗΤΩΝ:
variables <- data.frame(
  
"Όνομα" = c("Index", "User ID", "Test Group", "Converted", "Total Ads", "Most Ads day", "Most Ads Hour"),
  
 "Τύπος" = c("double", "double", "character", "logical", "double", "character", "double"),

"Περιγραφή" = c("Ο αύξων αριθμός της σειράς.", "Ο μοναδικός κωδικός χρήστη.", "Η ομάδα του πειράματος (ad/ psa).", "Αν πραγματοποιήθηκε η αγορά (True/False).", "Συνολικός αριθμός διαφημίσεων.", "Η ημέρα με τις περισσότερες διαφημίσεις.", "Η ώρα με τις περισσότερες διαφημίσεις.")
)

#ΕΜΦΑΝΙΣΗ ΠΙΝΑΚΑ:
knitr::kable(variables, caption = "Πίνακας μεταβλητών:")

Πίνακας μεταβλητών:

Όνομα	Τύπος	Περιγραφή
Index	double	Ο αύξων αριθμός της σειράς.
User ID	double	Ο μοναδικός κωδικός χρήστη.
Test Group	character	Η ομάδα του πειράματος (ad/ psa).
Converted	logical	Αν πραγματοποιήθηκε η αγορά (True/False).
Total Ads	double	Συνολικός αριθμός διαφημίσεων.
Most Ads day	character	Η ημέρα με τις περισσότερες διαφημίσεις.
Most Ads Hour	double	Η ώρα με τις περισσότερες διαφημίσεις.

3. Setup:

#ΦΟΡΤΩΣΗ ΒΙΒΛΙΟΘΗΚΩΝ:
library(tidyverse)
library(pwr)
library(broom)
library(scales)
library(janitor)

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)
  )

#ΕΜΦΑΝΙΣΗ ΔΟΜΗΣ ΤΩΝ ΔΕΔΟΜΕΝΩΝ
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, …

Μέρος Α’ - Simulated A/B Test

#ΠΑΡΑΜΕΤΡΟΙ ΠΕΙΡΑΜΑΤΟΣ

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)),
  clicked = c(rbinom(n_control,   1, prob = 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, 18,…
## $ group   <chr> "control", "control", "control", "control", "control", "contro…
## $ clicked <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0,…

# ΕΜΦΑΝΙΖΩ ΣΥΓΚΕΚΡΙΜΕΝΟ ΑΡΙΘΜΟ ΑΠΟ ΓΡΑΜΜΕΣ 
knitr::kable(head(experiment, 10))

user_id	group	clicked
1	control	0
2	control	1
3	control	0
4	control	0
5	control	0
6	control	0
7	control	0
8	control	0
9	control	0
10	control	0

#ΥΠΟΛΟΓΙΣΜΟΣ ΑΝΑ ΟΜΑΔΑ: n conversions, conversion_rate
summary_stats <- experiment |>
  group_by(group) |>
  summarise(
    n         = n(), #ΣΥΝΟΛΙΚΟ ΠΛΗΘΟΣ
    clicks    = sum(clicked), #ΣΥΝΟΛΙΚΕΣ ΜΕΤΑΤΡΟΠΕΣ
    ctp       = mean(clicked), #ΠΟΣΟΣΤΟ ΜΕΤΑΡΟΠΗΣ
    se        = sqrt(ctp * (1 - ctp) / n), # ΤΥΠΙΚΟ ΣΦΑΛΜΑ
    ci_lower  = ctp - 1.96 * se, #ΚΑΤΩ ΟΡΙΟ ΔΙΑΣΤΗΜΑΤΟΣ ΕΜΠΙΣΤΟΣΥΝΗΣ (z= 1.96)
    ci_upper  = ctp + 1.96 * se #ΑΝΩ ΟΡΙΟ ΔΙΑΣΤΗΜΑΤΟΣ ΕΜΠΙΣΤΟΣΥΝΗΣ (z= 1.96)
  )

summary_stats

## # A tibble: 2 × 7
##   group         n clicks    ctp      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

O παραπάνω πίνακας δείχνει τα περιγραφικά στατιστικά για κάθε ομάδα:

Stats_Data <- data.frame(
  
  "Στήλη" = c("n", "clicks", "ctp", "se", "ci_lower", "ci_uper"),
  
  "Control" = c("8000", "677", "0.0846",  "0.00311", "0.0785", "0.0907"),
  
  "Treatment" = c("8000", "764", "0.0955", "0.00329", "0.0891", "0.102")
  
)

knitr::kable(Stats_Data)

Στήλη	Control	Treatment
n	8000	8000
clicks	677	764
ctp	0.0846	0.0955
se	0.00311	0.00329
ci_lower	0.0785	0.0891
ci_uper	0.0907	0.102

Ερμηνεία:

• Μέγεθος Δείγματος (\(n\)): Το δείγμα χωρίζεται στις δύο κατηγορίες του πειράματος. Η ομάδα psa (ομάδα ελέγχου) περιλαμβάνει τους χρήστες που είδαν το κοινωνικό μήνυμα, ενώ η ομάδα ad περιλαμβάνει τη μεγάλη πλειοψηφία των χρηστών που εκτέθηκαν στην πραγματική διαφήμιση. Και οι δύο ομάδες έχουν ίσο αριθμό χρηστών, δηλαδή 8000.

• Αριθμός Clicks & Ποσοστό Click-Through (ctp):

  • Ομάδα Ελέγχου (psa): Σημείωσε 677 κλικ με ποσοστό ανταπόκρισης 8,46% (ctp = 0.0846). Αυτό είναι το baseline ποσοστό μας (πώς συμπεριφέρονται οι χρήστες χωρίς τη διαφήμιση).
  • Ομάδα Διαφήμισης (ad): Σημείωσε 764 κλικ με ποσοστό ανταπόκρισης 9,55% (ctp = 0.0955).
  • Αποτέλεσμα: Η έκθεση των χρηστών στην κανονική διαφήμιση (ad) οδήγησε σε αύξηση του ποσοστού μετατροπής κατά 1,09 ποσοστιαίες μονάδες σε σχέση με όσους είδαν το κοινωνικό μήνυμα (psa).

• Τυπικό Σφάλμα (se): Το τυπικό σφάλμα παραμένει χαμηλό (0,00311 για το psa και 0,00329 για το ad), επιβεβαιώνοντας τη σταθερότητα και την ακρίβεια των δειγμάτων μας.

• 95% Διαστήματα Εμπιστοσύνης (ci_lower έως ci_upper):

  • For την ομάδα psa, είμαστε 95% βέβαιοι ότι το πραγματικό ποσοστό κλικ κυμαίνεται μεταξύ 7,85% και 9,07%.
  • For την ομάδα ad, είμαστε 95% βέβαιοι ότι το πραγματικό ποσοστό κλικ κυμαίνεται μεταξύ 8,91% και 10,20%.

Οπτικοποίηση:

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 = "Click-through probability"
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "none")

Ερμηνεία:

• Η ομάδα ελέγχου πέτυχε ποσοστό κλικ 8,5%. Δηλαδή, στους 100 χρήστες, οι 8,5 έκαναν κλικ.

• Η πειραματική ομάδα πέτυχε υψηλότερο ποσοστό 9,6%. Δηλαδή, στους 100 χρήστες, οι 9,6 έκαναν κλικ.

Η διαφορά αυτή μεταφράζεται σε μια απόλυτη αύξηση 1,1 ποσοστιαίων μονάδων.Αν συγκρίνουμε αυτό το κέρδος με το πού ξεκινήσαμε, η νέα εκδοχή είναι κατά 12,9% (σχεδόν 13%) πιο αποτελεσματική από την παλιά. Αυτό σημαίνει ότι αν εφαρμόσουμε τη νέα αλλαγή σε όλους τους χρήστες, θα έχουμε σημαντική αύξηση στα συνολικά κλικ.

Έλεγχος Υπόθεσης με prop.test()

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

test_result <- prop.test(
  x           = clicks,
  n           = visitors,
  conf.level  = 0.95,
  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 Απορρίπτουμε την αρχική υπόθεση σε επίπεδο σημαντικότητας a = 0.5 (αφού το 0.016 είναι μικρότερο από το 0.05)

• CI [-0.019744875 -0.002005125]

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

#ΔΕΔΟΜΕΝΑ ΑΠΟ ΤΟ ΠΕΙΡΑΜΑ:
n_control <- 8000
n_treatment <- 8000
clicks_control <- 677
clicks_treatment <- 764

p_control <- clicks_control / n_control       # prop 1 = 0.084625
p_treatment <- clicks_treatment / n_treatment # prop 2 = 0.095500

#POOL ESTIMATE P_POOL
p_pool <- (clicks_control + clicks_treatment) / (n_control + n_treatment)

#POOLED SE
se_diff <- sqrt((p_control * (1 - p_control) / n_control) + 
                (p_treatment * (1 - p_treatment) / n_treatment))

#P_CONTROL - P_TREATMENT
Difference <- p_control - p_treatment

#ΓΙΑ 95% CI ΓΙΑ ΤΗ ΔΙΑΦΟΡΑ DIFFERENCE
z_critical <- 1.96
ci_lower <- Difference  - (z_critical * se_diff)
ci_upper <- Difference  + (z_critical * se_diff)

#ΕΜΦΑΝΙΣΗ ΑΠΟΤΕΛΕΣΜΑΤΩΝ
cat("p_pool: ", p_pool, "\n")

## p_pool:  0.0900625

cat("SE διαφοράς: ", se_diff, "\n")

## SE διαφοράς:  0.00452553

cat("Difference: ", Difference , "\n")

## Difference:  -0.010875

cat("95% CI: [", ci_lower, ", ", ci_upper, "]\n")

## 95% CI: [ -0.01974504 ,  -0.002004962 ]

Τα αποτελέσματα των χειρωνακτικών υπολογισμών ταυτίζονται απόλυτα με το prop.test(), με τη μηδαμινή διαφορά στα τελευταία δεκαδικά να οφείλεται αποκλειστικά στη χρήση του στρογγυλοποιημένου (z = 1.96) αντί της πλήρους ακρίβειας του.

Power Analysis:

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

n = 3204.715 Είναι το απαραίτητο μέγεθος δείγματος ανά ομάδα. Αυτό σημαίνει ότι για να είναι το πείραμά μας αξιόπιστο, χρειαζόμαστε τουλάχιστον 3204 χρήστες στην ομάδα ελέγχου και άλλους τόσους στην πειραματική ομάδα (συνολικά 6408 χρήστες).

power = 0.8: Είναι η στατιστική ισχύς 80%. Σημαίνει ότι αν η νέα μας εκδοχή είναι όντως καλύτερη, το πείραμα έχει 80% πιθανότητα να το εντοπίσει με επιτυχία και μόνο 20% πιθανότητα να το χάσει (ψευδώς αρνητικό). Αυτό σημαίνει ότι το πείραμα που τρέξαμε είναι εξαιρετικά ισχυρό και τα συμπεράσματά μας απόλυτα ασφαλή.

Μέρος Β’ - Πραγματικά Δεδομένα

#ΑΝΑΛΟΓΙΑ ΣΤΙΣ ΟΜΑΔΕΣ

αναλογία_ομάδων <- ads |>
  count(group) |>
  mutate(pct = n / sum(n))

knitr::kable(αναλογία_ομάδων, digits = 4)

group	n	pct
psa	23524	0.04
ad	564577	0.96

Η αναλογία των ομάδων δεν είναι 50/50. Η συντριπτική πλειοψηφία των χρηστών (περίπου το 96%) στην ομάδα της διαφήμισης (ad) και μόνο ένα μικρό μέρος (4%) στην ομάδα ελέγχου (PSA).

#ΚΑΤΑΝΟΜΗ ΑΝΑ ΗΜΕΡΑ ΕΒΔΟΜΑΔΑΣ
ads |>
  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") +
  scale_y_continuous(labels = percent) +
  labs(title = "Invariant check: κατανομή ανά ημέρα",
       x = NULL, y = "% της ομάδας") +
  theme_minimal()

Εξετάζοντας το ραβδόγραμμα («Invariant check: κατανομή ανά ημέρα»), παρατηρούμε ότι οι μπάρες των δύο ομάδων δεν είναι ίδιες, αναδεικνύοντας ορισμένες συστηματικές χρονικές ανισορροπίες ανάμεσα στα δύο δείγματα

• Καθημερινές (Υπεροχή της ομάδας psa): Η ομάδα ελέγχου (psa - σομόν μπάρα) παρουσιάζει αισθητά υψηλότερα ποσοστά έκθεσης κατά τις καθημερινές, με τη μεγαλύτερη απόκλιση να εντοπίζεται την Πέμπτη (Thursday), την Παρασκευή (Friday) και την Τετάρτη (Wednesday).

• Σαββατοκύριακο (Υπεροχή της ομάδας ad): Αντίθετα, το Σαββατοκύριακο παρατηρείται η αντίστροφη τάση. Η πειραματική ομάδα (ad - γαλάζια μπάρα) εμφανίζει καθαρά μεγαλύτερη συγκέντρωση χρηστών το Σάββατο (Saturday) και την Κυριακή (Sunday) σε σχέση με την ομάδα ελέγχου.

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

print("--- Περιγραφικά Στατιστικά ανά Ομάδα ---")

## [1] "--- Περιγραφικά Στατιστικά ανά Ομάδα ---"

knitr::kable(ads_summary, digits = 5)

group	n	conversions	conversion_rate	se	ci_lower	ci_upper
psa	23524	420	0.01785	0.00086	0.01616	0.01955
ad	564577	14423	0.02555	0.00021	0.02513	0.02596

test <- prop.test(
  x = ads_summary$conversions,
  n = ads_summary$n,
  correct = FALSE
)

test_tidy <- broom::tidy(test) |>
  select(estimate1, estimate2, statistic, p.value,
         conf.low, conf.high)

print("--- Μορφοποιημένο Output του prop.test() με broom::tidy() ---")

## [1] "--- Μορφοποιημένο Output του prop.test() με broom::tidy() ---"

knitr::kable(test_tidy, digits = 5)

estimate1	estimate2	statistic	p.value	conf.low	conf.high
0.01785	0.02555	54.31805	0	-0.00943	-0.00595

Ερμηνεία:

• Σύγκριση Ποσοστών Μετατροπής(CTR): Η ομάδα της πραγματικής διαφήμισης (ad) πέτυχε ποσοστό μετατροπής 2,555% το οποίο είναι σημαντικά υψηλότερο από το 1,785% της ομάδας ελέγχου (psa). Η διαφήμιση έφερε μια απόλυτη αύξηση +0,77 ποσοστιαίων μονάδων.

• Διαστήματα Εμπιστοσύνης (95% CI): Τα διαστήματα εμπιστοσύνης των δύο ομάδων δεν εμφανίζουν καμία επικάλυψη (το ανώτερο όριο της psa είναι 0.01955, το οποίο είναι πολύ χαμηλότερο από το κατώτερο όριο της ad που είναι 0.02513). Αυτό επιβεβαιώνει οπτικά και στατιστικά ότι η ομάδα ad υπερέχει ξεκάθαρα και σταθερά.

# 1. Υπολογισμός στατιστικών ανά ομάδα και ανά ημέρα
daily_summary <- ads |>
  group_by(group, most_ads_day) |>
  summarise(
    n               = n(),
    conversions     = sum(converted),
    conversion_rate = mean(converted),
    se              = sqrt(conversion_rate * (1 - conversion_rate) / n),
    .groups = "drop"
  ) |>
  mutate(
    ci_lower = conversion_rate - 1.96 * se,
    ci_upper = conversion_rate + 1.96 * se
  )

# 2. Δημιουργία Line Plot με Ribbon για τα Διαστήματα Εμπιστοσύνης
ggplot(daily_summary, aes(x = most_ads_day, y = conversion_rate, group = group, color = group, fill = group)) +
  geom_ribbon(aes(ymin = ci_lower, ymax = ci_upper), alpha = 0.15, color = NA) +
  geom_line(linewidth = 1) +
  geom_point(size = 2) +
  scale_y_continuous(labels = percent) +
  labs(
    title = "Conversion Rate ανά Ημέρα της Εβδομάδας με 95% CI",
    x = "Ημέρα (Most Ads Day)",
    y = "Conversion Rate (%)",
    color = "Ομάδα",
    fill = "Ομάδα"
  ) +
  theme_minimal()

Ερμηνεία:

Το διάγραμμα γραμμής με τα 95% διαστήματα εμπιστοσύνης (ribbons) μάς επιτρέπει να αναλύσουμε την απόδοση των δύο ομάδων σε καθημερινή βάση.

• Η ομάδα της πραγματικής διαφήμισης (ad - γαλάζια γραμμή) διατηρεί σταθερά υψηλότερο ποσοστό μετατροπής σε σχέση με την ομάδα ελέγχου (PSA - σομόν γραμμή) και τις 7 ημέρες της εβδομάδας. Η διαφήμιση λειτουργεί θετικά κάθε μέρα.

*Η μεγαλύτερη απόσταση ανάμεσα στις δύο γραμμές εντοπίζεται ξεκάθαρα την Τρίτη. Την ημέρα αυτή, η ομάδα ad σημειώνει μια από τις κορυφές της (πάνω από 3,0%), ενώ η ομάδα PSA πέφτει σε ένα από τα χαμηλότερα επίπεδά της (γύρω στο 1,45%), κάνοντας το χάσμα μεταξύ τους το μέγιστο της εβδομάδας. Πολύ μεγάλη διαφορά παρατηρείται επίσης και τη Δευτέρα.