Exam 1

Part 1

set.seed(13)
means<-c()
for (i in 1:1000){
sample<-rnorm(55, 10, 2.4)
means[i]<-mean(sample)

}

sd(sample)

## [1] 2.306867

sd(means)

## [1] 0.320393

mean(sample)

## [1] 10.16269

Difference In Means Decompoistion

\[\frac{1}{n_T}\sum_{i=1}^{n_T}(y_i|d_i=1)-\frac{1}{n_c}\sum_{i=1}^{n_C}(y_i|d_i=0)=E[Y^1]-E[Y^0]+E[Y^0|D=1]-E[Y^0|D=0]+(1-\pi)(ATT-ATU)\]

Bank Data

Test 1

library(tidyverse)
tertiary<- df %>% filter(education=="tertiary")
tertiary %>% group_by(version, y) %>% summarise(n=n()) %>% mutate(freq=n/sum(n))

## # A tibble: 4 × 4
## # Groups:   version [2]
##   version y         n  freq
##   <chr>   <chr> <int> <dbl>
## 1 A       no     5709 0.858
## 2 A       yes     948 0.142
## 3 B       no     5596 0.842
## 4 B       yes    1048 0.158

prop.test(x=c(948, 1048), n=c(5709+948,  5596+1048))

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(948, 1048) out of c(5709 + 948, 5596 + 1048)
## X-squared = 6.0072, df = 1, p-value = 0.01425
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.02761645 -0.00304318
## sample estimates:
##    prop 1    prop 2 
## 0.1424065 0.1577363

Test 2

age<-df %>% filter(age>35)
age %>% group_by(version, loan) %>% summarise(n=n()) %>% mutate(freq=n/sum(n))

## # A tibble: 4 × 4
## # Groups:   version [2]
##   version loan      n  freq
##   <chr>   <chr> <int> <dbl>
## 1 A       no    12049 0.840
## 2 A       yes    2290 0.160
## 3 B       no    11740 0.841
## 4 B       yes    2225 0.159

prop.test(x=c(2290, 2225), n=c(12049+2290,  11740+ 2225))

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(2290, 2225) out of c(12049 + 2290, 11740 + 2225)
## X-squared = 0.004965, df = 1, p-value = 0.9438
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.008225355  0.008980183
## sample estimates:
##    prop 1    prop 2 
## 0.1597043 0.1593269

Test 3

age<-df %>% filter(age>35)
age %>% group_by(version, y) %>% summarise(n=n()) %>% mutate(freq=n/sum(n))

## # A tibble: 4 × 4
## # Groups:   version [2]
##   version y         n  freq
##   <chr>   <chr> <int> <dbl>
## 1 A       no    12807 0.893
## 2 A       yes    1532 0.107
## 3 B       no    12397 0.888
## 4 B       yes    1568 0.112

prop.test(x=c(1532 ,1568 ), n=c(12807+1532,12397+ 1568))

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(1532, 1568) out of c(12807 + 1532, 12397 + 1568)
## X-squared = 2.0907, df = 1, p-value = 0.1482
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.012788837  0.001910396
## sample estimates:
##    prop 1    prop 2 
## 0.1068415 0.1122807

Amazon Tests

Preliminaries

First the Analysts at Amazon completed a preliminary sample size study. They were interested in finding a difference in click through rates of 5%. Their current click through rate is 3.45%

power.t.test(n=NULL, sig.level = 0.05, power=0.8, delta = 0.05)

## 
##      Two-sample t test power calculation 
## 
##               n = 6280.064
##           delta = 0.05
##              sd = 1
##       sig.level = 0.05
##           power = 0.8
##     alternative = two.sided
## 
## NOTE: n is number in *each* group

power.prop.test(n=NULL, sig.level = 0.05, power=0.8, p1=0.0345, p2=0.036225)

## 
##      Two-sample comparison of proportions power calculation 
## 
##               n = 179954.9
##              p1 = 0.0345
##              p2 = 0.036225
##       sig.level = 0.05
##           power = 0.8
##     alternative = two.sided
## 
## NOTE: n is number in *each* group

Summary

head(df)

##   a b
## 1 0 0
## 2 0 0
## 3 0 0
## 4 0 0
## 5 0 0
## 6 0 0

df %>% group_by(variant) %>% summarise("mean"=mean(click), "sd"=sd(click), "count"=n())

## # A tibble: 2 × 4
##   variant   mean    sd count
##   <chr>    <dbl> <dbl> <int>
## 1 a       0.0329 0.178  5014
## 2 b       0.0215 0.145  5014

df %>% group_by(variant, click) %>%  summarise(n = n()) %>%
  mutate(freq = n / sum(n))

## # A tibble: 4 × 4
## # Groups:   variant [2]
##   variant click     n   freq
##   <chr>   <int> <int>  <dbl>
## 1 a           0  4849 0.967 
## 2 a           1   165 0.0329
## 3 b           0  4906 0.978 
## 4 b           1   108 0.0215

Analysis

t.test(df$click~df$variant)

## 
##  Welch Two Sample t-test
## 
## data:  df$click by df$variant
## t = 3.4995, df = 9628.5, p-value = 0.0004682
## alternative hypothesis: true difference in means between group a and group b is not equal to 0
## 95 percent confidence interval:
##  0.005000443 0.017735895
## sample estimates:
## mean in group a mean in group b 
##      0.03290786      0.02153969

prop.test(x=c(165, 108), n=c(5014,5014))

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(165, 108) out of c(5014, 5014)
## X-squared = 11.809, df = 1, p-value = 0.0005896
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  0.004802437 0.017933902
## sample estimates:
##     prop 1     prop 2 
## 0.03290786 0.02153969

MSBA Ad Problem

df<-read.csv("https://raw.githubusercontent.com/weeseml/ISA633/refs/heads/main/msba.csv")
df %>% group_by(variant, conversion) %>% summarise(n=n()) %>% mutate(freq=n/sum(n))

## # A tibble: 4 × 4
## # Groups:   variant [2]
##   variant   conversion     n   freq
##   <chr>          <int> <int>  <dbl>
## 1 control            0 41380 0.962 
## 2 control            1  1620 0.0377
## 3 treatment          0 41435 0.959 
## 4 treatment          1  1783 0.0413

prop.test(x=c(1620, 1783), n=c(1620+41380, 1783+41435))

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(1620, 1783) out of c(1620 + 41380, 1783 + 41435)
## X-squared = 7.1987, df = 1, p-value = 0.007296
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.0062037104 -0.0009593687
## sample estimates:
##     prop 1     prop 2 
## 0.03767442 0.04125596

set.seed(13)
iter=100000
a=1620 +1
b=41380+1
a1=1783 +1
b1=41435+1
count<-c()
for (i in 1:iter){
A<-rbeta(1, a, b)
B<-rbeta(1, a1, b1)
count[i]<-ifelse(A>B, 1, 0)


}
pdiff<-sum(count)/iter
pdiff

## [1] 0.00359

Nike Footballverse

head(df)

## # A tibble: 6 × 3
##   region treatment engagement
##   <chr>  <chr>          <dbl>
## 1 SE     video1          5.91
## 2 SE     video2          3.14
## 3 SE     video3          6.92
## 4 SE     video4          5.07
## 5 SE     video5          3.79
## 6 SE     video1          4.24

boxplot(engagement~treatment, data=df)

df %>% group_by(treatment) %>% summarize("mean"=mean(engagement), "sd"=sd(engagement), "count"=n())

## # A tibble: 5 × 4
##   treatment  mean    sd count
##   <chr>     <dbl> <dbl> <int>
## 1 video1     4.06  2.09  4500
## 2 video2     4.82  1.98  4500
## 3 video3     4.98  2.02  4500
## 4 video4     4.90  2.05  4500
## 5 video5     5.05  2.01  4500

##                Df Sum Sq Mean Sq F value Pr(>F)    
## treatment       1   1936  1936.5   470.9 <2e-16 ***
## region          2   1158   579.0   140.8 <2e-16 ***
## Residuals   22496  92511     4.1                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

##                Df Sum Sq Mean Sq F value Pr(>F)    
## treatment       1   1936  1936.5   465.1 <2e-16 ***
## Residuals   22498  93669     4.2                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

##                Df Sum Sq Mean Sq F value Pr(>F)    
## treatment       4   2931   732.7   180.1 <2e-16 ***
## region          2   1158   579.0   142.3 <2e-16 ***
## Residuals   22493  91516     4.1                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

##                Df Sum Sq Mean Sq F value Pr(>F)    
## treatment       4   2931   732.7   177.9 <2e-16 ***
## Residuals   22495  92674     4.1                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

library(multcomp)
plot(glht(mod, linfct = mcp(treatment = "Tukey")))

Asics

Asics ran a test to compare the addition of two buttons. In the control the button contained a “View Cart and Checkout” button that lead users to the cart page. In the variation the button showed separate “View Cart” and “Checkout” buttons. They measured the user spend.

Analysis 1

## # A tibble: 2 × 4
##   variant  mean    sd count
##   <chr>   <dbl> <dbl> <int>
## 1 A        10.6  29.9  3401
## 2 B        11.1  31.2  3426

boxplot(user_spend~variant, data=df)

t.test(user_spend~variant, data=df)

## 
##  Welch Two Sample t-test
## 
## data:  user_spend by variant
## t = -0.69073, df = 6815.7, p-value = 0.4898
## alternative hypothesis: true difference in means between group A and group B is not equal to 0
## 95 percent confidence interval:
##  -1.9601047  0.9386885
## sample estimates:
## mean in group A mean in group B 
##        10.57423        11.08494

An alternative test.

set.seed(13)

# Sample data for two groups
groupA <- df$user_spend[df$variant=="A"]
groupB <- df$user_spend[df$variant=="B"]

# Observed test statistic
observed_statistic <- mean(groupA) - mean(groupB)

# Number of random permutations
num_permutations <- 1000

# Initialize an empty vector to store permutation test statistics
permutation_stats <- numeric(num_permutations)

# Perform random permutations and calculate test statistics
for (i in 1:num_permutations) {
  # Combine the data and shuffle the order
  combined_data <- c(groupA, groupB)
  shuffled_data <- sample(combined_data, replace = FALSE)
  
  # Calculate the test statistic for this permutation
  perm_statistic <- mean(shuffled_data[1:length(groupA)]) - mean(shuffled_data[(length(groupA) + 1):(length(groupA) + length(groupB))])
  
  # Store the permutation test statistic
  permutation_stats[i] <- perm_statistic
}

# Calculate the p-value
p_value <- mean(abs(permutation_stats) >= abs(observed_statistic))

# Display the p-value
cat("P-value:", p_value, "\n")

## P-value: 0.464

B<-df %>% filter(variant=="B")
t.test(user_spend, data=df)

## 
##  One Sample t-test
## 
## data:  user_spend
## t = 29.293, df = 6826, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  10.10574 11.55530
## sample estimates:
## mean of x 
##  10.83052

Analysis 2

nonzero<-df %>% filter(user_spend>0)
boxplot(user_spend~variant, data=nonzero)

t.test(user_spend~variant, data=nonzero)

## 
##  Welch Two Sample t-test
## 
## data:  user_spend by variant
## t = -3.4901, df = 793.13, p-value = 0.0005094
## alternative hypothesis: true difference in means between group A and group B is not equal to 0
## 95 percent confidence interval:
##  -7.866999 -2.203209
## sample estimates:
## mean in group A mean in group B 
##         89.9074         94.9425

B<-nonzero %>% filter(variant=="B")
t.test(user_spend, data=B)

## 
##  One Sample t-test
## 
## data:  user_spend
## t = 29.293, df = 6826, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  10.10574 11.55530
## sample estimates:
## mean of x 
##  10.83052

AirBnB

df_long %>% group_by(treatment, reservation) %>% summarise(n=n()) %>% mutate(freq=n/sum(n))

## # A tibble: 8 × 4
## # Groups:   treatment [4]
##   treatment reservation     n   freq
##   <fct>           <int> <int>  <dbl>
## 1 A                   0  3811 0.953 
## 2 A                   1   189 0.0472
## 3 B                   0  3808 0.952 
## 4 B                   1   192 0.048 
## 5 C                   0  3774 0.944 
## 6 C                   1   226 0.0565
## 7 D                   0  3745 0.936 
## 8 D                   1   255 0.0638

mod<-glm(reservation~treatment, data=df_long, family="binomial")
summary(mod)

## 
## Call:
## glm(formula = reservation ~ treatment, family = "binomial", data = df_long)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -3.00390    0.07452 -40.313  < 2e-16 ***
## treatmentB   0.01654    0.10499   0.158  0.87485    
## treatmentC   0.18854    0.10120   1.863  0.06246 .  
## treatmentD   0.31699    0.09870   3.212  0.00132 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 6712.7  on 15999  degrees of freedom
## Residual deviance: 6698.5  on 15996  degrees of freedom
## AIC: 6706.5
## 
## Number of Fisher Scoring iterations: 5

anova(mod, test="Chisq")

## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: reservation
## 
## Terms added sequentially (first to last)
## 
## 
##           Df Deviance Resid. Df Resid. Dev Pr(>Chi)   
## NULL                      15999     6712.7            
## treatment  3   14.174     15996     6698.5 0.002678 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1