WebR — VPL, TIR e Decisão de Investimento

Carregando WebR...

# ============================================
# VPL, TIR e Decisao de Investimento
# Exercicio Resolvido 18.2
# ============================================

# Paineis solares: I = 200.000, FC = 55.000/ano, 5 anos
I0 <- 200000
FC <- 55000
n <- 5
r_oport <- 0.12  # custo de oportunidade

cat("====== VPL E TIR ======\n")
cat(sprintf("Investimento: R$ %s\n", format(I0, big.mark=".")))
cat(sprintf("Fluxo anual: R$ %s por %d anos\n", format(FC, big.mark="."), n))
cat(sprintf("Custo de oportunidade: %.0f%%\n\n", r_oport*100))

# Funcao VPL
VPL <- function(r, FC, n, I0) {
  -I0 + FC * (1 - (1+r)^(-n)) / r
}

# --- VPL para varias taxas ---
cat("--- VPL vs. Taxa de desconto ---\n")
cat(sprintf("%-10s %-15s %-10s\n", "r (%)", "VPL (R$)", "Decisao"))
cat(strrep("-", 38), "\n")
r_tab <- c(0.02, 0.05, 0.08, 0.10, 0.12, 0.15, 0.18, 0.20)
for (ri in r_tab) {
  vpl_i <- VPL(ri, FC, n, I0)
  dec <- ifelse(vpl_i > 0, "Aceitar", ifelse(vpl_i < -1, "Rejeitar", "~Neutro"))
  cat(sprintf("%-10.0f %-15s %-10s\n", ri*100,
      format(round(vpl_i), big.mark="."), dec))
}

# --- TIR (busca numerica) ---
tir_func <- function(r) VPL(r, FC, n, I0)
TIR <- uniroot(tir_func, c(0.001, 0.99))$root
cat(sprintf("\nTIR = %.2f%%\n", TIR*100))
cat(sprintf("TIR %s r => %s\n\n",
    ifelse(TIR > r_oport, ">", "<"),
    ifelse(TIR > r_oport, "ACEITAR", "REJEITAR")))

# --- Contexto Brasil vs. EUA ---
cat("--- Contexto internacional ---\n")
vpl_eua <- VPL(0.04, FC, n, I0)
vpl_br <- VPL(0.08, FC, n, I0)
cat(sprintf("VPL a 4%% (juro real EUA): R$ %s => ACEITAR\n",
    format(round(vpl_eua), big.mark=".")))
cat(sprintf("VPL a 8%% (juro real Brasil): R$ %s => %s\n",
    format(round(vpl_br), big.mark="."),
    ifelse(vpl_br > 0, "ACEITAR", "REJEITAR")))
cat(sprintf("VPL a 12%%: R$ %s => %s\n",
    format(round(VPL(0.12, FC, n, I0)), big.mark="."),
    ifelse(VPL(0.12, FC, n, I0) > 0, "ACEITAR", "REJEITAR")))

# --- Grafico ---
par(mar = c(4.5, 4.5, 3, 2), bg = "#f8f9fa")
r_seq <- seq(0.01, 0.30, length = 300)
vpl_seq <- sapply(r_seq, function(r) VPL(r, FC, n, I0))

plot(r_seq * 100, vpl_seq / 1000, type = "l", lwd = 3, col = "#0d6efd",
     xlab = "Taxa de desconto (%)",
     ylab = "VPL (R$ mil)",
     main = "VPL vs. Taxa de desconto")
abline(h = 0, col = "#dc3545", lwd = 2, lty = 2)
abline(v = TIR * 100, col = "#6f42c1", lwd = 2, lty = 3)

# Zonas aceitar/rejeitar
polygon(c(r_seq[vpl_seq>0]*100, rev(r_seq[vpl_seq>0]*100)),
        c(vpl_seq[vpl_seq>0]/1000, rep(0, sum(vpl_seq>0))),
        col = rgb(0.1, 0.6, 0.3, 0.1), border = NA)
polygon(c(r_seq[vpl_seq<0]*100, rev(r_seq[vpl_seq<0]*100)),
        c(vpl_seq[vpl_seq<0]/1000, rep(0, sum(vpl_seq<0))),
        col = rgb(0.85, 0.2, 0.2, 0.1), border = NA)

# TIR
points(TIR*100, 0, pch = 19, col = "#6f42c1", cex = 2)
text(TIR*100 + 1.5, 3, paste0("TIR = ", round(TIR*100, 1), "%"),
     col = "#6f42c1", cex = 0.8, font = 2)

# Marcadores
points(r_oport*100, VPL(r_oport, FC, n, I0)/1000,
       pch = 17, col = "#dc3545", cex = 1.5)
text(r_oport*100 + 1.5, VPL(r_oport, FC, n, I0)/1000,
     paste0("r=", r_oport*100, "%"),
     col = "#dc3545", cex = 0.7, font = 2)

text(5, max(vpl_seq)/1000 * 0.6, "ACEITAR",
     col = "#198754", cex = 1, font = 2)
text(25, min(vpl_seq)/1000 * 0.4, "REJEITAR",
     col = "#dc3545", cex = 1, font = 2)

legend("topright",
       legend = c("VPL(r)", "VPL = 0", "TIR"),
       col = c("#0d6efd", "#dc3545", "#6f42c1"),
       lwd = c(3, 2, 2), lty = c(1, 2, 3),
       cex = 0.65, bg = "white")

(Aguardando WebR...)