WebR — Mecanismo VCG para Bem Publico Discreto

Carregando WebR...

# ============================================
# Mecanismo VCG para Bem Publico Discreto
# Exercicio Resolvido 20.8
# ============================================

cat("====== MECANISMO VCG (ER 20.8) ======\n\n")

# Ponte (bem publico discreto), custo C = 120
# Valoracoes: v_A = 70, v_B = 40, v_C = 30
v <- c(A = 70, B = 40, C = 30)
C_ponte <- 120
nomes <- names(v)

cat(sprintf("Custo da ponte: C = %d\n", C_ponte))
cat(sprintf("Valoracoes: %s\n\n",
    paste(sprintf("v_%s = %d", nomes, v), collapse = ", ")))

# --- (a) Decisao de provisao ---
soma_v <- sum(v)
cat("--- (a) Decisao ---\n")
cat(sprintf("Soma valoracoes: %s = %d\n", paste(v, collapse = " + "), soma_v))
cat(sprintf("Soma >= C? %d >= %d? %s => %s\n\n",
    soma_v, C_ponte,
    ifelse(soma_v >= C_ponte, "SIM", "NAO"),
    ifelse(soma_v >= C_ponte, "PROVER!", "NAO prover")))

# --- (b) Agentes pivotais ---
cat("--- (b) Agentes pivotais ---\n")
pivotal <- logical(length(v))
for (i in seq_along(v)) {
  soma_sem <- sum(v[-i])
  pivotal[i] <- soma_sem < C_ponte
  cat(sprintf("Sem %s: soma = %d %s %d => %s pivotal\n",
      nomes[i], soma_sem,
      ifelse(soma_sem < C_ponte, "<", ">="),
      C_ponte,
      ifelse(pivotal[i], "E'", "NAO e'")))
}
cat("\n")

# --- (c) Impostos pivotais ---
cat("--- (c) Impostos pivotais ---\n")
t_vcg <- numeric(length(v))
for (i in seq_along(v)) {
  if (pivotal[i]) {
    t_vcg[i] <- C_ponte - sum(v[-i])
  } else {
    t_vcg[i] <- 0
  }
  cat(sprintf("t_%s = C - sum(v_{-%s}) = %d - %d = %d\n",
      nomes[i], nomes[i], C_ponte, sum(v[-i]), t_vcg[i]))
}

cat(sprintf("\nTotal arrecadado: %s = %d\n",
    paste(t_vcg, collapse = " + "), sum(t_vcg)))
deficit <- C_ponte - sum(t_vcg)
cat(sprintf("Deficit: %d - %d = %d (VCG NAO e' equilibrado!)\n\n",
    C_ponte, sum(t_vcg), deficit))

# --- Excedentes liquidos ---
cat("--- Excedentes liquidos ---\n")
cat(sprintf("%-8s %-10s %-10s %-12s\n",
    "Agente", "v_i", "t_i", "Excedente"))
cat(strrep("-", 44), "\n")
for (i in seq_along(v)) {
  exc <- v[i] - t_vcg[i]
  cat(sprintf("%-8s %-10d %-10d %-12d\n",
      nomes[i], v[i], t_vcg[i], exc))
}

# --- (d) Compatibilidade de incentivos ---
cat("\n--- (d) Incentivos para agente A ---\n")
cat("Revelar verdade (v_A = 70):\n")
cat(sprintf("  Soma = 140 >= 120 => ponte provida\n"))
cat(sprintf("  t_A = 50, excedente = 70 - 50 = 20\n\n"))

# Subdeclarar
for (v_hat in c(30, 10, 0)) {
  soma_hat <- v_hat + sum(v[-1])
  provido <- soma_hat >= C_ponte
  if (provido) {
    t_hat <- C_ponte - sum(v[-1])
    exc_hat <- v[1] - t_hat
  } else {
    t_hat <- 0
    exc_hat <- 0
  }
  cat(sprintf("Declarar v_A = %d: soma = %d, %s, excedente = %d %s\n",
      v_hat, soma_hat,
      ifelse(provido, "provido", "NAO provido"),
      exc_hat,
      ifelse(exc_hat < 20, "(PIOR)", ifelse(exc_hat == 20, "(IGUAL)", "(MELHOR)"))))
}

# Sobredeclarar
cat(sprintf("Declarar v_A = 90: soma = %d, provido, t_A = %d, excedente = %d (IGUAL)\n\n",
    90 + sum(v[-1]), t_vcg[1], v[1] - t_vcg[1]))

cat("=> Revelar a verdade e' estrategia dominante!\n\n")

# --- Variando custo da ponte ---
cat("--- Sensibilidade: variando o custo ---\n")
cat(sprintf("%-8s %-12s %-8s %-8s %-8s %-10s\n",
    "Custo", "Prover?", "t_A", "t_B", "t_C", "Deficit"))
cat(strrep("-", 58), "\n")
C_vals <- seq(60, 180, by = 20)
for (Ci in C_vals) {
  provido <- soma_v >= Ci
  ti <- numeric(3)
  if (provido) {
    for (j in 1:3) {
      ti[j] <- max(0, Ci - sum(v[-j]))
    }
  }
  cat(sprintf("%-8d %-12s %-8d %-8d %-8d %-10d\n",
      Ci, ifelse(provido, "SIM", "NAO"),
      ti[1], ti[2], ti[3],
      ifelse(provido, Ci - sum(ti), 0)))
}

# --- Grafico ---
par(mar = c(4.5, 4.5, 3, 2), bg = "#f8f9fa")

cols <- c("#dc3545", "#0d6efd", "#fd7e14")

# Grafico de barras: valoracao vs imposto
barpos <- barplot(rbind(v, t_vcg),
        beside = TRUE, col = c(cols, adjustcolor(cols, 0.4)),
        names.arg = nomes,
        main = "VCG: valoracao vs. imposto pivotal",
        ylab = "R$", ylim = c(0, max(v) * 1.3),
        border = NA)

# Excedentes como texto
for (i in 1:3) {
  exc <- v[i] - t_vcg[i]
  mid_x <- mean(barpos[, i])
  text(mid_x, v[i] + 5,
       sprintf("exc = %d", exc),
       cex = 0.65, font = 2, col = cols[i])
}

# Linha do custo
abline(h = C_ponte, col = "#6f42c1", lty = 3, lwd = 2)
text(max(barpos) + 0.5, C_ponte + 4,
     sprintf("Custo = %d", C_ponte),
     col = "#6f42c1", cex = 0.7, font = 2)

# Total arrecadado
abline(h = sum(t_vcg), col = "#198754", lty = 2, lwd = 1.5)
text(max(barpos) + 0.5, sum(t_vcg) - 4,
     sprintf("Arrecadado = %d", sum(t_vcg)),
     col = "#198754", cex = 0.65, font = 2)

legend("topright",
       legend = c("Valoracao (v_i)", "Imposto (t_i)"),
       fill = c("#dc3545", adjustcolor("#dc3545", 0.4)),
       cex = 0.6, bg = "white", border = NA)

(Aguardando WebR...)