WebR — Condicao de Samuelson e Precos de Lindahl

Carregando WebR...

# ============================================
# Condicao de Samuelson e Precos de Lindahl
# Exercicio Resolvido 20.6
# ============================================

cat("====== CONDICAO DE SAMUELSON (ER 20.6) ======\n\n")

# 3 consumidores com valoracoes lineares:
# V1(G) = 80 - 2G,  V2(G) = 60 - G,  V3(G) = 40 - G
# CMg = 60

a <- c(80, 60, 40)   # interceptos
b <- c(2, 1, 1)       # inclinacoes
CMg <- 60

cat("Valoracoes marginais:\n")
for (i in 1:3) cat(sprintf("  V%d(G) = %d - %dG\n", i, a[i], b[i]))
cat(sprintf("CMg = %d\n\n", CMg))

# --- (a) Beneficio marginal social ---
# BMg_social(G) = sum(a) - sum(b)*G = 180 - 4G
a_tot <- sum(a)
b_tot <- sum(b)
cat("--- (a) Beneficio marginal social ---\n")
cat(sprintf("BMg_social(G) = %d - %dG\n\n", a_tot, b_tot))

# --- (b) Condicao de Samuelson ---
# 180 - 4G = 60  =>  G* = 30
G_star <- (a_tot - CMg) / b_tot
cat("--- (b) Condicao de Samuelson ---\n")
cat(sprintf("sum BMg_i = CMg:  %d - %dG = %d\n", a_tot, b_tot, CMg))
cat(sprintf("G* = (%d - %d) / %d = %.0f\n\n", a_tot, CMg, b_tot, G_star))

# Verificacao
BMg_star <- a_tot - b_tot * G_star
cat(sprintf("Verif: BMg_social(%.0f) = %d - %d*%.0f = %.0f = CMg? %s\n\n",
    G_star, a_tot, b_tot, G_star, BMg_star,
    ifelse(abs(BMg_star - CMg) < 0.01, "SIM!", "NAO")))

# --- (c) Precos de Lindahl ---
tau <- a - b * G_star
cat("--- (c) Precos de Lindahl ---\n")
for (i in 1:3) {
  cat(sprintf("tau_%d = V%d(%.0f) = %d - %d*%.0f = %.0f\n",
      i, i, G_star, a[i], b[i], G_star, tau[i]))
}
cat(sprintf("Soma: %s = %d = CMg? %s\n\n",
    paste(tau, collapse = " + "), sum(tau),
    ifelse(abs(sum(tau) - CMg) < 0.01, "SIM!", "NAO")))

# Participacao no custo
cat("--- Participacao no custo ---\n")
for (i in 1:3) {
  cat(sprintf("Consumidor %d: R$ %.0f (%.1f%% do custo)\n",
      i, tau[i], tau[i]/CMg*100))
}

# --- Provisao voluntaria (Nash) ---
cat("\n--- Provisao voluntaria (comparacao) ---\n")
# Cada um iguala seu BMg ao CMg (nao a soma)
# a_i - b_i*G = CMg  =>  contribui ate G_i = (a_i - CMg)/b_i
G_nash <- max(sapply(1:3, function(i) max(0, (a[i] - CMg)/b[i])))
cat(sprintf("Contribuicao Nash (apenas maior valorador): G_Nash = %.0f\n", G_nash))
cat(sprintf("Subprovisao: %.0f vs %.0f (%.0f%% do otimo)\n\n",
    G_nash, G_star, G_nash/G_star*100))

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

# Painel 1: Soma vertical dos BMg
G_seq <- seq(0, 45, length = 300)
V1 <- pmax(a[1] - b[1]*G_seq, 0)
V2 <- pmax(a[2] - b[2]*G_seq, 0)
V3 <- pmax(a[3] - b[3]*G_seq, 0)
BMg_soc <- V1 + V2 + V3

plot(G_seq, BMg_soc, type = "l", lwd = 3, col = "#198754",
     xlab = "Quantidade do bem publico (G)",
     ylab = "Beneficio marginal (R$)",
     main = "Soma vertical: Samuelson",
     ylim = c(0, max(BMg_soc) * 1.05))
lines(G_seq, V1, lwd = 1.5, col = "#dc3545", lty = 2)
lines(G_seq, V2, lwd = 1.5, col = "#0d6efd", lty = 2)
lines(G_seq, V3, lwd = 1.5, col = "#fd7e14", lty = 2)
abline(h = CMg, col = "#6f42c1", lwd = 2, lty = 3)

# Ponto otimo
points(G_star, CMg, pch = 19, col = "#198754", cex = 2)
abline(v = G_star, col = "#198754", lty = 3, lwd = 1)

# Precos de Lindahl (setas)
y_base <- 0
for (i in 1:3) {
  cols <- c("#dc3545", "#0d6efd", "#fd7e14")
  rect(G_star - 1, y_base, G_star + 1, y_base + tau[i],
       col = adjustcolor(cols[i], 0.2), border = cols[i])
  text(G_star + 2, y_base + tau[i]/2,
       sprintf("tau_%d=%d", i, tau[i]),
       col = cols[i], cex = 0.55, font = 2)
  y_base <- y_base + tau[i]
}

text(G_star - 5, CMg + 8, expression(G^"*" == 30),
     col = "#198754", cex = 0.7, font = 2)
text(40, CMg + 5, "CMg", col = "#6f42c1", cex = 0.6)

legend("topright",
       legend = c(expression(Sigma * BMg[i] ~ "(social)"),
                  expression(V[1](G)), expression(V[2](G)),
                  expression(V[3](G))),
       col = c("#198754", "#dc3545", "#0d6efd", "#fd7e14"),
       lwd = c(3, 1.5, 1.5, 1.5), lty = c(1, 2, 2, 2),
       cex = 0.5, bg = "white")

# Painel 2: Subprovisao vs N consumidores
N_vals <- 1:20
G_opt <- numeric(length(N_vals))
G_vol <- numeric(length(N_vals))
# Modelo simplificado: N consumidores identicos com BMg = 80 - 2G
for (k in seq_along(N_vals)) {
  Ni <- N_vals[k]
  # Samuelson: N*(80 - 2G) = 60  =>  G* = (80N - 60)/(2N)
  G_opt[k] <- max(0, (80*Ni - 60) / (2*Ni))
  # Nash: 80 - 2G = 60  =>  G_nash = 10 (independe de N!)
  G_vol[k] <- max(0, (80 - 60) / 2)
}

plot(N_vals, G_opt, type = "b", lwd = 3, col = "#198754", pch = 19,
     xlab = "Numero de consumidores (N)",
     ylab = "Quantidade do bem publico (G)",
     main = "Subprovisao cresce com N",
     ylim = c(0, max(G_opt) * 1.1))
lines(N_vals, G_vol, lwd = 2, col = "#dc3545", lty = 2)
points(N_vals, G_vol, pch = 17, col = "#dc3545", cex = 1)

legend("right",
       legend = c(expression(G^"*" ~ "(Samuelson)"),
                  expression(G^{Nash} ~ "(voluntario)")),
       col = c("#198754", "#dc3545"),
       lwd = c(3, 2), lty = c(1, 2), pch = c(19, 17),
       cex = 0.55, bg = "white")

text(15, G_vol[1] + 3, "Free riding:\nG_Nash fixo!", col = "#dc3545",
     cex = 0.6, font = 2)

(Aguardando WebR...)