WebR — Modelo de Fisher: Consumo Intertemporal

Carregando WebR...

# ============================================
# Modelo de Fisher: Consumo Intertemporal
# Exercicio Resolvido 18.1
# ============================================

Y1 <- 80; Y2 <- 66
rho <- 0.10   # taxa de desconto subjetiva
r <- 0.10     # taxa de juros

beta <- 1 / (1 + rho)

cat("====== MODELO DE FISHER ======\n")
cat(sprintf("Y1 = %.0f  Y2 = %.0f  r = %.0f%%  rho = %.0f%%\n",
    Y1, Y2, r*100, rho*100))
cat(sprintf("beta = 1/(1+rho) = %.4f\n\n", beta))

# --- Riqueza intertemporal ---
W <- Y1 + Y2 / (1 + r)
cat(sprintf("Riqueza intertemporal: W = %.2f\n\n", W))

# --- Consumo otimo (Cobb-Douglas intertemporal) ---
# U = ln(C1) + beta*ln(C2)
# C1* = W / (1 + beta)
# C2* = (1+r) * beta * W / (1 + beta)
C1_star <- W / (1 + beta)
C2_star <- (1 + r) * beta * W / (1 + beta)
S <- Y1 - C1_star

cat("--- Consumo otimo ---\n")
cat(sprintf("C1* = %.2f  C2* = %.2f\n", C1_star, C2_star))
cat(sprintf("Poupanca: S = Y1 - C1* = %.2f\n", S))
cat(sprintf("Classificacao: %s\n\n",
    ifelse(S > 0, "POUPADOR", ifelse(S < 0, "DEVEDOR", "NEUTRO"))))

# Verificacao: TMS = C2/(beta*C1) = 1+r?
TMS <- C2_star / (beta * C1_star)
cat(sprintf("Verificacao: TMS = %.4f  1+r = %.4f  OK? %s\n\n",
    TMS, 1+r, abs(TMS - (1+r)) < 0.001))

# --- Estatica comparativa: variando r ---
cat("--- Estatica comparativa ---\n")
cat(sprintf("%-8s %-8s %-8s %-8s %-10s\n",
    "r(%)", "W", "C1*", "C2*", "S"))
cat(strrep("-", 46), "\n")

r_vals <- c(0.02, 0.05, 0.08, 0.10, 0.15, 0.20, 0.30)
for (ri in r_vals) {
  Wi <- Y1 + Y2/(1+ri)
  C1i <- Wi / (1 + beta)
  C2i <- (1+ri) * beta * Wi / (1 + beta)
  Si <- Y1 - C1i
  cat(sprintf("%-8.0f %-8.2f %-8.2f %-8.2f %-10.2f\n",
      ri*100, Wi, C1i, C2i, Si))
}

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

# Restricao orcamentaria
C1_seq <- seq(0, W * 1.1, length = 300)
C2_reta <- (1 + r) * (W - C1_seq)

plot(C1_seq, C2_reta, type = "l", lwd = 3, col = "#0d6efd",
     xlim = c(0, W * 1.1), ylim = c(0, (1+r)*W * 1.1),
     xlab = expression(C[1]), ylab = expression(C[2]),
     main = "Consumo intertemporal (Fisher)")

# Curva de indiferenca
U_star <- log(C1_star) + beta * log(C2_star)
C1_ci <- seq(5, W, length = 400)
C2_ci <- exp((U_star - log(C1_ci)) / beta)
valid <- C2_ci < (1+r)*W * 1.2 & C2_ci > 0
lines(C1_ci[valid], C2_ci[valid], lwd = 2, col = "#6f42c1", lty = 2)

# Dotacao
points(Y1, Y2, pch = 17, col = "#198754", cex = 2)
text(Y1 + 2, Y2 + 5, paste0("Dotacao (", Y1, ",", Y2, ")"),
     col = "#198754", cex = 0.7, font = 2)

# Otimo
points(C1_star, C2_star, pch = 19, col = "#dc3545", cex = 2)
text(C1_star - 5, C2_star + 5,
     paste0("Otimo (", round(C1_star,1), ",", round(C2_star,1), ")"),
     col = "#dc3545", cex = 0.7, font = 2)

# Seta poupanca
if (abs(S) > 0.5) {
  arrows(Y1, Y2, C1_star, C2_star,
         col = "#fd7e14", lwd = 2, length = 0.1)
  text((Y1+C1_star)/2 + 3, (Y2+C2_star)/2,
       ifelse(S > 0, "Poupa", "Toma emprestado"),
       col = "#fd7e14", cex = 0.7, font = 2)
}

# Reta com r diferente (para comparacao)
r2 <- 0.20
W2 <- Y1 + Y2/(1+r2)
C2_reta2 <- (1+r2)*(W2 - C1_seq)
lines(C1_seq[C2_reta2 >= 0], C2_reta2[C2_reta2 >= 0],
      lwd = 1.5, col = "#adb5bd", lty = 3)
text(W2*0.3, (1+r2)*W2*0.7, paste0("r=", r2*100, "%"),
     col = "#adb5bd", cex = 0.65, font = 2)

legend("topright",
       legend = c(paste0("Restricao (r=", r*100, "%)"),
                  "Curva de indiferenca", "Dotacao", "Otimo"),
       col = c("#0d6efd", "#6f42c1", "#198754", "#dc3545"),
       lwd = c(3, 2, NA, NA), lty = c(1, 2, NA, NA),
       pch = c(NA, NA, 17, 19), cex = 0.6, bg = "white")

(Aguardando WebR...)