# Generate the sequence from 1 to 10 with increments of 0.5
data <- seq(from = 1, to = 10, by = 0.5)
# Print each value in the sequence
print(data) [1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5 7.0 7.5 8.0
[16] 8.5 9.0 9.5 10.0# Create custom linear function
function_1 <- function(X, a, b) {
Y = a * X + b
return(Y)
}
# Call function_1 for the specified values X=5, b=10, a=3
result_1 <- function_1(5, 3, 10)
# Print the result
cat("Answer using R:",result_1,"\n")Answer using R: 25 cat("Answer using algebra:","\n", "Y = a * X + b ","\n", "Y = (3*5) + 10", "\n", "Y = 25" )Answer using algebra:
Y = a * X + b
Y = (3*5) + 10
Y = 25library(tidyverse)
# Create custom linear function
fun_1 <- function(X, a1, b1) {
Y = a1 * X + b1
return(Y)
}
# Set input values
X <- seq(1, 10, by = 1)
a1 <- 3
b1 <- 10
# Build dataframe
df <- data.frame(
a1 = rep(3, length.out = 10),
b1 = rep(10, length.out = 10),
X = X,
Y = sapply(X,fun_1,a1, b1)
)
# Print dataframe
#cat("New dataframe",df,"\n")#| warning: false
#| message: false
#| error: false
#| echo: true
#| eval: true
plot <- ggplot(df,aes(x=X, y=X)) +
geom_point()
plot
# Load library for fzero package
library(pracma)
# Define second function
fun_2 <- function(X, a2, b2) {
Y = a2 * X + b2
return(Y)
}
# Define third function
fun_3 <- function(X, a3, b3) {
Y = a3 * X + b3
return(Y)
}
# Create a function equal to the difference between fun_2 and fun_3
fun_diff <- function(X,a2, b2, a3, b3) {
z = fun_2(X, a2, b2) - fun_3(X, a3, b3)
return(z)
}
# Use fzero function with fun_diff to find where the difference between fun_2 and fun_3 is zero
intersection_x <- fzero(fun_diff, c(-100, 100), a2 = -2, b2 = 100, a3 = 3, b3 = 0)$x
intersection_y <- fun_2(intersection_x, -2, 100)
# Print the result
cat("Using R: Intersection at (",intersection_x,",",intersection_y,")", "\n")Using R: Intersection at ( 20 , 60 ) #cat("Y-value at intersection",intersection_y,"\n")
# Use fzero function with fun_diff to find where the difference between fun_2 and fun_3 is zerocat("Set the two curves equal to one another:","\n", "\n", "a2 * X + b2 = a3 * X + b3", "\n", "\n") Set the two curves equal to one another:
a2 * X + b2 = a3 * X + b3
cat("Plug in constants:", "\n", "-2 * X + 100 = 3 * X + 0", "\n", "\n")Plug in constants:
-2 * X + 100 = 3 * X + 0
cat("Simplify and rearrage to solve for X:", "\n", "\n", "100 = 3*X + 2*X", "\n", "100 = 5*X", "\n", "X = 20", "\n", "\n")Simplify and rearrage to solve for X:
100 = 3*X + 2*X
100 = 5*X
X = 20
cat("Input X intersection point into one of the two curves to solve for Y intersection point:", "\n", "\n", "Y = 3 * X + 0", "\n", "Y = 3 * 20 + 0", "\n", "Y = 60", "\n", "\n")Input X intersection point into one of the two curves to solve for Y intersection point:
Y = 3 * X + 0
Y = 3 * 20 + 0
Y = 60
cat("Using algebra: Intersection at ( 20, 60 )")Using algebra: Intersection at ( 20, 60 )#| warning: false
#| message: false
#| error: false
#| echo: true
#| eval: true
# Load library for fzero package
library(pracma)
peanut_d <- function(q) {
p = 500 - .1*q
return(p)
}
peanut_s <- function(q) {
p = 5 + .05*q
return(p)
}
#Difference between supply and demand
peanut_diff <- function(q) {
z = peanut_s(q) - peanut_d(q)
return(z)
}
# Evaluate peanut_diff at the interval endpoints
#print(peanut_diff(-5000)) # Value at q = -100
#print(peanut_diff(5000)) # Value at q = 100
q_star <- fzero(peanut_diff, c(-5000, 5000))$x
p_star <- peanut_s(q_star)
# Print the result
cat("Q*:",q_star,"\n")Q*: 3300 cat("P*:",p_star,"\n")P*: 170 # Calculate consumer surplus when q_star = 3300 and p_star = 170
peanut_cs <- integral(peanut_d, xmin=0, xmax=3300) - 3300*170
cat("Consumer Benefit:", peanut_cs, "\n")Consumer Benefit: 544500 # Calculate consumer surplus when q_star = 3300 and p_star = 170
peanut_ps <- 3300*170 - integral(peanut_s, xmin=0, xmax=3300)
cat("Producer Benefit:", peanut_ps, "\n")Producer Benefit: 272250 # Load ggplot2 for plotting
library(ggplot2)
peanut_d_1 <- function(q) {
p = 500 - .1*q
return(p)
}
peanut_d_2 <- function(q) {
p = 400 - 2*q
return(p)
}
# Aggregate the demand curves by adding them
agg_peanut_d <- function(q) {
p = 500 - .1*q + 400 - 2*q
return(p)
}
# Define the supply curve
peanut_s <- function(q) {
p = 5 + .05*q
return(p)
}
# Calculate the difference between supply and demand
agg_peanut_diff <- function(q) {
z = peanut_s(q) - agg_peanut_d(q)
return(z)
}
# Evaluate peanut_diff at the interval endpoints
#print(agg_peanut_diff(-5000)) # Value at q = -100
#print(agg_peanut_diff(5000)) # Value at q = 100
# Calculate aggregate q-star
agg_q_star <- fzero(agg_peanut_diff, c(-5000, 5000))$x
# Calculate aggregate p-star
agg_p_star <- peanut_s(agg_q_star)
# Print the result
cat("Aggregate demand Q*:",agg_q_star,"\n")Aggregate demand Q*: 416.2791 cat("Aggregate demand P*:",agg_p_star,"\n")Aggregate demand P*: 25.81395 # Create a sequence of q values to evaluate and plot
q_values <- seq(0, 600, by = 10)
# Calculate prices for each demand and supply curve based on q-value sequence
c_1_values <- sapply(q_values, peanut_d_1)
c_2_values <- sapply(q_values, peanut_d_2)
agg_c_values <- sapply(q_values, agg_peanut_d)
s_values <- sapply(q_values, peanut_s)
# Create a dataframe for plotting
plot_data <- data.frame(
Quantity = c(q_values, q_values, q_values, q_values),
Price = c(c_1_values, c_2_values, agg_c_values, s_values),
Type = rep(c("Consumer 1 Demand", "Consumer 2 Demand", "Aggregate Demand", "Supply"), each = length(q_values))
)
# Plot the data for each curve as a line
ggplot(plot_data, aes(x = Quantity, y = Price, color = Type)) +
geom_line(linewidth = 1) +
geom_point(aes(x = agg_q_star, y = agg_p_star), color = "red", size = 3) +
scale_y_continuous(limits = c(-10, 600)) +
annotate("text", x = agg_q_star +70, y = agg_p_star + 80,
label = paste0("Q* = ", round(agg_q_star, 2), "\nP* = ", round(agg_p_star, 2)),
color = "red", size = 4, hjust = 0.5) +
labs(
title = "Aggregate Demand and Supply Curve",
x = "Quantity",
y = "Price"
) +
theme_minimal() +
theme(legend.title = element_blank())Warning in geom_point(aes(x = agg_q_star, y = agg_p_star), color = "red", : All aesthetics have length 1, but the data has 244 rows.
ℹ Please consider using `annotate()` or provide this layer with data containing
a single row.Warning: Removed 72 rows containing missing values or values outside the scale range
(`geom_line()`).
Externalities are always important to consider and attempt to account in the market. In the case of the food bank market for peanut butter, given that the market supports public health and food security, the known externality should not be addressed through intervention market. It should be addressed through other governmental measures or interventions that don’t impact the amount peanut butter that is traded for or the amount traded all together. Doing so would reduce the impact or effectiveness of the food banks on improving public health and food security.
library(pracma)
# Solve for Q when P = $2000
old_cars_s <- function(q) {
p = 200 + 0.2 * q^1.2
return(p)
}
# Instead of algebraically rearranging equation to solve for q, use fzero function to find q when the difference between the supply curve price and p=$2000 is zero
old_cars_diff <- function(q) {
old_cars_s(q) - 2000
}
# Use fzero (or uniroot) to find Q
cars <- fzero(old_cars_diff, c(0, 10000))$x
# Round to the nearest integer
cars_rounded <- round(cars)
# Print result
cat("The number of cars sold back to the state is:", cars_rounded, "\n")The number of cars sold back to the state is: 1973 # Take derivative of supply curve and multiply by (P/Q) or 2000/1973
old_cars_s <- function(q) {
p = 200 + 0.2 * q^1.2
return(p)
}
# Compute the derivative at x = 100
der_old_cars_s <- grad(old_cars_s, x = 1973)
cat("The derivative of supply curve when x = 1973:", der_old_cars_s, "\n")The derivative of supply curve when x = 1973: 1.094553 elasticity <- abs(der_old_cars_s*(2000/1973))
#elasticity_rounded <- round(elasticity)
# Print the result
cat("The elasticity at the market equilibrium:", elasticity, "\n")The elasticity at the market equilibrium: 1.109531 # Calculate producer surplus when q_star = 1973 and p_star = 2000
car_ps <- 1973*2000 - integral(old_cars_s, xmin=0, xmax=1973)
cat("Total benefit to old-car owners: $", car_ps, "\n")Total benefit to old-car owners: $ 1937462 # Calculate consumer surplus when q_star = 3300 and p_star = 170
car_taxpayer_cost <- 1973*2000
cat("Total cost to taxpayers: $", car_taxpayer_cost, "\n")Total cost to taxpayers: $ 3946000