Δεδομένου πως το σετ δεδομένων αναφέρει 2 εκδόσεις και αυτές αλλάζουν μεταξύ των εγγραφών, έχοντας στατιστικά για 1 και 7 μέρες μετά την αλλαγή, είναι προφανές πως θα χρησιμοποιήσω A/B Testing, καθώς μελετάται η επίδραση της αλλαγής από το gate level 30 σε gate level 40.
str(df)
## spc_tbl_ [90,189 × 5] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ userid : num [1:90189] 116 337 377 483 488 ...
## $ version : chr [1:90189] "gate_30" "gate_30" "gate_40" "gate_40" ...
## $ sum_gamerounds: num [1:90189] 3 38 165 1 179 187 0 2 108 153 ...
## $ retention_1 : logi [1:90189] FALSE TRUE TRUE FALSE TRUE TRUE ...
## $ retention_7 : logi [1:90189] FALSE FALSE FALSE FALSE TRUE TRUE ...
## - attr(*, "spec")=
## .. cols(
## .. userid = col_double(),
## .. version = col_character(),
## .. sum_gamerounds = col_double(),
## .. retention_1 = col_logical(),
## .. retention_7 = col_logical()
## .. )
## - attr(*, "problems")=<externalptr>
summary(df)
## userid version sum_gamerounds retention_1
## Min. : 116 Length:90189 Min. : 0.00 Mode :logical
## 1st Qu.:2512230 Class :character 1st Qu.: 5.00 FALSE:50036
## Median :4995815 Mode :character Median : 16.00 TRUE :40153
## Mean :4998412 Mean : 51.87
## 3rd Qu.:7496452 3rd Qu.: 51.00
## Max. :9999861 Max. :49854.00
## retention_7
## Mode :logical
## FALSE:73408
## TRUE :16781
##
##
##
cat("To dataset εχει ", nrow(df)," εγγραφές")
## To dataset εχει 90189 εγγραφές
df |>
count(version, retention_1) |>
group_by(version) |>
mutate(pct = n / sum(n)) |>
ggplot(aes(x = retention_1, y = pct, fill = version)) +
geom_col(position = "dodge") +
scale_y_continuous(labels = percent) +
labs(title = "Κατανομή για 1 μέρα",
x = NULL, y = "% της ομάδας") +
theme_minimal()
Ουσιαστικά από το παραπάνω διάγραμμα φαίνεται πως το ποσοστό διατήρησης για την πρώτη βδομάδα είναι περίπου 45% για gate 30 ενώ 44% για gate 40.
df |>
count(version, retention_7) |>
group_by(version) |>
mutate(pct = n / sum(n)) |>
ggplot(aes(x = retention_7, y = pct, fill = version)) +
geom_col(position = "dodge") +
scale_y_continuous(labels = percent) +
labs(title = "Κατανομή για 7 μέρα",
x = NULL, y = "% της ομάδας") +
theme_minimal()
Εδώ είναι 19% η διατήρηση για το gate_30 και 18% για το gate_40.
summary_stats1 <- df |>
group_by(version) |>
summarise(
n = n(),
retention = sum(retention_1),
rp = mean(retention_1),
se = sqrt(rp * (1 - rp) / n),
ci_lower = rp - 1.96 * se,
ci_upper = rp + 1.96 * se
)
summary_stats1
## # A tibble: 2 × 7
## version n retention rp se ci_lower ci_upper
## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 gate_30 44700 20034 0.448 0.00235 0.444 0.453
## 2 gate_40 45489 20119 0.442 0.00233 0.438 0.447
Από τον πίνακα αυτό φαίνεται ανά έκδοση η διατήρηση για την 1η μέρα.
retention1 <- c(summary_stats1$retention[1], summary_stats1$retention[2])
players1 <- c(summary_stats1$n[1], summary_stats1$n[2])
test_result <- prop.test(
x = retention1,
n = players1,
conf.level = 0.95,
correct = FALSE # χωρίς Yates correction (ταιριάζει με τον τύπο μας)
)
test_result
##
## 2-sample test for equality of proportions without continuity correction
##
## data: retention1 out of players1
## X-squared = 3.183, df = 1, p-value = 0.07441
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.0005820999 0.0123924394
## sample estimates:
## prop 1 prop 2
## 0.4481879 0.4422827
Από το παραπάνω φαίνεται πως η αλλαγή για την πρώτη μέρα είναι οριακά στατιστικά σημαντική, βγαίνοντας για λίγο από το α=0,05, ωστόσο λόγω του γεγονότος πως το p-value ισούται με 0.07441 τότε μπορούμε να πούμε πως δεν είναι 100% ασφαλής αλλά δεν είναι και τυχαίο.
summary_stats2 <- df |>
group_by(version) |>
summarise(
n = n(),
retention = sum(retention_7),
rp = mean(retention_7),
se = sqrt(rp * (1 - rp) / n),
ci_lower = rp - 1.96 * se,
ci_upper = rp + 1.96 * se
)
summary_stats2
## # A tibble: 2 × 7
## version n retention rp se ci_lower ci_upper
## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 gate_30 44700 8502 0.190 0.00186 0.187 0.194
## 2 gate_40 45489 8279 0.182 0.00181 0.178 0.186
Από τον πίνακα αυτό φαίνεται ανά έκδοση η διατήρηση για την 7η μέρα.
retention2 <- c(summary_stats2$retention[1], summary_stats2$retention[2])
players2 <- c(summary_stats2$n[1], summary_stats2$n[2])
test_result <- prop.test(
x = retention2,
n = players2,
conf.level = 0.95,
correct = FALSE # χωρίς Yates correction (ταιριάζει με τον τύπο μας)
)
test_result
##
## 2-sample test for equality of proportions without continuity correction
##
## data: retention2 out of players2
## X-squared = 10.013, df = 1, p-value = 0.001554
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## 0.003121044 0.013281552
## sample estimates:
## prop 1 prop 2
## 0.1902013 0.1820000
Από το παραπάνω φαίνεται πως η αλλαγή για την 7η μέρα είναι στατιστικά σημαντική, λόγω του γεγονότος πως το p-value ισούται με 0.001554 τότε μπορούμε να πούμε πως είναι 100% στατιστικά σημαντική.
effect_size <- ES.h(p1 = 0.4422827, p2 = 0.4481879)
cat(sprintf("Cohen's h = %.4f\n", effect_size))
## Cohen's h = -0.0119
# Υπολογισμός απαιτούμενου μεγέθους δείγματος ανά ομάδα
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.01188196
## n = 111188.7
## sig.level = 0.05
## power = 0.8
## alternative = two.sided
##
## NOTE: same sample sizes
Εδώ θα πρέπει το effect size να είναι 111.188 και στην πραγματικότητα είναι 90.189. Αυτό σημαίνει πως το δείγμα είναι κατά αρκετά μικρότερο ούτως ώστε να ανιχνευτεί το effect.
effect_size <- ES.h(p1 = 0.1902013 , p2 = 0.1820000 )
cat(sprintf("Cohen's h = %.4f\n", effect_size))
## Cohen's h = 0.0211
# Υπολογισμός απαιτούμενου μεγέθους δείγματος ανά ομάδα
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.02107401
## n = 35346.17
## sig.level = 0.05
## power = 0.8
## alternative = two.sided
##
## NOTE: same sample sizes
Εδώ θα πρέπει το effect size να είναι 35.346 και στην πραγματικότητα είναι 90.189. Αυτό σημαίνει πως το δείγμα είναι κατά αρκετά μεγαλύτερο, και άρα ανιχνέυεται το effect.
Επίσης από τα δύο παραπάνω είναι εμφανές πως μεταξύ των δύο ημερών υπάρχει διαφορά μεταξύ των δύο gates, καθώς στην 7η μέρα το δείγμα και επάρκει για την ανίχνευση της διαφοράς και το p-value είναι μικρότερο του 0,05. Για την 1η μέρα δεν επαρκεί το effect size και η στατιστική σημαντικότητα της διαφορά των αποτελεσμάτων δεν είναι τόσο δυνατή.
# 1. Pooled estimate
p_pool <- sum(retention1) / sum(players1)
# 2. Pooled standard error
se_pool <- sqrt(p_pool * (1 - p_pool) *
(1/players1[1] + 1/players1[2]))
# 3. Διαφορά και διάστημα εμπιστοσύνης
delta <- summary_stats1$rp[2] - summary_stats1$rp[1]
m <- 1.96 * se_pool
cat(sprintf("Pooled p̂ = %.4f\n", p_pool))
## Pooled p̂ = 0.4452
cat(sprintf("Pooled SE = %.4f\n", se_pool))
## Pooled SE = 0.0033
cat(sprintf("δ = %.4f\n", delta))
## δ = -0.0059
cat(sprintf("95%% CI for δ: [%.4f, %.4f]\n", delta - m, delta + m))
## 95% CI for δ: [-0.0124, 0.0006]
# Επιχειρηματική απόφαση
delta_min <- 0.01 # κατώφλι επιχειρηματικής ουσίας
if (delta - m > delta_min) {
cat("✅ ΣΥΜΠΕΡΑΣΜΑ: Υλοποιήστε την αλλαγή!\n")
} else {
cat("⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.\n")
}
## ⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.
Από τον παραπάνω κώδικα φαίνεται πως για την πρώτη μέρα το διάστημα εμπιστοσύνης με 95% για δ είναι [-0.0124, 0.0006].
# 1. Pooled estimate
p_pool <- sum(retention2) / sum(players2)
# 2. Pooled standard error
se_pool <- sqrt(p_pool * (1 - p_pool) *
(1/players2[1] + 1/players2[2]))
# 3. Διαφορά και διάστημα εμπιστοσύνης
delta <- summary_stats2$rp[2] - summary_stats2$rp[1]
m <- 1.96 * se_pool
cat(sprintf("Pooled p̂ = %.4f\n", p_pool))
## Pooled p̂ = 0.1861
cat(sprintf("Pooled SE = %.4f\n", se_pool))
## Pooled SE = 0.0026
cat(sprintf("δ = %.4f\n", delta))
## δ = -0.0082
cat(sprintf("95%% CI for δ: [%.4f, %.4f]\n", delta - m, delta + m))
## 95% CI for δ: [-0.0133, -0.0031]
# Επιχειρηματική απόφαση
delta_min <- 0.01 # κατώφλι επιχειρηματικής ουσίας
if (delta - m > delta_min) {
cat("✅ ΣΥΜΠΕΡΑΣΜΑ: Υλοποιήστε την αλλαγή!\n")
} else {
cat("⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.\n")
}
## ⚠️ ΣΥΜΠΕΡΑΣΜΑ: Στατιστικά σημαντικό αλλά χωρίς επιχειρηματική ουσία.
Από τον παραπάνω κώδικα φαίνεται πως για την πρώτη μέρα το διάστημα εμπιστοσύνης με 95% για δ είναι [-0.0133, -0.0031].
Δεδομένου πως για την πρώτη μέρα μετά την αλλαγή το CI της διαφοράς περίεχει το μηδέν και ξεπερνά το -delta_min θα πρέπει να είμαστε επιφυλακτικοί. Ωστόσο το p_value>α προσδίδει μια τυχαιότητα στα αποτελέσματα οπότε δεν προτείνεται η αλλαγή λόγω μη απόλυτης σιγουριάς.
Για την 7η μέρα το CI της διαφοράς είναι όλο μικρότερο του 0 (άρα δεν το εμπεριέχει) και περιέχει το +- delta_min. Συνεπώς ΔΕΝ προτείνεται η εφαρμογή της αλλαγής. Δεδομένου πως στην 7η μέρα αναγνωρίζεται αυτό, τότε συνολικά ΔΕΝ προτείνεται η αλλαγή της πύλης.
Αν αλλάξει η πύλη, δεδομένου πως σε όλες τις περιπτώσεις η αλλαγή (gate 40) δείχνει να έχει ελαφρώς χειρότερα αποτελέσματα και για τις δύο μέρες, η ενδεχόμενη αλλαγή της θα οδηγούσε σε μειώση της διατήρησης των παικτών στο μέλλον. σ