WebR — Discriminação de Preços de 3º Grau

Carregando WebR...

# ============================================
# Discriminacao de precos de 3o grau
# Exercicio Resolvido 15.4
# ============================================

# --- Parametros ---
a1 <- 120; b1 <- 2  # Mercado 1: p1 = a1 - b1*q1
a2 <- 80;  b2 <- 1  # Mercado 2: p2 = a2 - b2*q2
c <- 20              # CMg constante

cat("====== DISCRIMINACAO DE 3o GRAU ======\n")
cat("Mercado 1: p =", a1, "-", b1, "q  (demanda mais inelastica)\n")
cat("Mercado 2: p =", a2, "-", b2, "q  (demanda mais elastica)\n")
cat("CMg =", c, "\n\n")

# --- Equilibrio com discriminacao ---
q1 <- (a1 - c) / (2 * b1)
p1 <- a1 - b1 * q1
q2 <- (a2 - c) / (2 * b2)
p2 <- a2 - b2 * q2

eps1 <- (-1/b1) * (p1/q1)
eps2 <- (-1/b2) * (p2/q2)
L1 <- (p1 - c) / p1
L2 <- (p2 - c) / p2

lucro1 <- (p1 - c) * q1
lucro2 <- (p2 - c) * q2
lucro_total <- lucro1 + lucro2

cat("--- Com discriminacao ---\n")
cat(sprintf("Mercado 1: q = %-6.1f  p = %-6.1f  eps = %-6.3f  L = %-6.4f  Lucro = %-8.1f\n",
    q1, p1, eps1, L1, lucro1))
cat(sprintf("Mercado 2: q = %-6.1f  p = %-6.1f  eps = %-6.3f  L = %-6.4f  Lucro = %-8.1f\n",
    q2, p2, eps2, L2, lucro2))
cat("Lucro total =", lucro_total, "\n")
cat("Razao de precos: p1/p2 =", round(p1/p2, 3), "\n\n")

# Verificacao: razao de precos pela formula
razao_teorica <- (1 - 1/abs(eps2)) / (1 - 1/abs(eps1))
cat("Verificacao: (1-1/|eps2|)/(1-1/|eps1|) =", round(razao_teorica, 3), "\n\n")

# --- Equilibrio sem discriminacao (preco unico) ---
# Demanda agregada: Q = q1 + q2 = (a1-p)/(b1) + (a2-p)/(b2)
# Para p < min(a1,a2) = 80: Q = (a1/b1 + a2/b2) - p*(1/b1 + 1/b2)
# Inversa: p = [a1/b1 + a2/b2 - Q] / (1/b1 + 1/b2)
A <- a1/b1 + a2/b2
B <- 1/b1 + 1/b2
# p = (A - Q)/B => RMg = (A - 2Q)/B
# (A - 2Q)/B = c => Q_u = (A - c*B)/2
Qu <- (A - c * B) / 2
pu <- (A - Qu) / B
lucro_u <- (pu - c) * Qu

cat("--- Sem discriminacao (preco unico) ---\n")
cat("Q =", round(Qu, 2), "  p =", round(pu, 2), "\n")
cat("Lucro =", round(lucro_u, 1), "\n")
cat("Ganho da discriminacao:", round(lucro_total - lucro_u, 1),
    "(+", round((lucro_total/lucro_u - 1)*100, 1), "%)\n\n")

cat("CONCLUSAO: O mercado com demanda MAIS INELASTICA paga mais.\n")
cat("p1 =", p1, "> p2 =", p2, "porque |eps1| =", round(abs(eps1), 2),
    "< |eps2| =", round(abs(eps2), 2), "\n")

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

# Mercado 1
q_seq1 <- seq(0, a1/b1, length = 200)
plot(q_seq1, a1 - b1*q_seq1, type = "l", lwd = 3, col = "#0d6efd",
     ylim = c(0, a1 + 5), xlim = c(0, 65),
     xlab = "q", ylab = "p",
     main = "Mercado 1 (inelastico)")
lines(q_seq1, a1 - 2*b1*q_seq1, lwd = 2, col = "#6f42c1", lty = 2)
abline(h = c, col = "#dc3545", lwd = 2)
rect(0, c, q1, p1, col = rgb(0.1, 0.53, 0.33, 0.15), border = "#198754", lty = 2)
points(q1, p1, pch = 19, col = "#dc3545", cex = 2)
text(q1 + 2, p1, paste0("(", q1, ", ", p1, ")"), col = "#dc3545", cex = 0.8, font = 2)
text(q1/2, (p1+c)/2, paste0("pi = ", lucro1), col = "#198754", cex = 0.9, font = 2)

# Mercado 2
q_seq2 <- seq(0, a2/b2, length = 200)
plot(q_seq2, a2 - b2*q_seq2, type = "l", lwd = 3, col = "#0d6efd",
     ylim = c(0, a1 + 5), xlim = c(0, 65),
     xlab = "q", ylab = "p",
     main = "Mercado 2 (elastico)")
lines(q_seq2, a2 - 2*b2*q_seq2, lwd = 2, col = "#6f42c1", lty = 2)
abline(h = c, col = "#dc3545", lwd = 2)
rect(0, c, q2, p2, col = rgb(0.1, 0.53, 0.33, 0.15), border = "#198754", lty = 2)
points(q2, p2, pch = 19, col = "#dc3545", cex = 2)
text(q2 + 2, p2, paste0("(", q2, ", ", p2, ")"), col = "#dc3545", cex = 0.8, font = 2)
text(q2/2, (p2+c)/2, paste0("pi = ", lucro2), col = "#198754", cex = 0.9, font = 2)

(Aguardando WebR...)