Study1_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("Study1_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)
## "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) 

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

# new dataframe that counts the total number of policies/functions that were not tested, by preference at start (preferred vs non-preferred)
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)
names(ntb_agg2) <- c('Participant', 'NonPreferred', 'Preferred')
ntb_agg2$Preferred <- as.integer(ntb_agg2$Preferred)
ntb_agg2$NonPreferred <- as.integer(ntb_agg2$NonPreferred)
ntb_agg2 <- as_tibble(ntb_agg2)

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

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

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

# rename to note analysis 
ntb_agg2_pref_vs_nonpref <- ntb_agg2


# 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: 1
sum(ntb_agg2_pref_vs_nonpref__valid$b) # count: 1
sum(ntb_agg2_pref_vs_nonpref__valid$c) # count: 11
sum(ntb_agg2_pref_vs_nonpref__valid$d) # count: 28
length(unique(ntb_agg2_pref_vs_nonpref__valid$Participant)) # N = 41


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

# View Matrix
ntb_matrix

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


# binomial probabilities 

# switching a non-preferred policy to a preferred policy
round(BinomCI(ntb_matrix[1,1]+ntb_matrix[2,1], # sum of cell a + cell b 
              sum(ntb_matrix), 
              conf.level = 0.95, method = "clopper-pearson"),4)*100 
# output: 
# est lwr.ci upr.ci
# [1,] 4.88    0.6  16.53


# switching a preferred policy to a non-preferred policy
round(BinomCI(ntb_matrix[1,1]+ntb_matrix[1,2], # sum of cell a + cell c 
              sum(ntb_matrix), # sum of all cells in matrix
              conf.level = 0.95, method = "clopper-pearson"),4)*100 
# output:
# est lwr.ci upr.ci
# [1,] 29.27  16.13  45.54

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