WebR — Regra de Hotelling

Carregando WebR...

# ============================================
# Regra de Hotelling
# Exercicio Resolvido 18.3
# ============================================

p0 <- 80     # preco inicial (mil R$/ton)
c <- 20      # custo de extracao
r <- 0.04    # taxa de juros real
S0 <- 5000   # estoque (toneladas)

cat("====== REGRA DE HOTELLING ======\n")
cat(sprintf("p0 = %.0f  c = %.0f  r = %.0f%%  S0 = %.0f\n\n",
    p0, c, r*100, S0))

# --- Renda de escassez ---
R0 <- p0 - c
cat(sprintf("Renda de escassez inicial: R0 = p0 - c = %.0f\n\n", R0))

# --- Trajetoria de precos ---
cat("--- Trajetoria de precos (Hotelling) ---\n")
cat(sprintf("%-6s %-10s %-10s\n", "Ano", "R(t)", "p(t)"))
cat(strrep("-", 28), "\n")
anos <- c(0, 5, 10, 15, 20, 25, 30)
for (t in anos) {
  Rt <- R0 * (1 + r)^t
  pt <- Rt + c
  cat(sprintf("%-6d %-10.2f %-10.2f\n", t, Rt, pt))
}

# --- Backstop technology ---
p_backstop <- 100  # preco do substituto
t_backstop <- 15   # disponivel em t=15

cat(sprintf("\n--- Backstop technology ---\n"))
cat(sprintf("Substituto a R$ %.0f disponivel em t = %d\n", p_backstop, t_backstop))
R_backstop <- p_backstop - c
R0_novo <- R_backstop / (1 + r)^t_backstop
p0_novo <- R0_novo + c
cat(sprintf("R0 ajustado = %.2f  p0 ajustado = %.2f\n", R0_novo, p0_novo))
cat(sprintf("Preco cai de %.0f para %.2f (-%.1f%%)\n\n",
    p0, p0_novo, (1 - p0_novo/p0)*100))

# --- Efeito da taxa de juros ---
cat("--- Efeito da taxa de juros em t=20 ---\n")
r_vals <- c(0.02, 0.04, 0.06, 0.08, 0.10)
cat(sprintf("%-8s %-10s %-10s\n", "r(%)", "R(20)", "p(20)"))
cat(strrep("-", 30), "\n")
for (ri in r_vals) {
  Ri <- R0 * (1+ri)^20
  pi <- Ri + c
  cat(sprintf("%-8.0f %-10.2f %-10.2f\n", ri*100, Ri, pi))
}
cat("\nJuros altos => preco futuro sobe mais rapido\n")
cat("=> incentiva extracao HOJE (futuro vale menos)\n")

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

# Painel 1: Trajetoria de precos
t_seq <- 0:30
R_seq <- R0 * (1 + r)^t_seq
p_seq <- R_seq + c

plot(t_seq, p_seq, type = "l", lwd = 3, col = "#0d6efd",
     xlab = "Anos", ylab = "Preco (mil R$/ton)",
     main = "Trajetoria de precos (Hotelling)",
     ylim = c(0, max(p_seq) * 1.1))
lines(t_seq, R_seq, lwd = 2, col = "#6f42c1", lty = 2)
abline(h = c, col = "#adb5bd", lty = 3)
text(25, c + 3, "c (custo)", col = "#adb5bd", cex = 0.7)

# Backstop
abline(h = p_backstop, col = "#dc3545", lwd = 2, lty = 4)
text(2, p_backstop + 3, paste0("Backstop = ", p_backstop),
     col = "#dc3545", cex = 0.7, font = 2)

# Trajetoria com backstop
R_novo_seq <- R0_novo * (1+r)^t_seq
p_novo_seq <- pmin(R_novo_seq + c, p_backstop)
lines(t_seq, p_novo_seq, lwd = 2, col = "#198754", lty = 2)

legend("topleft",
       legend = c("Sem backstop", "Renda escassez",
                  "Com backstop", "Preco backstop"),
       col = c("#0d6efd", "#6f42c1", "#198754", "#dc3545"),
       lwd = c(3, 2, 2, 2), lty = c(1, 2, 2, 4),
       cex = 0.55, bg = "white")

# Painel 2: Efeito da taxa de juros
cols2 <- c("#0d6efd", "#198754", "#fd7e14", "#dc3545", "#6f42c1")
plot(NULL, xlim = c(0, 30), ylim = c(p0, 300),
     xlab = "Anos", ylab = "Preco (mil R$/ton)",
     main = "Efeito da taxa de juros")
for (k in seq_along(r_vals)) {
  p_k <- (R0 * (1+r_vals[k])^t_seq) + c
  lines(t_seq, p_k, lwd = 2, col = cols2[k],
        lty = ifelse(k <= 2, 1, 2))
}
legend("topleft",
       legend = paste0("r=", r_vals*100, "%"),
       col = cols2, lwd = 2,
       lty = c(1,1,2,2,2), cex = 0.55, bg = "white")

(Aguardando WebR...)