R Interativo — Seleção Adversa

R Interativo — Seleção Adversa no Mercado de Seguros

Carregando WebR (~10s)...

Simule o colapso do mercado — edite e executeR

# Seleção Adversa em Seguros (Adams 2025, Cap.13)
# Akerlof (1970) aplicado ao mercado de saúde

set.seed(42)
n <- 1000  # agentes no mercado

# Tipos: custo esperado de saúde
# Baixo risco: custo ~ N(1000, 300)
# Alto risco:  custo ~ N(5000, 800)
p_high <- 0.40  # proporção de alto risco (altere!)

type <- sample(c("Low","High"), n, replace = TRUE,
               prob = c(1 - p_high, p_high))
cost <- ifelse(type == "Low",
               rnorm(n, 1000, 300),
               rnorm(n, 5000, 800))
cost <- pmax(cost, 0)

# Disposição a pagar: custo esperado + aversão ao risco
wtp <- cost * 1.1 + ifelse(type == "High", 500, 100)

# Simular dinâmica de prêmio
cat("=== Dinâmica de Seleção Adversa ===\n")
premium <- mean(cost)  # prêmio atuarialmente justo para todos
for (round in 1:6) {
  buyers <- wtp >= premium
  if (sum(buyers) == 0) {
    cat(sprintf("Rodada %d: Prêmio R$ %.0f → MERCADO COLAPSA\n",
        round, premium))
    break
  }
  pct_high <- mean(type[buyers] == "High")
  avg_cost <- mean(cost[buyers])
  n_buy <- sum(buyers)
  cat(sprintf("Rodada %d: Prêmio R$ %5.0f | %d compradores | %.0f%% alto risco | Custo médio R$ %.0f\n",
      round, premium, n_buy, pct_high*100, avg_cost))
  premium <- avg_cost  # ajuste atuarial
}

# Gráfico: distribuição de custos por tipo
par(mar = c(4, 4, 3, 1))
hist(cost[type=="Low"], breaks = 30,
     col = rgb(0.17,0.5,0.17,0.5), border = NA,
     main = "Distribuição de Custos por Tipo",
     xlab = "Custo esperado (R$)", ylab = "Frequência",
     xlim = c(0, 8000), ylim = c(0, 80))
hist(cost[type=="High"], breaks = 30,
     col = rgb(0.78,0.06,0.18,0.5), border = NA, add = TRUE)
abline(v = mean(cost), lty = 2, lwd = 2, col = "#333")
legend("topright",
  legend = c(sprintf("Baixo risco (%.0f%%)", (1-p_high)*100),
             sprintf("Alto risco (%.0f%%)", p_high*100),
             "Prêmio médio"),
  fill = c(rgb(0.17,0.5,0.17,0.5), rgb(0.78,0.06,0.18,0.5), NA),
  border = NA, lty = c(NA, NA, 2), lwd = c(NA, NA, 2),
  col = c(NA, NA, "#333"), cex = 0.8)

Saída do R

Aguardando execução...

Altere p_high (proporção de alto risco) para ver quando o mercado colapsa. Com p_high = 0.1, o mercado funciona. Com p_high = 0.6, a espiral adversa se acelera.