WebR — Curva Envoltória: Curto Prazo vs. Longo Prazo

Carregando WebR...

# ============================================
# Envoltoria: CMe de curto vs. longo prazo
# q = K^(1/4) * L^(1/4) (retornos decrescentes)
# ============================================

w <- 10;  v <- 10
alpha <- 1/4;  beta_p <- 1/4
s <- alpha + beta_p   # 0.5

# --- Custo de longo prazo ---
# Com alpha = beta e w = v => K = L => K^0.5 = q => K = q^2
# CT_LP = 2*v*q^2 = 20*q^2
CT_LP <- function(q) 20 * q^2
CMe_LP <- function(q) 20 * q

# --- Custo de curto prazo (K fixo em Kbar) ---
# q = Kbar^(1/4) * L^(1/4) => L = q^4 / Kbar
# CT_CP = v*Kbar + w * q^4 / Kbar
CT_CP <- function(q, Kbar) v * Kbar + w * q^4 / Kbar
CMe_CP <- function(q, Kbar) v * Kbar / q + w * q^3 / Kbar

# Capital otimo de LP para cada q: K* = q^2
K_star <- function(q) q^2

# --- Verificacao: CT_CP - CT_LP >= 0 ---
q_seq <- seq(0.1, 3, length = 500)
Kbar_vals <- c(0.25, 1, 2.25, 4)  # K* para q = 0.5, 1, 1.5, 2

cat("====== ENVOLTORIA: VERIFICACAO ======\n")
cat("CT_LP(q) = 20*q^2   |   CMe_LP(q) = 20*q\n\n")

for (kb in Kbar_vals) {
  q_tang <- sqrt(kb)  # q onde K* = Kbar
  diff <- CT_CP(q_tang, kb) - CT_LP(q_tang)
  cat(sprintf("Kbar = %.2f => tangencia em q = %.2f | CT_CP - CT_LP = %.4f\n",
              kb, q_tang, diff))
}

cat("\nPara Kbar = 1, q = 1:\n")
cat("  CT_CP = ", CT_CP(1, 1), "\n")
cat("  CT_LP = ", CT_LP(1), "\n")
cat("  Diferenca = 10*(1 - q^2)^2 = ", 10*(1 - 1)^2, " (= 0, OK!)\n")

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

# Painel 1: Custo Total
cores <- c("#adb5bd", "#fd7e14", "#6f42c1", "#20c997")
plot(q_seq, CT_LP(q_seq), type = "l", lwd = 3, col = "#0d6efd",
     xlab = "q", ylab = "$", main = "Custo Total",
     ylim = c(0, max(CT_LP(q_seq)) * 1.05), cex.lab = 1.1)

for (i in seq_along(Kbar_vals)) {
  kb <- Kbar_vals[i]
  lines(q_seq, CT_CP(q_seq, kb), lwd = 1.5, col = cores[i], lty = 2)
  q_t <- sqrt(kb)
  if (q_t <= max(q_seq)) {
    points(q_t, CT_LP(q_t), pch = 19, col = "#dc3545", cex = 1.2)
  }
}

legend("topleft",
       legend = c("CT_LP (envoltoria)",
                  paste0("CT_CP (K=", Kbar_vals, ")")),
       col = c("#0d6efd", cores),
       lwd = c(3, rep(1.5, 4)), lty = c(1, rep(2, 4)),
       cex = 0.75, bg = "white")

# Painel 2: Custo Medio
plot(q_seq, CMe_LP(q_seq), type = "l", lwd = 3, col = "#0d6efd",
     xlab = "q", ylab = "$/unidade", main = "Custo Medio",
     ylim = c(0, 80), cex.lab = 1.1)

for (i in seq_along(Kbar_vals)) {
  kb <- Kbar_vals[i]
  cme_cp <- CMe_CP(q_seq, kb)
  cme_cp[cme_cp > 100] <- NA
  lines(q_seq, cme_cp, lwd = 1.5, col = cores[i], lty = 2)
  q_t <- sqrt(kb)
  if (q_t <= max(q_seq) & q_t > 0.1) {
    points(q_t, CMe_LP(q_t), pch = 19, col = "#dc3545", cex = 1.2)
  }
}

legend("topright",
       legend = c("CMe_LP (envoltoria)",
                  paste0("CMe_CP (K=", Kbar_vals, ")")),
       col = c("#0d6efd", cores),
       lwd = c(3, rep(1.5, 4)), lty = c(1, rep(2, 4)),
       cex = 0.75, bg = "white")

cat("\n=> Pontos vermelhos = tangencias (onde Kbar = K* de LP)\n")
cat("=> CMe_LP sempre <= CMe_CP (envoltoria inferior)\n")

(Aguardando WebR...)