Study2A_Never_Testing_Bias_By_Preference.R

####################################
# Never Testing Bias By Preference #
####################################

# Import Libraries
library("tidyverse")
library('DescTools') # used for "BinomCI" function 

# Import data
Never_Testing_Bias_by_Preference <- read.csv("Study2A_Never_Testing_Bias_by_Preference.csv")

# Preview data
head(Never_Testing_Bias_by_Preference)

# data dictionary:
## "Participant" = participant number
## "Function" = Function number (range 1-6; refer to payoff function figure)
## "Preferred_Policy_at_Start" = notes if randomized to preferred policy at start (or not), as well as if a policy was "neutral" in regards to participant preference. 
## "Policy_Changes" = count of number of times a policy/function was tested/changed at conclusion of learning task.
## "Did_Not_Test" = notes if participant never tested/changed a policy/function (1 = never tested; 0 = tested at least once)

# What percent of policies were never tested? 
mean(Never_Testing_Bias_by_Preference$Did_Not_Test) # 4.55% 

##############################################
# restructure data for proportional analyses #
##############################################

#########################
# proportional analyses #
#########################

# new dataframe that counts the total number of policies/functions that were not tested, by preference at start (preferred vs non-preferred vs neutral)
ntb_agg <- aggregate(Never_Testing_Bias_by_Preference$Did_Not_Test, 
                     by=list(Never_Testing_Bias_by_Preference$Preferred_Policy_at_Start, 
                             Never_Testing_Bias_by_Preference$Participant),sum)
names(ntb_agg) <- c("PP_at_Start_Text", "Participant", "DidnotTest")
ntb_agg <- as_tibble(ntb_agg)

# Preview data (intermediate step in data prep)
head(ntb_agg)

# restructure data so one participant per row
ntb_agg2 <- spread(ntb_agg, key=PP_at_Start_Text, DidnotTest, fill='n/a', convert=FALSE)
ntb_agg2$Neutral <- as.integer(ntb_agg2$Neutral)
ntb_agg2$Preferred <- as.integer(ntb_agg2$Preferred) # okay to ignore warning "NAs introduced by coercion"
ntb_agg2$NonPreferred <- as.integer(ntb_agg2$NonPreferred) # okay to ignore warning "NAs introduced by coercion"
ntb_agg2 <- as_tibble(ntb_agg2)

# Preview data (intermediate step in data prep)
head(ntb_agg2)

##############################
# Preferred vs Non-Preferred #
##############################

ntb_agg2_pref_vs_nonpref <- ntb_agg2
ntb_agg2_pref_vs_nonpref$Neutral <- NULL

# Create McNemar 2x2 scoring 

# 'a' cell: did not test occurred in both groups (nonpreferred & preferred at start)
ntb_agg2_pref_vs_nonpref$a <- ifelse(ntb_agg2_pref_vs_nonpref$NonPreferred>=1 &
                                       ntb_agg2_pref_vs_nonpref$Preferred>=1,
                                     1, 0)
# 'b' cell: did not test occurred in only one group (nonpreferred at start)
ntb_agg2_pref_vs_nonpref$b <- ifelse(ntb_agg2_pref_vs_nonpref$NonPreferred>=1 &
                                       ntb_agg2_pref_vs_nonpref$Preferred==0,
                                     1, 0)

# 'c' cell: did not test occurred in only one group (preferred at start)
ntb_agg2_pref_vs_nonpref$c <- ifelse(ntb_agg2_pref_vs_nonpref$NonPreferred==0 &
                                       ntb_agg2_pref_vs_nonpref$Preferred>=1,
                                     1, 0)

# 'd' cell: did not test occurred in neither group 
ntb_agg2_pref_vs_nonpref$d <- ifelse(ntb_agg2_pref_vs_nonpref$NonPreferred==0 &
                                       ntb_agg2_pref_vs_nonpref$Preferred==0,
                                     1, 0)

ntb_agg2_pref_vs_nonpref$omit <- ifelse(is.na(ntb_agg2_pref_vs_nonpref$NonPreferred)==TRUE |
                                          is.na(ntb_agg2_pref_vs_nonpref$Preferred)==TRUE,
                                        "Omit", "Valid")

ntb_agg2_pref_vs_nonpref__valid <- ntb_agg2_pref_vs_nonpref %>% 
  filter(omit=="Valid")
sum(ntb_agg2_pref_vs_nonpref__valid$a) # count: 0
sum(ntb_agg2_pref_vs_nonpref__valid$b) # count: 0
sum(ntb_agg2_pref_vs_nonpref__valid$c) # count: 10
sum(ntb_agg2_pref_vs_nonpref__valid$d) # count: 47
length(unique(ntb_agg2_pref_vs_nonpref__valid$Participant)) # N = 57


# Create matrix for McNemar's test
ntb_matrix <- matrix(c(
  sum(ntb_agg2_pref_vs_nonpref__valid$a),  # cell a
  sum(ntb_agg2_pref_vs_nonpref__valid$b),  # cell b
  sum(ntb_agg2_pref_vs_nonpref__valid$c),  # cell c
  sum(ntb_agg2_pref_vs_nonpref__valid$d)), # cell d
  nrow=2,
  dimnames=list(
    "Preferred" = c("Did not Test", "Tested"),
    "NonPreferred" = c("Did not Test", "Tested")))
ntb_matrix

# run analysis
mcnemar.test(ntb_matrix) # McNemar’s χ2(1) = 8.10, p = .004


# binomial probabilities 

# switching a non-preferred policy to a preferred policy 
round(BinomCI(0, 57, # (cell A + cell B, Cell D) 
              conf.level = 0.95, method = "clopper-pearson"),4)*100 # non-preferred
# output:
# est lwr.ci upr.ci
# [1,]   0      0   6.27

# switching a preferred policy to a non-preferred policy 
round(BinomCI(10, 57, # (cell A + cell B, Cell D) 
              conf.level = 0.95, method = "clopper-pearson"),4)*100 # preferred
# output:
# est lwr.ci upr.ci
# [1,] 17.54   8.75  29.91

#-----------------------------------------

###########################################
# Strong Preference vs Neutral Preference #
###########################################

# Inclusion criteria: 
# Participants generally had 3 neutral and 3 strong belief policies.
# However, due to the randomization design, it was possible to have 3 preferred at start (or non-preferred)
# and 0 non-preferred at start (or preferred). 
# Participants that had 0/3 for (non)preferred were omitted for analysis.

# Processing list of participants which can be included... [below code]
# long format
ntb <- Never_Testing_Bias_by_Preference
temp <- aggregate(ntb$Preferred_Policy_at_Start, list(ntb$Participant, ntb$Preferred_Policy_at_Start),length)

# wide format
ntb_randomization <- temp %>% 
  spread(Group.2, x)
names(ntb_randomization) <- c("Participant", "Neutral", "NonPreferred", "Preferred")

View(ntb_randomization) # column values are counts of randomization outcomes. 

ntb_r_ok <- ntb_randomization %>% 
  filter(!is.na(NonPreferred)) %>% 
  filter(!is.na(Preferred))

ntb_r_ok_Participants <- ntb_r_ok$Participant # use this list of Participants as acceptable for analysis

# Subset dataframe to only include participants that meet inclusion criteria
ntb_analysis <- ntb_agg2 %>% 
  filter(Participant %in% ntb_r_ok_Participants)

# Sum preferred and nonpreferred into "strong preference"
ntb_analysis$StrongPref <- ntb_analysis$NonPreferred+ntb_analysis$Preferred
sum(ntb_analysis$StrongPref) # 12
sum(ntb_analysis$Neutral) # 9
length(ntb$DidnotTest) # 0 

# Not excluding anyone, there was 24 instances of not testing across all participants 
# (out of 528 opportunities [88participants*6policies])
# This means that the included participants of 12 instances for strong pref
# and 9 instances for neutral pref, are omitting 3 instances of 'not testing behavior'

ntb_analysis2 <- select(ntb_analysis, Participant, Neutral, StrongPref)
ntb_analysis2$Neutral_Coded <- ifelse(ntb_analysis2$Neutral>=1, 1,0)
ntb_analysis2$StrongPref_Coded <- ifelse(ntb_analysis2$StrongPref>=1, 1,0)

sum(ntb_analysis2$StrongPref_Coded) # 10
sum(ntb_analysis2$Neutral_Coded) # 7


###################################
# Strong vs weak McNemar Analysis #
#    Create McNemar 2x2 scoring   #
###################################

ntb_analysis3 <- select(ntb_analysis2, Participant, Neutral_Coded, StrongPref_Coded)

# 'a' cell: did not test occurred in both groups (neutral & Strong Preference)
ntb_analysis3$a <- ifelse(ntb_analysis3$Neutral_Coded==1 &
                            ntb_analysis3$StrongPref_Coded==1,
                          1, 0)

# 'b' cell: did not test occurred in only one group (neutral)
ntb_analysis3$b <- ifelse(ntb_analysis3$Neutral_Coded==1 &
                            ntb_analysis3$StrongPref_Coded==0,
                          1, 0)

# 'c' cell: did not test occurred in only one group (Strong preference)
ntb_analysis3$c <- ifelse(ntb_analysis3$Neutral_Coded==0 &
                            ntb_analysis3$StrongPref_Coded==1,
                          1, 0)

# 'd' cell: did not test occurred in neither group
ntb_analysis3$d <- ifelse(ntb_analysis3$Neutral_Coded==0 &
                            ntb_analysis3$StrongPref_Coded==0,
                          1, 0)

sum(ntb_analysis3$a) # 5
sum(ntb_analysis3$b) # 2
sum(ntb_analysis3$c) # 5
sum(ntb_analysis3$d) # 45
length(unique(ntb_analysis3$Participant)) # N = 57


# Create matrix for McNemar's test
ntb_matrix <- matrix(c(
  sum(ntb_analysis3$a),  # cell a
  sum(ntb_analysis3$b),  # cell b
  sum(ntb_analysis3$c),  # cell c
  sum(ntb_analysis3$d)), # cell d
  nrow=2,
  dimnames=list(
    "StrongPref" = c("Did not Test", "Tested"),
    "Neutral" = c("Did not Test", "Tested")))

# View Matrix
ntb_matrix

# run analysis
mcnemar.test(ntb_matrix) # McNemar's X2(1) = .57, p = .450


# switching a neutral policy to a competing neutral policy 
round(BinomCI(sum(ntb_analysis3$a, ntb_analysis3$b), # 7 
              sum(ntb_analysis3$a, ntb_analysis3$b, ntb_analysis3$c, ntb_analysis3$d), # 57 
              conf.level = 0.95, method = "clopper-pearson"),4)*100 
# output:
# est lwr.ci upr.ci
# [1,] 12.28   5.08  23.68


# switching a strong-preference policy to a competing strong-preference policy 
round(BinomCI(sum(ntb_analysis3$a, ntb_analysis3$c), # 10 
              sum(ntb_analysis3$a, ntb_analysis3$b, ntb_analysis3$c, ntb_analysis3$d), # 57
              conf.level = 0.95, method = "clopper-pearson"),4)*100 
# output:
# est lwr.ci upr.ci
# [1,] 17.54   8.75  29.91