#| standalone: true
#| viewerHeight: 660
library(shiny)
ui <- fluidPage(
titlePanel("Cobb-Douglas Consumer"),
sidebarLayout(
sidebarPanel(
width = 4,
sliderInput("a", "Cobb-Douglas exponent a:",
min = 0.5, max = 4, value = 1, step = 0.25),
sliderInput("b", "Cobb-Douglas exponent b:",
min = 0.5, max = 4, value = 1, step = 0.25),
sliderInput("m", "Income (m):", min = 20, max = 200, value = 100, step = 10),
sliderInput("p1", "Price of good 1 (p₁):", min = 1, max = 20, value = 5, step = 1),
sliderInput("p2", "Price of good 2 (p₂):", min = 1, max = 20, value = 5, step = 1),
hr(),
checkboxInput("show_other_ics",
"Show a ladder of indifference curves",
value = TRUE),
htmlOutput("readout")
),
mainPanel(
width = 8,
plotOutput("choice_plot", height = "520px")
)
)
)
server <- function(input, output, session) {
bundle <- reactive({
a <- input$a; b <- input$b
m <- input$m; p1 <- input$p1; p2 <- input$p2
x1 <- a * m / ((a + b) * p1)
x2 <- b * m / ((a + b) * p2)
u_opt <- x1^a * x2^b
list(a = a, b = b, m = m, p1 = p1, p2 = p2,
x1 = x1, x2 = x2, u_opt = u_opt)
})
output$choice_plot <- renderPlot({
s <- bundle()
x1_int <- s$m / s$p1
x2_int <- s$m / s$p2
xmax <- max(40, x1_int) * 1.05
ymax <- max(40, x2_int) * 1.05
par(mar = c(4.2, 4.5, 1, 1))
plot(NA, xlim = c(0, xmax), ylim = c(0, ymax),
xlab = expression(x[1]), ylab = expression(x[2]), main = "")
# Indifference curves: x_1^a x_2^b = U => x_2 = (U / x_1^a)^(1/b)
ic_x <- seq(0.1, xmax * 1.5, length.out = 600)
ic_y_opt <- (s$u_opt / ic_x^s$a)^(1 / s$b)
if (isTRUE(input$show_other_ics)) {
for (frac in c(0.5, 0.75, 1.25)) {
u <- s$u_opt * frac
y <- (u / ic_x^s$a)^(1 / s$b)
lines(ic_x, y, col = adjustcolor("#7f8c8d", 0.5), lwd = 1.2, lty = 3)
}
}
lines(ic_x, ic_y_opt, col = "#27ae60", lwd = 2.4)
polygon(c(0, x1_int, 0), c(0, 0, x2_int),
col = adjustcolor("#3498db", 0.12), border = NA)
segments(0, x2_int, x1_int, 0, col = "#185FA5", lwd = 3)
points(s$x1, s$x2, pch = 19, col = "#c0392b", cex = 1.8)
text(s$x1, s$x2, sprintf(" (%.1f, %.1f)", s$x1, s$x2),
pos = 4, col = "#c0392b", cex = 1.0)
legend("topright",
legend = c("Budget line", "Indifference curve through optimum",
if (isTRUE(input$show_other_ics)) "Other indifference curves" else NULL,
"Optimal bundle (x₁*, x₂*)"),
col = c("#185FA5", "#27ae60",
if (isTRUE(input$show_other_ics)) "#7f8c8d" else NULL,
"#c0392b"),
lwd = c(3, 2.4, if (isTRUE(input$show_other_ics)) 1.2 else NULL, NA),
lty = c(1, 1, if (isTRUE(input$show_other_ics)) 3 else NULL, NA),
pch = c(NA, NA, if (isTRUE(input$show_other_ics)) NA else NULL, 19),
bty = "n", cex = 0.9)
})
output$readout <- renderUI({
s <- bundle()
share1 <- s$a / (s$a + s$b)
share2 <- s$b / (s$a + s$b)
HTML(sprintf(paste(
"<div style='margin-top:10px;font-size:13px;line-height:1.7;'>",
"<b>Ordinary demand:</b> x₁* = %.2f, x₂* = %.2f<br>",
"<b>Spending on good 1:</b> p₁·x₁* = %.1f (%.0f%% of income)<br>",
"<b>Spending on good 2:</b> p₂·x₂* = %.1f (%.0f%% of income)<br>",
"<b>MRS at optimum:</b> %.2f <b>p₁/p₂:</b> %.2f<br>",
"<b>Utility achieved:</b> %.2f",
"</div>"
),
s$x1, s$x2,
s$p1 * s$x1, 100 * share1,
s$p2 * s$x2, 100 * share2,
(s$a / s$b) * (s$x2 / s$x1),
s$p1 / s$p2, s$u_opt))
})
}
shinyApp(ui, server)