suppressMessages(library(readxl))
suppressMessages(library(dplyr))
suppressMessages(library(ggplot2))
suppressMessages(library(R6))
# Read in experimental data from an Excel file and convert to a data frame
data <- read_excel("/Users/robertvargas/Documents/School/Purdue/Experimental Econ/Module 2 Data.xlsx")
df = as.data.frame(data)
colnames(df) <- c('Round', 'Participant', 'Decision')
# Define model parameters as described in lecture
V = 10 # Value of volunteering
L = 2 # Loss from inaction
C = 3 # Cost of volunteering
# Function to calculate the probability of cooperation (volunteering)
probability <- function(n, V = 10, L = 2, C = 3) {
p = 1 - (C/(V-L))^(1/(n-1))
return(p)
}
# Record the results of the study
results = df %>% group_by(Round) %>% summarise(participants = n(), volunteers =
sum(Decision))
results['Rate'] = results['volunteers']/results['participants']
results['Model Rate'] = NA
for (rd in 1:nrow(results)) {
if (rd < 6) { results$`Model Rate`[rd] = probability(n = 3)} # For rounds 1-5, group size = 3
if (rd < 11 & rd > 5) {results$`Model Rate`[rd] = probability(n = 9) } # For rounds 6-10, group size = 9
if (rd > 10) {results$`Model Rate`[rd] = probability(n = 27) } # For rounds 11+, group size = 27
}
# Plot observed vs. model-predicted cooperation rates
plot(results$Round, results$Rate, type = 'l', xlab = 'Round', ylab = 'Cooperation Rate', main = 'Volunteers Dilemma Experiment, Behavorial Economics (SP24)', col = 'red', ylim = c(0,.6))
lines(results$Round, results$`Model Rate`, col = 'blue', lwd = 2)
legend('topright', legend = c('Observed Co-op Rate','Model Co-op Rate'), col = c('red','blue'), lty = 1 , lwd =2 )
grid(col = 'black', lty = 'dotted')
