WebR — Lema de Hotelling: Verificação

Carregando WebR...

# ============================================
# Lema de Hotelling: verificacao numerica
# q = K^(1/3) * L^(1/3) (retornos decrescentes)
# ============================================

# --- Funcao lucro analitica ---
# pi(p, w, v) = p^3 / (27*w*v)
pi_fun <- function(p, w, v) p^3 / (27 * w * v)

# --- Demandas otimas analiticas ---
q_star <- function(p, w, v) p^2 / (9 * w * v)
L_star <- function(p, w, v) p^3 / (27 * w^2 * v)
K_star <- function(p, w, v) p^3 / (27 * w * v^2)

# --- Verificacao numerica do Lema ---
p0 <- 12; w0 <- 1; v0 <- 1
eps <- 1e-6

# Derivadas numericas
dpi_dp <- (pi_fun(p0+eps, w0, v0) - pi_fun(p0-eps, w0, v0)) / (2*eps)
dpi_dw <- (pi_fun(p0, w0+eps, v0) - pi_fun(p0, w0-eps, v0)) / (2*eps)
dpi_dv <- (pi_fun(p0, w0, v0+eps) - pi_fun(p0, w0, v0-eps)) / (2*eps)

cat("====== LEMA DE HOTELLING: VERIFICACAO ======\n")
cat("Tecnologia: q = K^(1/3) * L^(1/3)\n")
cat("Precos: p =", p0, " w =", w0, " v =", v0, "\n\n")

cat("--- Solucao otima ---\n")
cat("K* =", K_star(p0, w0, v0), "\n")
cat("L* =", L_star(p0, w0, v0), "\n")
cat("q* =", q_star(p0, w0, v0), "\n")
cat("pi* =", pi_fun(p0, w0, v0), "\n\n")

cat("--- Lema de Hotelling ---\n")
cat("d(pi)/dp (numerico) =", round(dpi_dp, 4), "\n")
cat("q* (analitico)      =", q_star(p0, w0, v0), "\n")
cat("  Diferenca:", abs(dpi_dp - q_star(p0, w0, v0)), "\n\n")

cat("d(pi)/dw (numerico) =", round(dpi_dw, 4), "\n")
cat("-L* (analitico)     =", -L_star(p0, w0, v0), "\n")
cat("  Diferenca:", abs(dpi_dw - (-L_star(p0, w0, v0))), "\n\n")

cat("d(pi)/dv (numerico) =", round(dpi_dv, 4), "\n")
cat("-K* (analitico)     =", -K_star(p0, w0, v0), "\n")
cat("  Diferenca:", abs(dpi_dv - (-K_star(p0, w0, v0))), "\n\n")

cat("=> Lema de Hotelling verificado!\n\n")

# --- Propriedades da funcao lucro ---
cat("--- Propriedades de pi ---\n")
cat("Homogeneidade: pi(2p, 2w, 2v) / (2*pi(p,w,v)) =",
    pi_fun(2*p0, 2*w0, 2*v0) / (2*pi_fun(p0, w0, v0)),
    " (= 1 => grau 1)\n")
cat("d2(pi)/dp2 =", round((pi_fun(p0+eps,w0,v0) - 2*pi_fun(p0,w0,v0) + pi_fun(p0-eps,w0,v0))/eps^2, 2),
    " > 0 => CONVEXA em p (lei da oferta)\n")

# --- Grafico: oferta q*(p) e pi(p) ---
par(mfrow = c(1, 2), mar = c(4.5, 4.5, 3, 1), bg = "#f8f9fa")

p_seq <- seq(1, 30, length = 200)

# Painel 1: Oferta q*(p) = p^2/(9wv)
plot(p_seq, q_star(p_seq, w0, v0), type = "l", lwd = 3, col = "#0d6efd",
     xlab = "p (preco do produto)", ylab = "q*",
     main = "Oferta: q* = dpi/dp", cex.lab = 1.1)
points(p0, q_star(p0, w0, v0), pch = 19, col = "#dc3545", cex = 1.5)
text(p0, q_star(p0, w0, v0),
     paste0("  p=", p0, ", q*=", q_star(p0, w0, v0)),
     pos = 4, cex = 0.8, col = "#dc3545", font = 2)
text(15, q_star(15, w0, v0)*0.8, "q* = p^2/(9wv)\ncrescente em p\n(lei da oferta!)",
     cex = 0.8, col = "#0d6efd")

# Painel 2: Funcao lucro pi(p)
plot(p_seq, pi_fun(p_seq, w0, v0), type = "l", lwd = 3, col = "#198754",
     xlab = "p (preco do produto)", ylab = "pi*",
     main = "Funcao lucro: convexa em p", cex.lab = 1.1)
points(p0, pi_fun(p0, w0, v0), pch = 19, col = "#dc3545", cex = 1.5)

# Tangente (inclinacao = q*)
tang <- pi_fun(p0, w0, v0) + q_star(p0, w0, v0) * (p_seq - p0)
lines(p_seq, tang, lwd = 1.5, col = "#dc3545", lty = 2)
text(p0, pi_fun(p0, w0, v0),
     paste0("  incl = q* = ", q_star(p0, w0, v0)),
     pos = 4, cex = 0.8, col = "#dc3545", font = 2)

legend("topleft",
       legend = c("pi*(p)", "Tangente (Hotelling)"),
       col = c("#198754", "#dc3545"),
       lwd = c(3, 1.5), lty = c(1, 2), cex = 0.8, bg = "white")

(Aguardando WebR...)