R Interativo — Desconto Hiperbólico vs Exponencial

Carregando WebR (~10s na primeira vez)...

Edite o código e clique "Executar"R

# Desconto Hiperbólico vs Exponencial
# Cap. 8 — Por que você assina a academia em janeiro e para em março?

# Exponencial: D(t) = delta^t (consistente no tempo)
# Quasi-hiperbólico (beta-delta): D(t) = beta * delta^t para t>0
# Hiperbólico: D(t) = 1/(1 + k*t)

delta <- 0.95   # fator de desconto por período
beta  <- 0.7    # viés do presente (altere: 1=exponencial, 0.5=muito impaciente)
k     <- 0.5    # parâmetro hiperbólico

t <- 0:20

D_exp  <- delta^t
D_qh   <- ifelse(t == 0, 1, beta * delta^t)
D_hyp  <- 1 / (1 + k * t)

cat("=== Desconto Temporal ===\n\n")
cat(sprintf("delta=%.2f, beta=%.2f, k=%.2f\n\n", delta, beta, k))
cat(sprintf("%-4s %-12s %-12s %-12s\n", "t", "Exponencial", "Beta-delta", "Hiperbolico"))
cat(paste(rep("-", 45), collapse=""), "\n")
for (i in c(1, 2, 3, 4, 5, 6, 11, 21)) {
  cat(sprintf("%-4d %-12.4f %-12.4f %-12.4f\n",
      i-1, D_exp[i], D_qh[i], D_hyp[i]))
}

cat("\n=== Reversão de Preferencias ===\n")
cat("Escolha: R$100 em t vs R$120 em t+1\n\n")
for (t_start in c(0, 5, 10)) {
  # Exponencial: 100*D(t) vs 120*D(t+1)
  v_exp_now <- 100 * delta^t_start
  v_exp_later <- 120 * delta^(t_start + 1)
  # Beta-delta
  v_qh_now <- 100 * ifelse(t_start==0, 1, beta*delta^t_start)
  v_qh_later <- 120 * ifelse(t_start+1==0, 1, beta*delta^(t_start+1))
  cat(sprintf("t=%2d: Exp: %.1f vs %.1f -> %s  |  ",
      t_start, v_exp_now, v_exp_later,
      ifelse(v_exp_now > v_exp_later, "HOJE", "ESPERA")))
  cat(sprintf("QH: %.1f vs %.1f -> %s\n",
      v_qh_now, v_qh_later,
      ifelse(v_qh_now > v_qh_later, "HOJE", "ESPERA")))
}
cat("\nBeta-delta: prefere ESPERAR quando t=5,\n")
cat("mas HOJE quando t=0. Inconsistencia temporal!\n")

# Gráfico
par(mfrow = c(1, 2), mar = c(4, 4, 3, 1))
plot(t, D_exp, type = "l", col = "steelblue", lwd = 2,
     xlab = "Periodos (t)", ylab = "Fator de desconto D(t)",
     main = "Funcoes de Desconto", ylim = c(0, 1))
lines(t, D_qh, col = "#C8102E", lwd = 2, lty = 2)
lines(t, D_hyp, col = "#ff9800", lwd = 2, lty = 3)
legend("topright",
       legend = c("Exponencial", sprintf("Beta-delta (b=%.1f)", beta), "Hiperbolico"),
       col = c("steelblue", "#C8102E", "#ff9800"),
       lwd = 2, lty = c(1,2,3), cex = 0.75)
text(10, 0.8, "Queda brusca\nno presente!", col = "#C8102E", font = 2, cex = 0.8)

# Taxa de desconto instantânea
t2 <- seq(0.5, 20, by = 0.5)
r_exp <- -log(delta) * rep(1, length(t2))  # constante
r_hyp <- k / (1 + k * t2)  # decrescente
plot(t2, r_exp, type = "l", col = "steelblue", lwd = 2,
     xlab = "Periodos (t)", ylab = "Taxa de desconto",
     main = "Taxa Instantanea de Desconto", ylim = c(0, max(r_hyp)))
lines(t2, r_hyp, col = "#ff9800", lwd = 2, lty = 3)
legend("topright",
       legend = c("Exponencial (constante)", "Hiperbolico (decrescente)"),
       col = c("steelblue", "#ff9800"), lwd = 2, lty = c(1,3), cex = 0.75)

Saída do R

Aguardando execução...

WebR executa R no navegador. Com beta < 1, o "eu do presente" é mais impaciente que o "eu do futuro" — gerando procrastinação e reversão de preferências. Altere beta: com 1.0, não há viés.