Carregando WebR...
# ============================================ # Cap-and-Trade e Custo-Efetividade # Exercicio Resolvido 20.4 # ============================================ cat("====== CAP-AND-TRADE (ER 20.4) ======\n\n") # Duas fabricas, emissao base = 50 cada (total 100) # Meta: reduzir para 60 (abatimento = 40) # CMgA_1 = 4*a_1, CMgA_2 = 2*a_2 e_base <- c(50, 50) A_total <- 40 c1 <- 4 # inclinacao CMgA firma 1 c2 <- 2 # inclinacao CMgA firma 2 cat(sprintf("Emissao base: %d + %d = %d ton\n", e_base[1], e_base[2], sum(e_base))) cat(sprintf("Meta: emissao total = %d ton (abatimento = %d)\n", sum(e_base) - A_total, A_total)) cat(sprintf("CMgA_1 = %d*a_1, CMgA_2 = %d*a_2\n\n", c1, c2)) # --- (a) Alocacao custo-efetiva --- # CMgA_1 = CMgA_2 => 4*a1 = 2*a2 => a2 = 2*a1 # a1 + a2 = 40 => a1 + 2*a1 = 40 => a1 = 40/3 a1_eff <- A_total / 3 a2_eff <- 2 * A_total / 3 cat("--- (a) Alocacao custo-efetiva ---\n") cat(sprintf("CMgA_1 = CMgA_2: %d*a1 = %d*a2, a1 + a2 = %d\n", c1, c2, A_total)) cat(sprintf("a1* = %.1f ton, a2* = %.1f ton\n", a1_eff, a2_eff)) # Custos totais CT1_eff <- (c1/2) * a1_eff^2 # integral de 4a da = 2a^2 CT2_eff <- (c2/2) * a2_eff^2 # integral de 2a da = a^2 CT_eff <- CT1_eff + CT2_eff cat(sprintf("Custo firma 1: %.1f, Custo firma 2: %.1f\n", CT1_eff, CT2_eff)) cat(sprintf("Custo total eficiente: %.1f\n\n", CT_eff)) # --- (b) Abatimento uniforme --- a_unif <- A_total / 2 CT1_unif <- (c1/2) * a_unif^2 CT2_unif <- (c2/2) * a_unif^2 CT_unif <- CT1_unif + CT2_unif cat("--- (b) Abatimento uniforme ---\n") cat(sprintf("Cada firma abate %d ton\n", a_unif)) cat(sprintf("Custo firma 1: %.0f, Custo firma 2: %.0f\n", CT1_unif, CT2_unif)) cat(sprintf("Custo total uniforme: %.0f\n", CT_unif)) economia <- CT_unif - CT_eff cat(sprintf("Economia com cap-and-trade: %.1f (%.1f%%)\n\n", economia, economia/CT_unif*100)) # --- (c) Preco da permissao --- p_perm <- c1 * a1_eff cat("--- (c) Preco da permissao ---\n") cat(sprintf("p_E = CMgA_1(a1*) = %d * %.1f = %.1f por ton\n", c1, a1_eff, p_perm)) cat(sprintf("Verif: CMgA_2(a2*) = %d * %.1f = %.1f? %s\n\n", c2, a2_eff, c2*a2_eff, ifelse(abs(p_perm - c2*a2_eff) < 0.01, "SIM!", "NAO"))) # Comercio de permissoes # Firma 1 compra permissoes (abate menos que 20) # Firma 2 vende permissoes (abate mais que 20) perm_trade <- a_unif - a1_eff # permissoes que firma 1 compra cat("--- Comercio de permissoes ---\n") cat(sprintf("Firma 1 compra %.1f permissoes a R$ %.1f = R$ %.1f\n", perm_trade, p_perm, perm_trade * p_perm)) cat(sprintf("Firma 2 vende %.1f permissoes a R$ %.1f = R$ %.1f\n\n", perm_trade, p_perm, perm_trade * p_perm)) # --- Variando o cap --- cat("--- Sensibilidade: variando o cap ---\n") cat(sprintf("%-12s %-8s %-8s %-10s %-10s\n", "Abatimento", "a1*", "a2*", "Custo", "Preco perm")) cat(strrep("-", 52), "\n") A_vals <- seq(10, 80, by = 10) for (Ai in A_vals) { ai1 <- Ai / 3 ai2 <- 2 * Ai / 3 cti <- (c1/2)*ai1^2 + (c2/2)*ai2^2 pi <- c1 * ai1 cat(sprintf("%-12d %-8.1f %-8.1f %-10.1f %-10.1f\n", Ai, ai1, ai2, cti, pi)) } # --- Grafico --- par(mfrow = c(1, 2), mar = c(4.5, 4.5, 3, 1), bg = "#f8f9fa") # Painel 1: CMgA das duas firmas a_seq <- seq(0, 30, length = 200) CMgA1 <- c1 * a_seq CMgA2 <- c2 * a_seq plot(a_seq, CMgA1, type = "l", lwd = 3, col = "#dc3545", xlab = "Abatimento (ton)", ylab = "CMg abatimento (R$/ton)", main = "Custo-efetividade: igualar CMgA", ylim = c(0, max(CMgA1))) lines(a_seq, CMgA2, lwd = 3, col = "#0d6efd") # Preco de equilibrio abline(h = p_perm, col = "#198754", lwd = 2, lty = 2) points(a1_eff, p_perm, pch = 19, col = "#dc3545", cex = 2) points(a2_eff, p_perm, pch = 19, col = "#0d6efd", cex = 2) # Abatimento uniforme abline(v = a_unif, col = "#fd7e14", lty = 3, lwd = 1.5) text(a_unif + 0.5, max(CMgA1)*0.9, "Uniforme\n(a=20)", col = "#fd7e14", cex = 0.6, font = 2) text(a1_eff, p_perm + 10, sprintf("a1*=%.1f", a1_eff), col = "#dc3545", cex = 0.6, font = 2) text(a2_eff, p_perm + 10, sprintf("a2*=%.1f", a2_eff), col = "#0d6efd", cex = 0.6, font = 2) text(28, p_perm + 5, sprintf("p_E = %.1f", p_perm), col = "#198754", cex = 0.6, font = 2) legend("topleft", legend = c(expression(CMgA[1] == 4*a[1]), expression(CMgA[2] == 2*a[2]), "Preco permissao"), col = c("#dc3545", "#0d6efd", "#198754"), lwd = c(3, 3, 2), lty = c(1, 1, 2), cex = 0.55, bg = "white") # Painel 2: Custo total vs abatimento total A_fine <- seq(1, 80, length = 200) CT_eff_fine <- (c1/2)*(A_fine/3)^2 + (c2/2)*(2*A_fine/3)^2 CT_unif_fine <- (c1/2)*(A_fine/2)^2 + (c2/2)*(A_fine/2)^2 plot(A_fine, CT_unif_fine, type = "l", lwd = 2, col = "#fd7e14", lty = 2, xlab = "Abatimento total (ton)", ylab = "Custo total (R$)", main = "Custo: cap-trade vs. uniforme") lines(A_fine, CT_eff_fine, lwd = 3, col = "#198754") # Ponto do exercicio points(A_total, CT_eff, pch = 19, col = "#198754", cex = 2) points(A_total, CT_unif, pch = 17, col = "#fd7e14", cex = 1.5) arrows(A_total + 1, CT_unif, A_total + 1, CT_eff, code = 3, lwd = 2, col = "#6f42c1", length = 0.08) text(A_total + 5, (CT_unif + CT_eff)/2, sprintf("Economia\nR$ %.0f", economia), col = "#6f42c1", cex = 0.6, font = 2) legend("topleft", legend = c("Cap-and-trade (eficiente)", "Regulacao uniforme"), col = c("#198754", "#fd7e14"), lwd = c(3, 2), lty = c(1, 2), cex = 0.55, bg = "white")
▶ Executar
↻ Resetar
(Aguardando WebR...)