suppressPackageStartupMessages({
library(ggplot2)
library(latex2exp)
library(patchwork)
})
# Parâmetros comuns
px <- 1; py <- 4; I_renda <- 8
x_seq <- seq(0.01, 9, length.out = 500)
# Cores consistentes para os 3 casos
cor1 <- "dodgerblue" # sigma = 2
cor2 <- "firebrick" # sigma = 0.5
cor3 <- "forestgreen" # sigma = 0 (Leontief)
# Restrição orçamentária
bl_x0 <- 0; bl_y0 <- I_renda / py
bl_x1 <- I_renda / px; bl_y1 <- 0
tema <- theme_minimal(base_size = 12) +
theme(
axis.line = element_line(color = "black", linewidth = 0.8),
panel.grid = element_blank(),
axis.title = element_text(size = 11),
plot.title = element_text(size = 12)
)
# Função auxiliar: gráfico de demanda (x* horizontal, preço vertical)
graf_demanda <- function(dem_fun, cor, titulo, eixo_q, eixo_p, q_ref, p_ref,
label_eq = NULL) {
p <- ggplot() +
geom_function(
fun = dem_fun, xlim = c(0.3, 8), n = 300,
color = cor, linewidth = 1
) +
geom_point(aes(x = q_ref, y = p_ref), size = 3, color = "red") +
geom_segment(
aes(x = q_ref, y = 0, xend = q_ref, yend = p_ref),
linetype = "dashed", color = "gray40"
) +
geom_segment(
aes(x = 0, y = p_ref, xend = q_ref, yend = p_ref),
linetype = "dashed", color = "gray40"
) +
annotate("label", x = q_ref + 0.8, y = p_ref + 1,
label = paste0("(", round(q_ref, 1), "; ", round(p_ref, 0), ")"),
size = 3.5, color = "red", fill = "white", label.size = 0.2) +
scale_x_continuous(expand = c(0, 0), limits = c(0, 9), breaks = seq(0, 8, 2)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 9), breaks = seq(0, 8, 2)) +
labs(x = eixo_q, y = eixo_p, title = titulo) +
tema
if (!is.null(label_eq)) {
p <- p + annotate("text", x = 4.5, y = 7.5, label = label_eq,
size = 5, color = cor, parse = TRUE)
}
p
}
# ============================================================
# LINHA 1: Caso 1 — U = x^0.5 + y^0.5 (sigma = 2)
# ============================================================
x1_star <- 6.4; y1_star <- 0.4
k_vals_a <- c(2.5, sqrt(x1_star) + sqrt(y1_star), 3.5)
df_ic_a <- do.call(rbind, lapply(seq_along(k_vals_a), function(i) {
k <- k_vals_a[i]
x <- x_seq[x_seq <= k^2]
y <- (k - sqrt(x))^2
data.frame(x = x, y = y, curva = factor(i))
}))
p1_u <- ggplot() +
geom_line(data = df_ic_a, aes(x = x, y = y, group = curva),
color = cor1, linewidth = 0.6) +
geom_segment(aes(x = bl_x0, y = bl_y0, xend = bl_x1, yend = bl_y1),
colour = "black", linewidth = 0.8) +
geom_point(aes(x = x1_star, y = y1_star), size = 3, colour = "red") +
geom_segment(aes(x = x1_star, y = y1_star, xend = x1_star, yend = 0),
linetype = "dashed", colour = "grey40") +
geom_segment(aes(x = x1_star, y = y1_star, xend = 0, yend = y1_star),
linetype = "dashed", colour = "grey40") +
annotate("label", x = x1_star - 0.5, y = y1_star + 0.7,
label = "(6,4; 0,4)", size = 4, fill = "white", label.size = 0.2) +
scale_x_continuous(limits = c(0, 9), expand = c(0, 0)) +
scale_y_continuous(limits = c(0, 5), expand = c(0, 0)) +
labs(x = TeX(r"($x$)"), y = TeX(r"($y$)"),
title = TeX(r"($U = x^{0.5} + y^{0.5}$ ($\sigma = 2$))")) +
tema
# Demanda de x: x*(px) = I / (px * (1 + px/py)), py = 4 fixo
# Demanda inversa: para plotar px no eixo y, dado x no eixo x
dem_x1 <- function(x) I_renda / (x * (1 + x * py / I_renda))
# Mais simples: usar a demanda inversa numericamente
dem_x1_inv <- function(q) {
# x* = I / (px * (1 + px/py)) => resolver para px dado q
# Usar a função direta para plotar: px -> x*(px)
sapply(q, function(qi) {
tryCatch(uniroot(function(p) I_renda / (p * (1 + p / py)) - qi,
c(0.01, 100))$root, error = function(e) NA)
})
}
# Alternativa direta: plotar px vs x*(px)
dem_x1_dir <- function(px) I_renda / (px * (1 + px / py))
p1_dx <- graf_demanda(
\(q) sapply(q, function(qi)
tryCatch(uniroot(\(p) I_renda / (p * (1 + p / py)) - qi,
c(0.001, 200))$root, error = \(e) NA)),
cor1, "Demanda de x",
TeX(r"($x^*$)"), TeX(r"($p_x$)"), x1_star, px,
"italic(x)^'*' == frac(I, p[x]*(1 + p[x]/p[y]))")
# Demanda de y: y*(py) = I / (py * (1 + py/px)), px = 1 fixo
p1_dy <- graf_demanda(
\(q) sapply(q, function(qi)
tryCatch(uniroot(\(p) I_renda / (p * (1 + p / px)) - qi,
c(0.001, 200))$root, error = \(e) NA)),
cor1, "Demanda de y",
TeX(r"($y^*$)"), TeX(r"($p_y$)"), y1_star, py,
"italic(y)^'*' == frac(I, p[y]*(1 + p[y]/p[x]))")
# ============================================================
# LINHA 2: Caso 2 — U = -x^{-1} - y^{-1} (sigma = 0.5)
# ============================================================
x2_star <- 8 / 3; y2_star <- 4 / 3
k_opt_b <- -1 / x2_star - 1 / y2_star
k_vals_b <- c(k_opt_b - 0.3, k_opt_b, k_opt_b + 0.2)
df_ic_b <- do.call(rbind, lapply(seq_along(k_vals_b), function(i) {
k <- k_vals_b[i]
x <- x_seq; denom <- k + 1 / x; y <- -1 / denom
valid <- y > 0 & y < 5
data.frame(x = x[valid], y = y[valid], curva = factor(i))
}))
p2_u <- ggplot() +
geom_line(data = df_ic_b, aes(x = x, y = y, group = curva),
color = cor2, linewidth = 0.6) +
geom_segment(aes(x = bl_x0, y = bl_y0, xend = bl_x1, yend = bl_y1),
colour = "black", linewidth = 0.8) +
geom_point(aes(x = x2_star, y = y2_star), size = 3, colour = "red") +
geom_segment(aes(x = x2_star, y = y2_star, xend = x2_star, yend = 0),
linetype = "dashed", colour = "grey40") +
geom_segment(aes(x = x2_star, y = y2_star, xend = 0, yend = y2_star),
linetype = "dashed", colour = "grey40") +
annotate("label", x = x2_star + 1.2, y = y2_star + 0.7,
label = "(2,67; 1,33)", size = 4, fill = "white", label.size = 0.2) +
scale_x_continuous(limits = c(0, 9), expand = c(0, 0)) +
scale_y_continuous(limits = c(0, 5), expand = c(0, 0)) +
labs(x = TeX(r"($x$)"), y = TeX(r"($y$)"),
title = TeX(r"($U = -x^{-1} - y^{-1}$ ($\sigma = 0{,}5$))")) +
tema
# Demanda de x: x*(px) = I / (px * (1 + (py/px)^0.5))
p2_dx <- graf_demanda(
\(q) sapply(q, function(qi)
tryCatch(uniroot(\(p) I_renda / (p * (1 + (py / p)^0.5)) - qi,
c(0.001, 200))$root, error = \(e) NA)),
cor2, "Demanda de x",
TeX(r"($x^*$)"), TeX(r"($p_x$)"), x2_star, px,
"italic(x)^'*' == frac(I, p[x]*(1 + (p[y]/p[x])^0.5))")
# Demanda de y: y*(py) = I / (py * (1 + (px/py)^0.5))
p2_dy <- graf_demanda(
\(q) sapply(q, function(qi)
tryCatch(uniroot(\(p) I_renda / (p * (1 + (px / p)^0.5)) - qi,
c(0.001, 200))$root, error = \(e) NA)),
cor2, "Demanda de y",
TeX(r"($y^*$)"), TeX(r"($p_y$)"), y2_star, py,
"italic(y)^'*' == frac(I, p[y]*(1 + (p[x]/p[y])^0.5))")
# ============================================================
# LINHA 3: Caso 3 — U = min(x, 4y) (sigma = 0, Leontief)
# ============================================================
x3_star <- 4; y3_star <- 1
k_vals_c <- c(2, 4, 6)
df_seg_c <- do.call(rbind, lapply(k_vals_c, function(k) {
rbind(
data.frame(x = k, y = k / 4, xend = 9, yend = k / 4, k = factor(k)),
data.frame(x = k, y = k / 4, xend = k, yend = 5, k = factor(k))
)
}))
p3_u <- ggplot() +
geom_segment(data = df_seg_c,
aes(x = x, y = y, xend = xend, yend = yend, group = k),
color = cor3, linewidth = 0.6) +
geom_segment(aes(x = bl_x0, y = bl_y0, xend = bl_x1, yend = bl_y1),
colour = "black", linewidth = 0.8) +
geom_point(aes(x = x3_star, y = y3_star), size = 3, colour = "red") +
geom_segment(aes(x = x3_star, y = y3_star, xend = x3_star, yend = 0),
linetype = "dashed", colour = "grey40") +
geom_segment(aes(x = x3_star, y = y3_star, xend = 0, yend = y3_star),
linetype = "dashed", colour = "grey40") +
annotate("label", x = x3_star + 1.2, y = y3_star + 0.7,
label = "(4; 1)", size = 4, fill = "white", label.size = 0.2) +
scale_x_continuous(limits = c(0, 9), expand = c(0, 0)) +
scale_y_continuous(limits = c(0, 5), expand = c(0, 0)) +
labs(x = TeX(r"($x$)"), y = TeX(r"($y$)"),
title = TeX(r"($U = \min(x, 4y)$ ($\sigma = 0$))")) +
tema
# Demanda de x: x*(px) = 4I / (4px + py)
p3_dx <- graf_demanda(
\(q) (4 * I_renda / q - py) / 4,
cor3, "Demanda de x",
TeX(r"($x^*$)"), TeX(r"($p_x$)"), x3_star, px,
"italic(x)^'*' == frac(4*I, 4*p[x] + p[y])")
# Demanda de y: y*(py) = I / (4px + py)
p3_dy <- graf_demanda(
\(q) I_renda / q - 4 * px,
cor3, "Demanda de y",
TeX(r"($y^*$)"), TeX(r"($p_y$)"), y3_star, py,
"italic(y)^'*' == frac(I, 4*p[x] + p[y])")
# Combinar: 3 linhas × 3 colunas
(p1_u | p1_dx | p1_dy) /
(p2_u | p2_dx | p2_dy) /
(p3_u | p3_dx | p3_dy)