WebR — Contrato Otimo com Risco Moral

Carregando WebR...

# ============================================
# Contrato Otimo com Risco Moral
# Exercicio Resolvido 19.1
# ============================================

# U = sqrt(w) - e,  e in {0, 1}
# p(1) = 3/4,  p(0) = 1/4,  U_bar = 3

pH <- 3/4   # prob bom resultado com esforco alto
pL <- 1/4   # prob bom resultado com esforco baixo
c_eH <- 1   # custo do esforco alto
c_eL <- 0   # custo do esforco baixo
U_bar <- 3  # utilidade de reserva

cat("====== CONTRATO OTIMO COM RISCO MORAL ======\n")
cat(sprintf("p(eH) = %.2f   p(eL) = %.2f\n", pH, pL))
cat(sprintf("c(eH) = %.0f   c(eL) = %.0f   U_bar = %.0f\n\n", c_eH, c_eL, U_bar))

# --- Resolucao: RP e RCI binding ---
# Defina a = sqrt(wH), b = sqrt(wL)
# RP:  pH*a + (1-pH)*b - c_eH = U_bar
# RCI: (pH-pL)*(a - b) >= c_eH - c_eL

# Com ambas binding:
# (pH-pL)*(a-b) = c_eH - c_eL  =>  a = b + (c_eH-c_eL)/(pH-pL)
delta_c <- c_eH - c_eL
delta_p <- pH - pL
gap <- delta_c / delta_p   # a - b

cat("--- Passo 1: RCI binding ---\n")
cat(sprintf("a - b = (c_eH - c_eL)/(pH - pL) = %.0f/%.2f = %.2f\n\n", delta_c, delta_p, gap))

# Substituindo na RP:  pH*(b+gap) + (1-pH)*b = U_bar + c_eH
b <- (U_bar + c_eH - pH * gap) / 1
a <- b + gap

wH <- a^2
wL <- b^2

cat("--- Passo 2: Salarios otimos ---\n")
cat(sprintf("a = sqrt(wH) = %.2f   b = sqrt(wL) = %.2f\n", a, b))
cat(sprintf("wH* = %.2f   wL* = %.2f\n", wH, wL))
cat(sprintf("Diferenca wH - wL = %.2f\n\n", wH - wL))

# --- Custo esperado ---
E_w <- pH * wH + (1 - pH) * wL
cat("--- Passo 3: Custo esperado ---\n")
cat(sprintf("E[w] = %.2f*%.2f + %.2f*%.2f = %.4f\n\n",
    pH, wH, 1-pH, wL, E_w))

# --- First-best ---
# sqrt(w_FB) - 1 = 3  =>  w_FB = 16
w_FB <- (U_bar + c_eH)^2
cat("--- First-best (esforco observavel) ---\n")
cat(sprintf("w_FB = (U_bar + c_eH)^2 = %.0f\n", w_FB))
cat(sprintf("Custo de agencia = E[w] - w_FB = %.4f\n\n", E_w - w_FB))

# --- Sensibilidade: variando delta_p ---
cat("--- Sensibilidade: efeito de (pH - pL) ---\n")
cat(sprintf("%-12s %-8s %-8s %-10s %-12s\n",
    "pH-pL", "wH*", "wL*", "E[w]", "Custo Ag."))
cat(strrep("-", 54), "\n")

dp_vals <- c(0.10, 0.20, 0.30, 0.50, 0.70, 0.90)
wH_vec <- numeric(length(dp_vals))
wL_vec <- numeric(length(dp_vals))
Ew_vec <- numeric(length(dp_vals))

for (k in seq_along(dp_vals)) {
  dp <- dp_vals[k]
  g <- delta_c / dp
  # pH = pL + dp; usar pL = (1-dp)/2 nao — manter pH fixo e variar pL
  # Melhor: fixar pH = 3/4, variar pL = pH - dp
  pHi <- 3/4
  pLi <- pHi - dp
  if (pLi < 0) pLi <- 0.01
  dpi <- pHi - pLi
  gi <- delta_c / dpi
  bi <- (U_bar + c_eH - pHi * gi) / 1
  ai <- bi + gi
  wHi <- ai^2; wLi <- bi^2
  Ewi <- pHi * wHi + (1 - pHi) * wLi
  wH_vec[k] <- wHi; wL_vec[k] <- wLi; Ew_vec[k] <- Ewi
  cat(sprintf("%-12.2f %-8.2f %-8.2f %-10.4f %-12.4f\n",
      dpi, wHi, wLi, Ewi, Ewi - w_FB))
}

cat("\nQuanto menor (pH-pL), mais dificil distinguir esforco de sorte\n")
cat("=> maior diferenca wH-wL => maior custo de agencia\n")

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

dp_fine <- seq(0.05, 0.95, length = 200)
ca_fine <- numeric(length(dp_fine))
for (k in seq_along(dp_fine)) {
  dp <- dp_fine[k]
  g <- delta_c / dp
  pHi <- 3/4
  bi <- (U_bar + c_eH - pHi * g) / 1
  ai <- bi + g
  Ewi <- pHi * ai^2 + (1 - pHi) * bi^2
  ca_fine[k] <- Ewi - w_FB
}

plot(dp_fine, ca_fine, type = "l", lwd = 3, col = "#dc3545",
     xlab = expression(p[H] - p[L] ~ "(informatividade do resultado)"),
     ylab = "Custo de agencia (E[w] - w_FB)",
     main = "Custo de agencia vs. informatividade")

abline(h = 0, col = "#adb5bd", lty = 3)
points(delta_p, E_w - w_FB, pch = 19, col = "#0d6efd", cex = 2)
text(delta_p + 0.08, E_w - w_FB + 0.3,
     paste0("ER 19.1\n(pH-pL=", delta_p, ")"),
     col = "#0d6efd", cex = 0.7, font = 2)

text(0.15, max(ca_fine) * 0.7,
     "Dificil distinguir\nesforco de sorte\n=> custo alto",
     col = "#dc3545", cex = 0.7, font = 2)
text(0.75, 0.5,
     "Facil distinguir\n=> custo baixo",
     col = "#198754", cex = 0.7, font = 2)

(Aguardando WebR...)