R Interativo — Ultimatum Game

R Interativo — Ultimatum Game: Experimento na Índia

Carregando WebR (~10s)...

Edite o código e clique "Executar" R

# Ultimatum Game — Simulação (inspirado em Andersen et al. 2011)
# Adams (2025), Cap. 8

# Simular dados de um experimento tipo ultimatum
set.seed(42)
n <- 500
stakes <- sample(c(20, 200, 2000), n, replace = TRUE,
                 prob = c(0.33, 0.34, 0.33))
offer_pct <- rbeta(n, 2, 2)  # ofertas centradas em 50%

# Probabilidade de aceitar depende da oferta (logit)
# Quanto menor a oferta, maior a chance de rejeição
alpha <- -3; beta_offer <- 8
p_accept <- 1 / (1 + exp(-(alpha + beta_offer * offer_pct)))
accept <- rbinom(n, 1, p_accept)

cat("=== Estatísticas descritivas ===\n")
cat("N observações:", n, "\n")
cat("Oferta média (% do bolo):", round(mean(offer_pct)*100, 1), "%\n")
cat("Taxa de aceitação:", round(mean(accept)*100, 1), "%\n")
cat("Oferta média quando aceita:", round(mean(offer_pct[accept==1])*100,1), "%\n")
cat("Oferta média quando rejeita:", round(mean(offer_pct[accept==0])*100,1), "%\n")

# Logit: aceitar ~ oferta
glm1 <- glm(accept ~ offer_pct, family = binomial)
cat("\n=== Modelo Logit ===\n")
print(summary(glm1)$coefficients)

# Gráfico: ofertas e probabilidade predita de aceitar
par(mar = c(4, 4, 3, 1))
x_seq <- seq(0, 1, 0.01)
pred <- predict(glm1, newdata = data.frame(offer_pct = x_seq),
                type = "response")
plot(x_seq * 100, pred, type = "l", col = "#C8102E", lwd = 3,
     xlab = "Oferta (% do bolo)", ylab = "Pr(Aceitar)",
     main = "Ultimatum: Probabilidade de Aceitar vs Oferta",
     ylim = c(0, 1))
points(offer_pct[accept==1]*100, jitter(rep(0.95, sum(accept==1)), amount=0.03),
       pch = 16, col = rgb(0.17, 0.5, 0.17, 0.2), cex = 0.5)
points(offer_pct[accept==0]*100, jitter(rep(0.05, sum(accept==0)), amount=0.03),
       pch = 16, col = rgb(0.78, 0.06, 0.18, 0.3), cex = 0.5)
abline(v = 50, lty = 2, col = "gray")
text(52, 0.5, "50/50", col = "gray40", cex = 0.8)
legend("bottomright", legend = c("Aceita", "Rejeita"),
       pch = 16, col = c("#2a7f2a", "#C8102E"), cex = 0.8)

Saída do R

Aguardando execução...

Experimento: Andersen et al. (2011) realizaram ultimatum games em vilas pobres no norte da Índia com stakes variando de $0.50 a $200 (até 8 meses de salário local). Com stakes altos, propostas convergem para o equilíbrio de subjogo perfeito (oferta mínima aceita).