R Interativo — Lema de Shephard e Função Dispêndio

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

Edite o código e clique "Executar"R

# Lema de Shephard: dE/dp_i = h_i (demanda hicksiana)
# Cap. 4 — A dualidade em ação

# Cobb-Douglas: U = x^a * y^(1-a)
a <- 0.4;  px <- 3;  py <- 2;  u_bar <- 10

# Funcao Dispendio (analitica)
E <- function(px, py, u) {
  (px/a)^a * (py/(1-a))^(1-a) * u
}

# Demanda Hicksiana (analitica)
hx <- function(px, py, u) {
  u * (a * py / ((1-a) * px))^(1-a)
}
hy <- function(px, py, u) {
  u * ((1-a) * px / (a * py))^a
}

# Lema de Shephard (numerico)
dp <- 0.001
dE_dpx <- (E(px+dp, py, u_bar) - E(px-dp, py, u_bar)) / (2*dp)
dE_dpy <- (E(px, py+dp, u_bar) - E(px, py-dp, u_bar)) / (2*dp)

cat("=== Lema de Shephard ===\n\n")
cat(sprintf("Parametros: a=%.1f, px=%.0f, py=%.0f, u=%.0f\n\n", a, px, py, u_bar))
cat(sprintf("E(p,u) = %.4f\n\n", E(px, py, u_bar)))
cat("Bem x:\n")
cat(sprintf("  h_x (analitico) = %.4f\n", hx(px, py, u_bar)))
cat(sprintf("  dE/dpx (numerico) = %.4f\n\n", dE_dpx))
cat("Bem y:\n")
cat(sprintf("  h_y (analitico) = %.4f\n", hy(px, py, u_bar)))
cat(sprintf("  dE/dpy (numerico) = %.4f\n\n", dE_dpy))
cat("Shephard confirmado: dE/dp_i = h_i!\n\n")

# Propriedade: E é côncava em preços
cat("E e concava em precos (pela envoltoria):\n")
d2E_dpx2 <- (E(px+dp,py,u_bar)-2*E(px,py,u_bar)+E(px-dp,py,u_bar))/dp^2
cat(sprintf("  d2E/dpx2 = %.4f < 0\n", d2E_dpx2))

# Gráfico
par(mfrow = c(1, 2), mar = c(4, 4, 3, 1))

# E(px) — côncava
px_vec <- seq(0.5, 8, length.out = 200)
E_vec  <- sapply(px_vec, function(p) E(p, py, u_bar))
plot(px_vec, E_vec, type = "l", col = "steelblue", lwd = 2,
     xlab = "px", ylab = "E(px, py, u)",
     main = "Funcao Dispendio (concava)")
# Tangente (Shephard)
tang <- E(px, py, u_bar) + dE_dpx * (px_vec - px)
lines(px_vec, tang, col = "#C8102E", lwd = 1.5, lty = 2)
points(px, E(px, py, u_bar), pch = 19, col = "#333", cex = 1.5)
text(px + 1, E(px, py, u_bar) - 3,
     sprintf("incl = h_x = %.1f", hx(px, py, u_bar)),
     col = "#C8102E", font = 2, cex = 0.8)

# h_x(px) — negativamente inclinada
hx_vec <- sapply(px_vec, function(p) hx(p, py, u_bar))
plot(hx_vec, px_vec, type = "l", col = "#C8102E", lwd = 2,
     xlab = "h_x (demanda hicksiana)", ylab = "px",
     main = "Demanda Hicksiana de x")
points(hx(px, py, u_bar), px, pch = 19, col = "#333", cex = 1.5)

Saída do R

Aguardando execução...

WebR executa R no navegador. O Lema de Shephard conecta a função dispêndio à demanda hicksiana: dE/dp_i = h_i. A concavidade de E em preços garante que h é negativamente inclinada.