Microconomics - Problem Set #2, Question 3.

Load the libraries

library(readxl)

Load, cleanup and preview the data

# Read the excel file
data <- read_excel("Problem Set 2 Data.xlsx")

New names:
• `` -> `...1`

# Remove the last observation
cleaned_data <- data[-50,]

# Check the first few rows
head(cleaned_data)

Run multiple regression using the relevant columns as X

model <- lm(as.vector(cleaned_data[[2]]) ~ as.vector(cleaned_data[[3]]) + as.vector(cleaned_data[[4]]) + as.vector(cleaned_data[[5]]) + as.vector(cleaned_data[[6]]) + as.vector(cleaned_data[[7]]) + as.vector(cleaned_data[[8]]))
summary(model)

Call:
lm(formula = as.vector(cleaned_data[[2]]) ~ as.vector(cleaned_data[[3]]) + 
    as.vector(cleaned_data[[4]]) + as.vector(cleaned_data[[5]]) + 
    as.vector(cleaned_data[[6]]) + as.vector(cleaned_data[[7]]) + 
    as.vector(cleaned_data[[8]]))

Residuals:
    Min      1Q  Median      3Q     Max 
-124141  -27689   -5628   22545  223153 

Coefficients:
                               Estimate Std. Error t value Pr(>|t|)    
(Intercept)                   6.468e+05  1.518e+05   4.261 0.000116 ***
as.vector(cleaned_data[[3]]) -1.274e+05  1.492e+04  -8.537 1.23e-10 ***
as.vector(cleaned_data[[4]])  5.351e+00  1.082e+00   4.946 1.33e-05 ***
as.vector(cleaned_data[[5]])  2.940e+04  1.241e+04   2.370 0.022567 *  
as.vector(cleaned_data[[6]])  3.243e-01  2.854e+00   0.114 0.910105    
as.vector(cleaned_data[[7]])  2.396e-02  2.351e-03  10.193 8.34e-13 ***
as.vector(cleaned_data[[8]])  4.396e+03  4.398e+03   0.999 0.323461    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 60700 on 41 degrees of freedom
  (1 observation deleted due to missingness)
Multiple R-squared:  0.896, Adjusted R-squared:  0.8808 
F-statistic: 58.86 on 6 and 41 DF,  p-value: < 2.2e-16

Visualize the data for clarity

# Get the coefficients from the model
coefficients <- coef(model)

# Add "Intercept" to the beginning of the column names
column_names <- c("Intercept", names(data)[3:8])

# Clean up column names by removing newline characters and extra whitespace
cleaned_names <- gsub("\\s+", " ", column_names)
names(coefficients) <- cleaned_names

# Create a data frame for the coefficients table, keeping the intercept
coefficients_table <- data.frame(
  Variable = names(coefficients),
  Coefficient = format(round(as.numeric(coefficients), 3), nsmall = 2, scientific = FALSE)
)

# Convert to a plain data frame
coefficients_table <- as.data.frame(coefficients_table)

# Display the table
coefficients_table

Understanding the coefficients

1. b - Intercept: Is high indicating a strong quantity demand independent of the influence of the dependent variables
2. P - Mrs. Smith’s Price: A high negative coefficient indicates that the quantity demand will drop significantly even with a small price increase
3. A - Advertising: A small positive coefficient indicates that there will be a small boost in quantity demanded with advertising spend
4. PX - Competitor Price: A big positive coefficient indicates that any increase in the price of the competitor will lead to a significant increase in quantity demanded for Mrs. Smith’s pies
5. Y - Disposable Income per Capita: A fractional positive coefficient indicates a very minor increase in quantity demanded with increase in disposable income per capital of consumers
6. Pop - Population: Similarly to the Income per Capita, a population increase doesn’t lead to a significant increase in demand of pies
7. T - Trend Factor: A high positive coefficient indicates that as the time goes by the demand for pies increased significantly and the demand will increase strongly with time

Predict for the given values

coefficients <- coef(model)
intercept <- coefficients[1]
coefficient_P <- coefficients[2]
coefficient_A <- coefficients[3]
coefficient_PX <- coefficients[4]
coefficient_Y <- coefficients[5]
coefficient_Pop <- coefficients[6]
coefficient_T <- coefficients[7]

baltimore_P <- 7.20
baltimore_A <- 30000
baltimore_PX <- 6.00
baltimore_Y <- 43000
baltimore_Pop <- cleaned_data[[48, 7]] # Same as quarter 2001-8
baltimore_T <- 9 # Quarter 1 of 2002, 8 + 1

baltimore_quantity_2002_T_1 <- intercept + coefficient_P * baltimore_P + coefficient_A * baltimore_A + coefficient_PX * baltimore_PX + coefficient_Y * baltimore_Y + coefficient_Pop * baltimore_Pop + coefficient_T * baltimore_T

# Printout the result
baltimore_quantity_2002_T_1

(Intercept) 
   306797.2 

Compute the price elasticity of demand

dQ_dP <- abs(coefficient_P)
Q1 <- baltimore_quantity_2002_T_1
P1 <- baltimore_P

price_elasticity_of_demand <- dQ_dP * (P1 / Q1)

print(sprintf("Q1, P1: (%0.2f, %0.2f)", Q1, P1))

[1] "Q1, P1: (306797.19, 7.20)"

print(sprintf("Ed: %0.3f", price_elasticity_of_demand))

[1] "Ed: 2.989"

Marginal revenue using price elasticity of demand and new price

marginal_revenue <- P1 * (1 - 1/abs(price_elasticity_of_demand))
marginal_revenue

as.vector(cleaned_data[[3]]) 
                    4.791069