WebR — Imposto Pigouviano e Perda de Peso Morto

Carregando WebR...

# ============================================
# Imposto Pigouviano e Perda de Peso Morto
# Exercicio Resolvido 20.1
# ============================================

P <- 100        # preco competitivo
a <- 10         # coef linear do custo privado
b <- 1          # coef quadratico do custo privado: C(q) = aq + bq^2
d <- 1          # coef quadratico do custo externo: E(q) = dq^2

cat("====== IMPOSTO PIGOUVIANO (ER 20.1) ======\n")
cat(sprintf("Preco: P = %d\n", P))
cat(sprintf("Custo privado: C(q) = %dq + %dq^2\n", a, b))
cat(sprintf("Custo externo: E(q) = %dq^2\n\n", d))

# --- (a) Producao privada e otimo social ---
# CMg privado = a + 2bq = P  =>  q_priv = (P - a) / (2b)
q_priv <- (P - a) / (2 * b)
# CMg social = a + 2bq + 2dq = P  =>  q_soc = (P - a) / (2b + 2d)
q_soc <- (P - a) / (2 * b + 2 * d)

cat("--- (a) Producao ---\n")
cat(sprintf("CMg privado = %d + %dq  =>  q_priv = %.1f\n", a, 2*b, q_priv))
cat(sprintf("CMg social  = %d + %dq  =>  q_soc  = %.1f\n", a, 2*(b+d), q_soc))
cat(sprintf("Sobreprod.: %.1f unidades (%.0f%% acima do otimo)\n\n",
    q_priv - q_soc, (q_priv/q_soc - 1)*100))

# --- (b) Imposto pigouviano ---
t_star <- 2 * d * q_soc
cat("--- (b) Imposto pigouviano ---\n")
cat(sprintf("t* = E'(q_soc) = 2*%d*%.1f = %.1f\n", d, q_soc, t_star))

# Verificacao
q_tax <- (P - a - t_star) / (2 * b)
cat(sprintf("Verif.: q com imposto = (%.0f - %d - %.1f)/(2*%d) = %.1f = q_soc? %s\n\n",
    P, a, t_star, b, q_tax, ifelse(abs(q_tax - q_soc) < 0.01, "SIM!", "NAO")))

# --- (c) Perda de peso morto ---
# DWL = integral de q_soc a q_priv de [CMg_social - P] dq
# CMg_social - P = (a + 2(b+d)q) - P
# No intervalo [q_soc, q_priv], isso vai de 0 a (2(b+d)*q_priv - (P-a))
# DWL = (1/2) * base * altura (triangulo)
altura_dwl <- (a + 2*(b+d)*q_priv) - P
base_dwl <- q_priv - q_soc
DWL <- 0.5 * base_dwl * altura_dwl

cat("--- (c) Perda de peso morto ---\n")
cat(sprintf("DWL = 0.5 * (%.1f - %.1f) * (%.1f - %.0f)\n",
    q_priv, q_soc, a + 2*(b+d)*q_priv, P))
cat(sprintf("DWL = 0.5 * %.1f * %.1f = R$ %.1f\n\n", base_dwl, altura_dwl, DWL))

# --- Sensibilidade: variando custo externo ---
cat("--- Sensibilidade: variando d (custo externo) ---\n")
cat(sprintf("%-8s %-10s %-10s %-10s %-10s\n",
    "d", "q_soc", "t*", "DWL", "% sobrep."))
cat(strrep("-", 52), "\n")
d_vals <- c(0.25, 0.5, 1, 2, 4, 8)
for (di in d_vals) {
  qs <- (P - a) / (2*b + 2*di)
  ti <- 2 * di * qs
  hi <- (a + 2*(b+di)*q_priv) - P
  dwli <- 0.5 * (q_priv - qs) * hi
  cat(sprintf("%-8.2f %-10.1f %-10.1f %-10.1f %-10.0f%%\n",
      di, qs, ti, dwli, (q_priv/qs - 1)*100))
}

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

# Painel 1: CMg privado vs social
q_seq <- seq(0, q_priv * 1.2, length = 300)
CMg_priv <- a + 2 * b * q_seq
CMg_soc  <- a + 2 * (b + d) * q_seq

plot(q_seq, CMg_soc, type = "l", lwd = 3, col = "#dc3545",
     xlab = "Quantidade (q)", ylab = "Custo marginal / Preco (R$)",
     main = "Imposto pigouviano otimo",
     ylim = c(0, max(CMg_soc) * 1.05))
lines(q_seq, CMg_priv, lwd = 3, col = "#0d6efd")
abline(h = P, col = "#198754", lwd = 2, lty = 2)

# Zona DWL
q_dwl <- seq(q_soc, q_priv, length = 100)
CMg_soc_dwl <- a + 2*(b+d)*q_dwl
polygon(c(q_dwl, rev(q_dwl)),
        c(CMg_soc_dwl, rep(P, length(q_dwl))),
        col = rgb(0.86, 0.2, 0.2, 0.15), border = NA)
text((q_soc + q_priv)/2, P + (altura_dwl)/3, "DWL",
     col = "#dc3545", cex = 0.8, font = 2)

# Marcas
abline(v = q_soc, col = "#6f42c1", lty = 3, lwd = 1.5)
abline(v = q_priv, col = "#fd7e14", lty = 3, lwd = 1.5)
text(q_soc - 2, P * 0.15, expression(q^{soc}), col = "#6f42c1", cex = 0.7, font = 2)
text(q_priv + 1.5, P * 0.15, expression(q^{priv}), col = "#fd7e14", cex = 0.7, font = 2)

# Seta do imposto
arrows(q_soc + 0.5, a + 2*b*q_soc, q_soc + 0.5, a + 2*(b+d)*q_soc,
       code = 3, lwd = 2, col = "#6f42c1", length = 0.08)
text(q_soc + 4, (a + 2*b*q_soc + a + 2*(b+d)*q_soc)/2,
     paste0("t* = ", round(t_star, 1)),
     col = "#6f42c1", cex = 0.65, font = 2)

legend("topleft",
       legend = c("CMg privado", "CMg social", "Preco (P)"),
       col = c("#0d6efd", "#dc3545", "#198754"),
       lwd = c(3, 3, 2), lty = c(1, 1, 2),
       cex = 0.55, bg = "white")

# Painel 2: DWL vs custo externo d
d_fine <- seq(0.1, 10, length = 200)
DWL_fine <- numeric(length(d_fine))
for (k in seq_along(d_fine)) {
  di <- d_fine[k]
  qs <- (P - a) / (2*b + 2*di)
  hi <- (a + 2*(b+di)*q_priv) - P
  DWL_fine[k] <- 0.5 * (q_priv - qs) * hi
}

plot(d_fine, DWL_fine, type = "l", lwd = 3, col = "#dc3545",
     xlab = "Coeficiente do custo externo (d)",
     ylab = "Perda de peso morto (R$)",
     main = "DWL vs. magnitude da externalidade")

points(d, DWL, pch = 19, col = "#0d6efd", cex = 2)
text(d + 0.5, DWL + max(DWL_fine)*0.05,
     paste0("ER 20.1\n(d=", d, ", DWL=", round(DWL, 1), ")"),
     col = "#0d6efd", cex = 0.6, font = 2)

(Aguardando WebR...)