Este script reproduce, paso a paso, el mismo
contenido del notebook de Python/Colab, pero en R. Usamos
Deriv (derivación simbólica), Ryacas
opcionalmente para integrales simbólicas, y ggplot2 para
las gráficas.
paquetes <- c("ggplot2", "Deriv")
instalar <- paquetes[!(paquetes %in% installed.packages()[, "Package"])]
if (length(instalar)) install.packages(instalar)
library(ggplot2)
library(Deriv)
Un monopolio es una estructura de mercado en la que una sola empresa es la oferente de un bien sin sustitutos cercanos y enfrenta directamente la curva de demanda de mercado. A diferencia del competidor perfecto (tomador de precios), el monopolista es formador de precios.
Poder de mercado: capacidad de fijar el precio por encima del costo marginal de forma rentable y sostenida. El monopolio es el caso extremo.
\[P(Q) = a - bQ, \qquad IT(Q) = P(Q)\cdot Q = aQ - bQ^2\]
# Definimos las funciones como funciones de R (parámetros a, b, c, F)
P_fun <- function(Q, a, b) a - b * Q
IT_fun <- function(Q, a, b) P_fun(Q, a, b) * Q
# Derivada simbólica de IT respecto a Q usando Deriv
IT_expr <- quote(a * Q - b * Q^2)
IMg_expr <- Deriv(IT_expr, "Q")
IMg_expr # debe ser: a - 2*b*Q
## a - 2 * (b * Q)
\[IMg(Q) = a - 2bQ\]
Propiedad clave: la pendiente de \(IMg\) (\(-2b\)) es el doble de la de la demanda (\(-b\)), por lo que \(IMg(Q) < P(Q)\) para toda \(Q>0\). Esta es la diferencia esencial respecto a competencia perfecta (\(IMg=P\)).
a_val <- 100; b_val <- 2
Q_seq <- seq(0, a_val / b_val, length.out = 200)
df1 <- data.frame(
Q = Q_seq,
D = a_val - b_val * Q_seq,
IMg = a_val - 2 * b_val * Q_seq
)
ggplot(df1, aes(x = Q)) +
geom_line(aes(y = D, color = "Demanda (D)")) +
geom_line(data = subset(df1, IMg >= 0), aes(y = IMg, color = "IMg")) +
labs(y = "P, IMg", color = "", title = "Demanda vs. Ingreso Marginal") +
theme_minimal()
\[CT(Q) = cQ + F, \qquad CMg = c\]
CT_expr <- quote(c * Q + Fc) # Fc para evitar choque con la función F de R
CMg_expr <- Deriv(CT_expr, "Q")
CMg_expr # debe ser: c
## c
\[\pi(Q) = IT(Q) - CT(Q), \qquad \frac{d\pi}{dQ}=0 \;\Rightarrow\; IMg=CMg\]
pi_expr <- quote(a * Q - b * Q^2 - (c * Q + Fc))
dpi_dQ <- Deriv(pi_expr, "Q")
d2pi_dQ2 <- Deriv(dpi_dQ, "Q")
dpi_dQ # CPO: a - 2*b*Q - c = 0 -> IMg = CMg
## a - (2 * (b * Q) + c)
d2pi_dQ2 # CSO: -2*b (debe ser negativo)
## -(2 * b)
CSO: \(-2b<0\) ✔ (pues \(b>0\)) → confirma un máximo.
\[Q^* = \frac{a-c}{2b}, \qquad P^* = \frac{a+c}{2}\]
Q_star_fun <- function(a, b, c) (a - c) / (2 * b)
P_star_fun <- function(a, b, c) (a + c) / 2
\(P = 100 - 2Q\), \(CMg = 20\) (es decir \(a=100, b=2, c=20, F=0\)).
a_v <- 100; b_v <- 2; c_v <- 20; F_v <- 0
Q_star <- Q_star_fun(a_v, b_v, c_v)
P_star <- P_star_fun(a_v, b_v, c_v)
pi_star <- (P_star - c_v) * Q_star - F_v # beneficio = (P*-CMg)*Q* - F
cat("Q* =", Q_star, "\n")
## Q* = 20
cat("P* =", P_star, "\n")
## P* = 60
cat("Beneficio pi* =", pi_star, "\n")
## Beneficio pi* = 800
Resultado: Q*=20, P*=60, π*=800 — coincide con el cálculo manual.
Q_seq2 <- seq(0, 55, length.out = 300)
df2 <- data.frame(
Q = Q_seq2,
D = a_v - b_v * Q_seq2,
IMg = a_v - 2 * b_v * Q_seq2,
CMg = c_v
)
ggplot(df2, aes(x = Q)) +
geom_line(aes(y = D, color = "Demanda")) +
geom_line(data = subset(df2, IMg >= 0), aes(y = IMg, color = "IMg")) +
geom_line(aes(y = CMg, color = "CMg")) +
geom_rect(aes(xmin = 0, xmax = Q_star, ymin = c_v, ymax = P_star),
fill = "green", alpha = 0.02, inherit.aes = FALSE) +
geom_point(aes(x = Q_star, y = P_star), size = 2) +
annotate("text", x = Q_star + 3, y = P_star + 3, label = "(Q*, P*)") +
labs(y = "P", color = "", title = "Equilibrio de monopolio: pi* = (P*-CMg) x Q*") +
theme_minimal()
\[P = CMg \;\Rightarrow\; Q_{CP}\]
Q_cp_fun <- function(a, b, c) (a - c) / b
Q_cp <- Q_cp_fun(a_v, b_v, c_v)
P_cp <- c_v
cat("Q_CP =", Q_cp, " | P_CP =", P_cp, "\n")
## Q_CP = 40 | P_CP = 20
cat("Monopolio: Q*=", Q_star, ", P*=", P_star, "\n")
## Monopolio: Q*= 20 , P*= 60
cat("Competencia perfecta: Q_CP=", Q_cp, ", P_CP=", P_cp, "\n")
## Competencia perfecta: Q_CP= 40 , P_CP= 20
El monopolista produce menos y cobra un precio mayor que el mercado competitivo.
\[DWL = \int_{Q^*}^{Q_{CP}} \left[P(q)-CMg\right] dq = \frac12 (Q_{CP}-Q^*)(P^*-CMg)\]
# Integración numérica (equivalente a integrate() en R) para verificar la fórmula
integrando <- function(q, a, b, c) (a - b * q) - c
DWL_integral <- integrate(integrando, lower = Q_star, upper = Q_cp,
a = a_v, b = b_v, c = c_v)$value
DWL_formula <- 0.5 * (Q_cp - Q_star) * (P_star - c_v)
cat("DWL (integral) =", DWL_integral, "\n")
## DWL (integral) = 400
cat("DWL (triángulo) =", DWL_formula, "\n")
## DWL (triángulo) = 400
Ambos métodos dan DWL = 400.
df3 <- df2
ec_df <- data.frame(Q = seq(0, Q_star, length.out = 50))
ec_df$D <- a_v - b_v * ec_df$Q
dwl_df <- data.frame(Q = seq(Q_star, Q_cp, length.out = 50))
dwl_df$D <- a_v - b_v * dwl_df$Q
ggplot(df3, aes(x = Q)) +
geom_line(aes(y = D, color = "Demanda")) +
geom_line(data = subset(df3, IMg >= 0), aes(y = IMg, color = "IMg")) +
geom_line(aes(y = CMg, color = "CMg")) +
geom_ribbon(data = ec_df, aes(ymin = P_star, ymax = D), fill = "cyan", alpha = 0.35) +
geom_rect(aes(xmin = 0, xmax = Q_star, ymin = c_v, ymax = P_star),
fill = "orange", alpha = 0.03, inherit.aes = FALSE) +
geom_ribbon(data = dwl_df, aes(ymin = c_v, ymax = D), fill = "gray40", alpha = 0.6) +
geom_vline(xintercept = c(Q_star, Q_cp), linetype = "dashed", color = "gray50") +
labs(y = "P", color = "", title = "Excedentes bajo monopolio y triángulo de Harberger") +
theme_minimal()
\[L = \frac{P-CMg}{P} = \frac{1}{|\varepsilon_D|}\]
L <- (P_star - c_v) / P_star
cat("Índice de Lerner L =", round(L, 3), "\n")
## Índice de Lerner L = 0.667
# Elasticidad-precio de la demanda en (Q*, P*)
dQ_dP <- -1 / b_v
epsilon_D <- dQ_dP * (P_star / Q_star)
L_via_eps <- 1 / abs(epsilon_D)
cat("Elasticidad e_D =", epsilon_D, "\n")
## Elasticidad e_D = -1.5
cat("L via 1/|e_D| =", round(L_via_eps, 3), "\n")
## L via 1/|e_D| = 0.667
Ambas vías dan L ≈ 0.667.
eps_seq <- seq(1.05, 8, length.out = 200)
df_L <- data.frame(eps = eps_seq, L = 1 / eps_seq)
ggplot(df_L, aes(x = eps, y = L)) +
geom_line(color = "purple") +
geom_vline(xintercept = 1, linetype = "dashed", color = "gray50") +
labs(x = expression("|" * epsilon[D] * "|"), y = "L",
title = expression(L == 1/"|"*epsilon[D]*"|")) +
theme_minimal()
\(P = 200-4Q\), \(CT(Q)=20Q+500\).
a1 <- 200; b1 <- 4; c1 <- 20; F1 <- 500
Qs1 <- Q_star_fun(a1, b1, c1)
Ps1 <- P_star_fun(a1, b1, c1)
pi1 <- (Ps1 - c1) * Qs1 - F1
cso1 <- -2 * b1
cat("a) IMg(Q) = 200 - 8Q\n")
## a) IMg(Q) = 200 - 8Q
cat("b) Q* =", Qs1, " P* =", Ps1, "\n")
## b) Q* = 22.5 P* = 110
cat("c) Beneficio máximo =", pi1, "\n")
## c) Beneficio máximo = 1525
cat("d) CSO =", cso1, "(negativo -> máximo)\n")
## d) CSO = -8 (negativo -> máximo)
Q1seq <- seq(0, a1 / b1, length.out = 300)
df_e1 <- data.frame(Q = Q1seq, D = a1 - b1 * Q1seq, IMg = a1 - 2 * b1 * Q1seq, CMg = c1)
ggplot(df_e1, aes(x = Q)) +
geom_line(aes(y = D, color = "D")) +
geom_line(data = subset(df_e1, IMg >= 0), aes(y = IMg, color = "IMg")) +
geom_line(aes(y = CMg, color = "CMg")) +
geom_point(aes(x = Qs1, y = Ps1), size = 2) +
labs(y = "P", color = "", title = "Ejercicio 1: equilibrio de monopolio") +
theme_minimal()
Qcp1 <- Q_cp_fun(a1, b1, c1)
DWL1_formula <- 0.5 * (Qcp1 - Qs1) * (Ps1 - c1)
DWL1_integral <- integrate(integrando, lower = Qs1, upper = Qcp1, a = a1, b = b1, c = c1)$value
cat("a) Q_CP =", Qcp1, "\n")
## a) Q_CP = 45
cat("b) DWL (fórmula) =", DWL1_formula, "\n")
## b) DWL (fórmula) = 1012.5
cat("c) DWL (integral) =", DWL1_integral, "\n")
## c) DWL (integral) = 1012.5
dwl1_df <- data.frame(Q = seq(Qs1, Qcp1, length.out = 50))
dwl1_df$D <- a1 - b1 * dwl1_df$Q
ggplot(df_e1, aes(x = Q)) +
geom_line(aes(y = D, color = "D")) +
geom_line(data = subset(df_e1, IMg >= 0), aes(y = IMg, color = "IMg")) +
geom_line(aes(y = CMg, color = "CMg")) +
geom_ribbon(data = dwl1_df, aes(ymin = c1, ymax = D), fill = "gray40", alpha = 0.6) +
geom_vline(xintercept = c(Qs1, Qcp1), linetype = "dashed", color = "gray50") +
labs(y = "P", color = "", title = "Ejercicio 2: triángulo de Harberger") +
theme_minimal()
L1 <- (Ps1 - c1) / Ps1
dQdP1 <- -1 / b1
eps1 <- dQdP1 * (Ps1 / Qs1)
L1_via_eps <- 1 / abs(eps1)
cat("a) L =", round(L1, 3), "\n")
## a) L = 0.818
cat("b) e_D =", round(eps1, 3), "\n")
## b) e_D = -1.222
cat("c) 1/|e_D| =", round(L1_via_eps, 3), " -> coincide con L:", isTRUE(all.equal(L1, L1_via_eps)), "\n")
## c) 1/|e_D| = 0.818 -> coincide con L: TRUE
cat("d) Con |e_D| ~", round(abs(eps1),2), ", la demanda es poco elástica, permitiendo",
"un margen precio-costo considerable (poder de mercado alto).\n")
## d) Con |e_D| ~ 1.22 , la demanda es poco elástica, permitiendo un margen precio-costo considerable (poder de mercado alto).
\(P=150-3Q\), \(CMg(Q)=10+2Q\).
# IMg(Q) = 150 - 6Q (derivada de IT = 150Q - 3Q^2)
IMg4_expr <- Deriv(quote(150 * Q - 3 * Q^2), "Q")
IMg4_expr
## 150 - 6 * Q
# a) Resolver IMg = CMg -> 150 - 6Q = 10 + 2Q -> Q* = 140/8 = 17.5
Q4_star <- (150 - 10) / (6 + 2)
P4_star <- 150 - 3 * Q4_star
# c) Equilibrio competitivo: P = CMg -> 150-3Q = 10+2Q -> Q_CP = 140/5 = 28
Q4_cp <- (150 - 10) / (3 + 2)
P4_cp <- 150 - 3 * Q4_cp
cat("a) Q* =", Q4_star, "\n")
## a) Q* = 17.5
cat("b) P* =", P4_star, "\n")
## b) P* = 97.5
cat("c) Q_CP =", Q4_cp, " P_CP =", P4_cp, "\n")
## c) Q_CP = 28 P_CP = 66
# d) DWL por integración numérica: integral de [P(q) - CMg(q)] dq entre Q* y Q_CP
integrando4 <- function(q) (150 - 3 * q) - (10 + 2 * q)
DWL4 <- integrate(integrando4, lower = Q4_star, upper = Q4_cp)$value
cat("d) DWL =", DWL4, "\n")
## d) DWL = 275.625
Q4seq <- seq(0, 50, length.out = 300)
df_e4 <- data.frame(Q = Q4seq, D = 150 - 3 * Q4seq, IMg = 150 - 6 * Q4seq, CMg = 10 + 2 * Q4seq)
dwl4_df <- data.frame(Q = seq(Q4_star, Q4_cp, length.out = 50))
dwl4_df$D <- 150 - 3 * dwl4_df$Q
dwl4_df$CMg <- 10 + 2 * dwl4_df$Q
ggplot(df_e4, aes(x = Q)) +
geom_line(aes(y = D, color = "D")) +
geom_line(data = subset(df_e4, IMg >= 0), aes(y = IMg, color = "IMg")) +
geom_line(aes(y = CMg, color = "CMg (creciente)")) +
geom_ribbon(data = dwl4_df, aes(ymin = CMg, ymax = D), fill = "gray40", alpha = 0.6) +
geom_vline(xintercept = c(Q4_star, Q4_cp), linetype = "dashed", color = "gray50") +
labs(y = "P", color = "", title = "Ejercicio 4: monopolio con CMg creciente") +
theme_minimal()
Docente: MSc. Jeel Cueva · Curso: Regulación Económica · Facultad de Economía — UNHEVAL