bargaining_data <- read.csv("selected_bargaining_data.csv")
#Outliers Function
exclude_outliers <- function(x, threshold = 3) {
z_scores <- abs(scale(x))
x[z_scores > threshold] <- NA
x
}
# Property Age
property_age_summary <- bargaining_data %>%
group_by(event_id) %>%
summarize(
property_age = ifelse(all(is.na(year_built)), NA, 2024 - max(year_built, na.rm = TRUE))
) %>%
filter(!is.na(property_age)) %>%
summarize(
Mean = mean(property_age, na.rm = TRUE),
Std.Dev. = sd(property_age, na.rm = TRUE),
Min = min(property_age, na.rm = TRUE),
Median = median(property_age, na.rm = TRUE),
Max = max(property_age, na.rm = TRUE)
)
# Number of Buyers
number_of_buyers_summary <- bargaining_data %>%
group_by(event_id) %>%
summarize(number_of_buyers = sum(!is.na(buyer_id))) %>%
mutate(number_of_buyers = exclude_outliers(number_of_buyers)) %>%
summarize(
Mean = mean(number_of_buyers, na.rm = TRUE),
Std.Dev. = sd(number_of_buyers, na.rm = TRUE),
Min = min(number_of_buyers, na.rm = TRUE),
Median = median(number_of_buyers, na.rm = TRUE),
Max = max(number_of_buyers, na.rm = TRUE)
)
# Number of Revisions
number_of_revisions_summary <- bargaining_data %>%
group_by(event_id) %>%
summarize(
number_of_revisions = sum(action == "seller_revise" | is.na(action), na.rm = TRUE)
) %>%
mutate(
number_of_revisions = exclude_outliers(number_of_revisions)
) %>%
summarize(
Mean = mean(number_of_revisions, na.rm = TRUE),
Std.Dev. = sd(number_of_revisions, na.rm = TRUE),
Min = min(number_of_revisions, na.rm = TRUE),
Median = median(number_of_revisions, na.rm = TRUE),
Max = max(number_of_revisions, na.rm = TRUE)
)
# Duration Until Off-Market (Days)
bargaining_data <- bargaining_data %>%
mutate(
listing_date = ymd_hm(listing_date),
off_market_date = ymd(off_market_date)
)
duration_days <- bargaining_data %>%
group_by(event_id) %>%
summarize(duration_days = as.numeric(
difftime(max(off_market_date, na.rm = TRUE), min(listing_date, na.rm = TRUE), units = "days"))) %>%
filter(duration_days >= 0)
duration_days_summary <- duration_days %>%
mutate(duration_days = exclude_outliers(duration_days)) %>%
summarize(
Mean = mean(duration_days, na.rm = TRUE),
Std.Dev. = sd(duration_days, na.rm = TRUE),
Min = min(duration_days, na.rm = TRUE),
Median = median(duration_days, na.rm = TRUE),
Max = max(duration_days, na.rm = TRUE)
)
# Sales Price
de_sales_price <- bargaining_data %>%
distinct(de_sales_price, event_id) %>%
mutate(de_sales_price = exclude_outliers(de_sales_price))
sales_price_summary <- bargaining_data %>%
summarize(
Mean = mean(de_sales_price, na.rm = TRUE),
Std.Dev. = sd(de_sales_price, na.rm = TRUE),
Min = min(de_sales_price, na.rm = TRUE),
Median = median(de_sales_price, na.rm = TRUE),
Max = max(de_sales_price, na.rm = TRUE)
)
#Make Summary Table
summary_combined <- bind_rows(
property_age_summary %>%
mutate(Variable = "Property Age"),
number_of_buyers_summary %>%
mutate(Variable = "Buyer Represented by the Platform"),
number_of_revisions_summary %>%
mutate(Variable = "Revisions"),
duration_days_summary %>%
mutate(Variable = "Duration Until Off-Market (Days)"),
sales_price_summary %>%
mutate(Variable = "Sales Price")
)
summary_combined <- summary_combined %>%
select(Variable, Mean, Std.Dev., Min, Median, Max) %>%
mutate(across(where(is.numeric), ~round(., 0))) %>%
mutate(across(where(is.numeric), ~format(., scientific = FALSE)))
print(summary_combined)
## # A tibble: 5 × 6
## Variable Mean Std.Dev. Min Median Max
## <chr> <chr> <chr> <chr> <chr> <chr>
## 1 Property Age " 47" " 32" " 5" " 38" " 16…
## 2 Buyer Represented by the Platform " 3" " 1" " 2" " 2" " …
## 3 Revisions " 1" " 1" " 0" " 0" " …
## 4 Duration Until Off-Market (Days) " 42" " 50" " 1" " 21" " 23…
## 5 Sales Price "469988" "249385" "104335" "411423" "156179…
state_name <- read.csv("cbsa2fipsxw.csv")
bargaining_data <- bargaining_data %>%
mutate(state_fips = ifelse(nchar(censustract) == 11,
substr(censustract, 1, 2),
substr(censustract, 1, 1)))
state_names <- state_name %>%
mutate(fipsstatecode = as.character(fipsstatecode))
bargaining_data <- left_join(bargaining_data, state_names, by = c("state_fips" = "fipsstatecode"))
## Warning in left_join(bargaining_data, state_names, by = c(state_fips = "fipsstatecode")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 365 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.
library(ggplot2)
library(plotly)
## Warning: 程辑包'plotly'是用R版本4.3.3 来建造的
##
## 载入程辑包：'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
us_states <- map_data("state")
#Number of Properties in Each State & Legend Showing Distribution of Counts
property_count <- bargaining_data %>%
group_by(statename) %>%
summarize(property_count = n_distinct(property_id))
bargaining_data <- left_join(bargaining_data, property_count, by = "statename")
property_count
## # A tibble: 28 × 2
## statename property_count
## <chr> <int>
## 1 Arizona 7
## 2 Arkansas 1
## 3 California 51
## 4 Colorado 5
## 5 District of Columbia 6
## 6 Florida 5
## 7 Georgia 2
## 8 Illinois 12
## 9 Maryland 11
## 10 Massachusetts 16
## # ℹ 18 more rows
#gglot
p1 <- ggplot(us_states)+
geom_polygon(aes(x=long, y=lat, group = group), fill="white", color ="black")+
geom_point(data=bargaining_data,
aes(x=property_longitude, y=property_latitude, color=property_count, size=property_count), na.rm=T)+
scale_color_gradient(low = "green", high="darkblue")+
scale_size_continuous(range=c(1,4))+
coord_fixed(1.2)+
theme_void() +
ggtitle("Number of Properties in Each State & Distribution of Counts")
ggplotly(p1)
property_age <- bargaining_data %>%
group_by(event_id) %>%
summarize(
property_age = ifelse(all(is.na(year_built)), NA, 2024 - max(year_built, na.rm = TRUE))
) %>%
distinct()
bargaining_data <- bargaining_data %>%
left_join(property_age, by = "event_id")
#exclude outliers
bargaining_data_1 <- bargaining_data %>%
mutate(de_sales_price = exclude_outliers(de_sales_price))
bargaining_data_1 <- bargaining_data %>%
filter(!is.na(de_sales_price) & !is.na(property_age)) %>%
mutate(de_sales_price = log(de_sales_price)) %>%
select(event_id, property_age, de_sales_price)
# univariate regression
library(readxl)
lm_property_age = lm(de_sales_price~property_age, data = bargaining_data_1)
plot(bargaining_data_1$property_age, bargaining_data_1$de_sales_price, pch = 16, col = "blue", xlab = "Property Age", ylab = "Sales Price")
abline(lm_property_age)
summary(lm_property_age)
##
## Call:
## lm(formula = de_sales_price ~ property_age, data = bargaining_data_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.28317 -0.31453 0.02626 0.23440 1.40076
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.278e+01 5.575e-03 2292.47 <2e-16 ***
## property_age 1.298e-03 1.141e-04 11.37 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4767 on 20778 degrees of freedom
## Multiple R-squared: 0.006185, Adjusted R-squared: 0.006138
## F-statistic: 129.3 on 1 and 20778 DF, p-value: < 2.2e-16
r_squared <- summary(lm_property_age)$r.squared
library(dplyr)
# Assume bargaining_data, duration_days, and de_sales_price are available
original_listing <- bargaining_data %>%
distinct(event_id, de_original_list_price) %>%
select(event_id, de_original_list_price)
duration_price <- merge(duration_days, original_listing, by = "event_id", all.x = TRUE)
duration_price <- duration_price %>%
mutate(log_de_original_list_price = log(de_original_list_price))
# Check correlation between duration and original listing price
lm_listing_duration <- lm(duration_days ~ log_de_original_list_price, data = duration_price)
summary(lm_listing_duration)
##
## Call:
## lm(formula = duration_days ~ log_de_original_list_price, data = duration_price)
##
## Residuals:
## Min 1Q Median 3Q Max
## -57.21 -41.63 -29.37 18.27 338.32
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -148.970 124.151 -1.200 0.232
## log_de_original_list_price 15.249 9.564 1.594 0.112
##
## Residual standard error: 66.52 on 197 degrees of freedom
## Multiple R-squared: 0.01274, Adjusted R-squared: 0.007728
## F-statistic: 2.542 on 1 and 197 DF, p-value: 0.1124
# Plot duration vs. original listing price
plot(duration_price$log_de_original_list_price, duration_price$duration_days,
pch = 16, col = "blue", xlab = "Log Original Price", ylab = "Duration in the Market",
main = "Duration vs. Original Listing Price")
abline(lm_listing_duration, col = "red")
listing_sales <- merge(de_sales_price, original_listing, by = "event_id", all.x = TRUE)
listing_sales <- listing_sales %>%
mutate(log_de_sales_price = log(de_sales_price),
log_de_original_list_price = log(de_original_list_price))
# Check correlation between sales price and original listing price
lm_listing_sales <- lm(log_de_sales_price ~ log_de_original_list_price, data = listing_sales)
summary(lm_listing_sales)
##
## Call:
## lm(formula = log_de_sales_price ~ log_de_original_list_price,
## data = listing_sales)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.23647 -0.03985 -0.00427 0.02771 0.22068
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.29803 0.15193 -1.962 0.0514 .
## log_de_original_list_price 1.02252 0.01173 87.150 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.07048 on 171 degrees of freedom
## (因为不存在，27个观察量被删除了)
## Multiple R-squared: 0.978, Adjusted R-squared: 0.9779
## F-statistic: 7595 on 1 and 171 DF, p-value: < 2.2e-16
# Plot sales price vs. original listing price
plot(listing_sales$log_de_original_list_price, listing_sales$log_de_sales_price,
pch = 16, col = "blue", xlab = "Log Original Price", ylab = "Log Sales Price",
main = "Sales Price vs. Original Listing Price")
abline(lm_listing_sales, col = "red")
all_data <- merge(listing_sales, duration_price, by = "event_id", all.x = TRUE)
all_data <- all_data %>%
mutate(log_duration_days = log(duration_days))
# Multivariate regression model
lm_full_model <- lm(log_de_sales_price ~ log_de_original_list_price.x + log_duration_days, data = all_data)
summary(lm_full_model)
##
## Call:
## lm(formula = log_de_sales_price ~ log_de_original_list_price.x +
## log_duration_days, data = all_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.138840 -0.032394 -0.008055 0.024956 0.184768
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.262560 0.118817 -2.21 0.0285 *
## log_de_original_list_price.x 1.026980 0.009182 111.85 <2e-16 ***
## log_duration_days -0.032691 0.003119 -10.48 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.05509 on 170 degrees of freedom
## (因为不存在，27个观察量被删除了)
## Multiple R-squared: 0.9866, Adjusted R-squared: 0.9865
## F-statistic: 6269 on 2 and 170 DF, p-value: < 2.2e-16
# Plot the relationships side-by-side
par(mfrow = c(1, 2))
# Plot 1: Sales price vs. original listing price
plot(all_data$log_de_original_list_price.x, all_data$log_de_sales_price,
pch = 16, col = "blue", xlab = "Original Price", ylab = "Sales Price",
main = "Sales Price vs. Original Listing Price")
abline(lm(log_de_sales_price ~ log_de_original_list_price.x, data = all_data), col = "red")
# Plot 2: Sales price vs. duration in the market
plot(all_data$log_duration_days, all_data$log_de_sales_price,
pch = 17, col = "green", xlab = "Duration in the Market", ylab = "Sales Price",
main = "Sales Price vs. Duration in the Market")
abline(lm(log_de_sales_price ~ log_duration_days, data = all_data), col = "red")
#combine
par(mfrow = c(1, 1))