R Interativo — Simulação de Bem de Giffen

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

Edite o código e clique "Executar"R

# Simulação: Bem de Giffen via Slutsky
# Cap. 5 — Quando o efeito-renda domina o efeito-substituição

# Preferências quasi-côncavas com possível Giffen:
# U(x,y) = a*x + b*ln(y) — "quase-linear em y"
# x = subsistência (arroz), y = luxo

# Demanda: max a*x + b*ln(y) s.a. px*x + py*y = m
# CPO: a/px = b/(py*y) => y = b*px/(a*py)
# x = (m - py*y)/px = m/px - b/a

a_pref <- 1    # peso de x (subsistência)
b_pref <- 15   # peso de y (altere: 15 -> Giffen; 5 -> normal)
py <- 5;  m <- 50

cat("=== Simulacao Giffen via Slutsky ===\n\n")

# Demanda de x como funcao de px
x_dem <- function(px) m/px - b_pref/a_pref
y_dem <- function(px) b_pref * px / (a_pref * py)

# Testar para vários px
px_vec <- seq(1, 8, by = 0.5)
cat(sprintf("%-6s %-8s %-8s %-10s\n", "px", "x*", "y*", "Giffen?"))
cat(paste(rep("-", 35), collapse=""), "\n")
for (p in px_vec) {
  x <- x_dem(p); y <- y_dem(p)
  if (x > 0 & y > 0) {
    cat(sprintf("%-6.1f %-8.2f %-8.2f %-10s\n",
        p, x, y, ifelse(x > x_dem(p-0.5) & p > 1.5, "SIM!", "")))
  }
}

# Slutsky em px0
px0 <- 3; px1 <- 4
xA <- x_dem(px0); yA <- y_dem(px0)
xC <- x_dem(px1); yC <- y_dem(px1)

# Efeito substituicao (Slutsky): compensar renda
m_comp <- px1 * xA + py * yA  # renda para comprar cesta A a novos precos
xB <- m_comp/px1 - b_pref/a_pref
ES <- xB - xA  # efeito substituição
ER <- xC - xB  # efeito renda
ET <- xC - xA  # efeito total

cat(sprintf("\nSlutsky: px %.0f -> %.0f\n", px0, px1))
cat(sprintf("  A(%.1f, %.1f) -> C(%.1f, %.1f)\n", xA, yA, xC, yC))
cat(sprintf("  Ef. Substituicao = %.2f (sempre <= 0)\n", ES))
cat(sprintf("  Ef. Renda        = %.2f %s\n", ER,
    ifelse(ER > 0, "(positivo -> inferior!)", "")))
cat(sprintf("  Ef. Total        = %.2f %s\n", ET,
    ifelse(ET > 0, "-> GIFFEN!", "(normal)")))

# Gráfico: demanda "anômala"
par(mar = c(4, 4, 3, 1))
px_plot <- seq(1, 8, length.out = 200)
x_plot <- sapply(px_plot, x_dem)
valid <- x_plot > 0

plot(x_plot[valid], px_plot[valid], type = "l", col = "#C8102E", lwd = 2,
     xlab = "x* (quantidade)", ylab = "px (preco)",
     main = "Demanda de Giffen: dx/dp > 0!")
# Marcar trecho Giffen (se existir)
dx <- diff(x_plot[valid])
dp <- diff(px_plot[valid])
giffen_idx <- which(dx > 0 & dp > 0)
if (length(giffen_idx) > 0) {
  lines(x_plot[valid][giffen_idx], px_plot[valid][giffen_idx],
        col = "#ff9800", lwd = 4)
  text(mean(x_plot[valid][giffen_idx]), mean(px_plot[valid][giffen_idx]) + 0.5,
       "Trecho Giffen!", col = "#ff9800", font = 2, cex = 0.9)
}
points(xA, px0, pch = 19, col = "#333", cex = 1.3)
points(xC, px1, pch = 17, col = "#C8102E", cex = 1.3)
text(xA + 1, px0, "A", font = 2); text(xC + 1, px1, "C", font = 2)

Saída do R

Aguardando execução...

WebR executa R no navegador. Um bem de Giffen exige: (1) bem inferior e (2) efeito-renda dominando o efeito-substituição. Altere b_pref: com b=5 é normal; com b=15, x vira Giffen!