---
title: "房屋价格数据探索"
format:
html:
toc: True
toc-location: right
code-fold: true
code-tools: true
editor_options:
chunk_output_type: inline
---
# 背景
该数据集是美国爱荷华州(艾奥瓦州)下辖的埃姆斯市的2006\~2010年房屋数据。该市位于美国中部地区,2018年人口数量约6.7万人,在美国属于小型城市,这个市有爱荷华州立大学和国家级实验室(艾姆斯实验室)
{width="462"}
{width="460"}
下面我们对这个数据集进行探索。
# 工具包及设置
```{r setup, include=FALSE}
options(warn=-1) # 忽略警告信息
knitr::opts_chunk$set(message=FALSE, warning=FALSE, echo =TRUE)
```
quarto-executable-code-5450563D
```r
library(skimr)
library(dplyr)
library(readxl)
library(tidyverse)
library(lubridate)
library(plotly)
library(gt)
library(writexl)
library(knitr)
library(kableExtra)
library(DT)
library(visdat)
library(corrplot)
library(forcats) # for fct_reorder
library(scales) # for dollar formatting
library(viridis) # for color palette
```
quarto-executable-code-5450563D
```r
# 通用函数
create_custom_datatable <- function(data) {
datatable(
data,
options = list(
scrollX = TRUE, # 启用水平滚动条(左右滑动)
autoWidth = FALSE # 禁用自动宽度计算
),
class = 'cell-border stripe'
)
}
to_table <- function(data) {
if (nrow(data) == 0 || ncol(data) == 0) {
return("数据框为空")
}
# 添加行索引作为第一列,并生成表格
data %>%
rowid_to_column("index") %>%
knitr::kable(
format = "html",
booktabs = TRUE,
escape = FALSE,
align = "c",
caption = paste0("数据框包含 ", nrow(data), " 行和 ", ncol(data), " 列")
) %>%
kable_styling(
full_width = FALSE,
font_size = 14,
fixed_thead = TRUE
) %>%
scroll_box(width = "100%", height = "400px")
}
del_dupli_all <- function(data) {
# 检查数据框是否存在以及是否包含指定列
if (!is.data.frame(data)) {
stop("输入必须是一个数据框")
}
# 基于特定列判断重复行
duplicate_indices <- which(duplicated(data) | duplicated(data, fromLast = TRUE))
# 删除所有包含重复值的行
df_clean <- data[-unique(duplicate_indices), ]
# # 返回清理后的数据框
# return(df_clean)
}
```
# 导入数据及说明
## 导入数据
quarto-executable-code-5450563D
```r
file_path <- "D:/R/house_price/ames_houseprice.csv"
ames <- read.csv(file_path) %>%
janitor::clean_names()
ames_copy <- read.csv(file_path)
names1 <- names(ames)
names2 <- names(ames_copy)
# 处理过列名和没处理过的映射关系的映射关系
cols_df <- data.frame(col = names1, col2 = names2)
# 导入字段的注释说明
explanation_path <- "D:/R/house_price/ames_houseprice_explanation.xlsx"
explanation <- read_excel(explanation_path)
# 匹配
cols_df <- cols_df %>%
left_join(explanation, by = c("col2" = "col_name")) %>%
select(col, explanation, class)
```
## 字段说明
quarto-executable-code-5450563D
```r
skim_result <- skim(ames) %>%
as.data.frame() %>%
mutate(
miss_rate = scales::percent(1 - complete_rate, accuracy = 0.1)
) %>%
select(skim_variable, skim_type, numeric.p0, numeric.p100, numeric.p50,n_missing, miss_rate) %>%
set_names(c("field", "type", "min", "max", "median", "n_miss", "miss_rate")) %>%
left_join(cols_df, c("field" = "col")) %>%
select(field, type, class, explanation, min, max, median, n_miss, miss_rate) %>%
arrange(desc(class))
to_table(skim_result)
```
字段分类说明
把字段分类更有助于理解数据
- 地理信息:房子的位置、占地面积信息
- 评估结果:评级等级等相关数据,从不同角度来评估房子的好坏
- 设计及装修:描述房子的外部、内部设计,软硬装修的程度和好坏
- 时间:房子时间相关的信息
- 房屋周边:房子附近的交通信息、公用设施、配套、道路信息
- 交易信息:房子的成交时间,交易价格等
- 建筑性质:建筑性质(农业、商业、高/低密度住宅)
# 数据探索
## 探索主题
探索影响房屋价格的因素
## 选择变量
作为购房者,确实会重点评估以下因素
- lot_area 占地面积
- gr_liv_area 地上居住面积
- neighborhood 建筑在Ames城市的位置
- lot_frontage 建筑离街道的距离
- bldg_type 住宅类别(联排别墅、独栋别墅...)
- ms_zoning 建筑性质(农业、商业、高/低密度住宅)
- year_built 房屋修建年份
quarto-executable-code-5450563D
```r
# 选择所需列
choice <- ames %>%
select(lot_area, gr_liv_area, neighborhood, lot_frontage, bldg_type, year_built, ms_zoning, sale_price)
to_table(choice)
```
## 异常值处理
### 缺失值
quarto-executable-code-5450563D
```r
# 选择字段的缺失值信息
values_to_match <- c("lot_area", "gr_liv_area", "neighborhood", "lot_frontage", "bldg_type", "year_built", "ms_zoning","sale_price")
filtered_rows <- skim_result %>%
filter(field %in% values_to_match)
to_table(filtered_rows)
```
lot_frontage:建筑离街道的距离 这列有259个缺失值。明细如下:
quarto-executable-code-5450563D
```r
choice %>%
filter(if_any(everything(), is.na)) %>%
to_table()
```
查看缺失值分布
quarto-executable-code-5450563D
```r
# 执行后查看 1.每个变量的数据类型(通过颜色区分)2. 缺失值的位置(如果有)3.变量之间的相对位置和排列。
choice %>% vis_dat()
```
quarto-executable-code-5450563D
```r
# 排除lot_frontage 列之后的数据情况
choice %>%
select(-lot_frontage) %>%
vis_dat()
```
共计1460个样本,确实259个,占比17.8%
缺失值有以下处理方式:
- 如果不重要的列,直接删除(此处不行)
- 填充缺失值。用中位数/平均值/固定值填充
- 删除含缺失值的行。此处删除后还有 1201个样本。暂时使用此处理方式。
更好的处理方式。还请各位老师指导。
quarto-executable-code-5450563D
```r
choice <- choice %>%
drop_na()
to_table(choice)
```
### 重复值
检查是否有重复值
quarto-executable-code-5450563D
```r
# 检查整个数据框是否有重复行
has_duplicates <- any(duplicated(choice))
has_duplicates
```
有重复值,从原始数据找出重复明细
quarto-executable-code-5450563D
```r
duplicate_rows <- choice %>%
group_by_all() %>% # 如果您只想检查某些列,请指定列名,例如:group_by(column1, column2)
filter(n() > 1) %>%
ungroup()
ames %>%
filter(
lot_area == 2522,
gr_liv_area == 1709
) %>%
select(id, yr_sold, mo_sold, sale_price) %>%
to_table()
```
发现这三行数据的差异在id,mo_sold(销售月份),sale_price(销售价格),不一样,其他信息均相同。不知道为什么。暂时做删除处理。
quarto-executable-code-5450563D
```r
df_clean <- del_dupli_all(choice) %>%
mutate(unit_price = sale_price/gr_liv_area) # 新增一列单价
```
## 开始探索
### 数值型变量分布
查看数值型变量整体分布有助于了解数据
备注:
- 1平方英尺 = 0.092903平方米 (m²)
- 1英尺 = 0.3048米,1码 = 3英尺 = 0.9144米
<!-- -->
- 人民币 2010年人民币和美元汇率在6.615到6.7695之间,取6.7
**从以下图中可以得出以下信息:**
1. lot_area(地块面积):大部分地块面积在5000平方英尺以下
2. gr_liv_area(地面以上居住面积)
- 大部分房屋的地面以上居住面积集中在1000到2000平方英尺之间。
- 有少数房屋的居住面积较大,超过3000平方英尺。
3. lot_frontage (和街道距离):大部分集中在100以内(单位是英尺还是码?待确认)
4. year_built(建造年份)
- 房屋建造年份分布广泛,从早期到现代都有。
- 有两个明显的峰值,一个在1960年代左右,另一个在2000年代左右。
5. sale_price(销售价格)
- 销售价格主要集中在较低的价格区间,大部分房屋的销售价格在200,000美元以下。
- 有少数房屋的销售价格较高,超过500,000美元。
6. unit_price(单价)
- 单位价格(每平方英尺的价格)主要集中在较低的价格区间,大部分房屋的单位价格在100美元/平方英尺(7212元/平方米)以下。
- 有少数房屋的单位价格较高,超过200美元/平方英尺(14424/平方米)。
概率密度函数
quarto-executable-code-5450563D
```r
library(purrr)
library(tidyr)
library(patchwork)
# 改进后的绘制函数,包含x轴标签处理
plot_density_all_numeric <- function(data) {
numeric_cols <- data %>% select_if(is.numeric)
data_long <- numeric_cols %>%
pivot_longer(everything(), names_to = "variable", values_to = "value")
unique_vars <- unique(data_long$variable)
map(unique_vars, ~ {
ggplot(data_long %>% filter(variable == .x), aes(x = value)) +
geom_density(fill = "blue", alpha = 0.5) +
labs(title = .x,
x = .x,
y = "Density") +
theme_minimal() +
# 根据需要选择一个或多个以下选项来调整x轴标签
theme(axis.text.x = element_text(angle = 45, hjust = 1)) + # 旋转x轴标签
scale_x_continuous(labels = scales::label_number()) # 或者简化数字标签
})
}
# 应用函数到数据框并获取图形列表
density_plots <- plot_density_all_numeric(df_clean)
# 使用 patchwork 将所有图形组合在一起
combined_plot <- Reduce(`+`, density_plots)
# 打印组合后的图形
print(combined_plot)
```
箱线图
quarto-executable-code-5450563D
```r
# 定义一个函数来绘制所有数值型变量的箱线图,并添加抖动点和异常值,使用facet_wrap分割图形
plot_boxplot_with_jitter_facet <- function(data) {
# 获取所有数值型列的名字,并转换成长格式
data_long <- data %>%
select_if(is.numeric) %>%
pivot_longer(everything(), names_to = "variable", values_to = "value")
# 创建箱线图并添加抖动点,使用facet_wrap分割图形
p <- ggplot(data_long, aes(x = "", y = value)) +
geom_boxplot(outlier.shape = 1, outlier.color = "red") + # 异常点用红色标记
geom_jitter(alpha = 0.6, color = "#ADD8E6", width = 0.2) + # 使用浅蓝色 (#ADD8E6),抖动点
facet_wrap(~ variable, scales = "free_y") + # 每个变量有自己的y轴尺度
labs(
# title = "数据分布图",
x = "",
y = "Value") +
theme_minimal() +
theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
scale_fill_brewer(palette = "Set3")
return(p)
}
# 应用函数到数据框并创建图形
faceted_plots <- plot_boxplot_with_jitter_facet(df_clean)
# 打印图形
print(faceted_plots)
```
### 各因素对房价的影响
#### 相关性分析
通过相关系数查看和各因素和房价的相关性,异常值可能会显著影响皮尔逊相关系数的结果,因此在分析前应考虑去除或处理异常值。
- 结论:连续性变量中,gr_liv_area(地上居住面积)和year_built (房屋修建年份)和房子售价相关性最高。分别为0.68,0.66
quarto-executable-code-5450563D
```r
# 定义一个函数来检测并剔除所有数值型列的异常值
remove_all_outliers_iqr_simplified <- function(data) {
# 获取所有数值型列的名字
numeric_cols <- select_if(data, is.numeric)
# 计算每列的上下限
bounds <- numeric_cols %>%
summarise(across(everything(), ~ {
qnt <- quantile(., probs = c(0.25, 0.75), na.rm = TRUE)
iqr <- IQR(., na.rm = TRUE)
list(lower = qnt[1] - 1.5 * iqr, upper = qnt[2] + 1.5 * iqr)
}))
# 创建一个布尔矩阵,标识哪些行和列符合 IQR 范围内的条件
within_bounds <- map2_df(numeric_cols, bounds, ~ between(.x, .y$lower, .y$upper))
# 确保所有数值型列都满足条件
valid_rows <- rowSums(within_bounds) == ncol(within_bounds)
filtered_data <- data %>%
filter(valid_rows)
return(filtered_data)
}
# 应用函数到数据框
df_no_outliers_simplified <- remove_all_outliers_iqr_simplified(df_clean)
# 查看结果
# to_table(df_no_outliers_simplified)
# 选择数值型变量
numeric_vars <- df_no_outliers_simplified %>%
select(lot_area, gr_liv_area, lot_frontage, year_built, sale_price)
# 计算相关矩阵,忽略缺失值
cor_matrix <- cor(numeric_vars, use = "complete.obs")
# 打印相关矩阵(可选)
# 使用 corrplot 包绘制相关矩阵的热力图,并显示相关系数
corrplot(
cor_matrix,
method = "color", # 使用颜色填充表示相关系数
type = "upper", # 只显示上三角部分的相关系数
tl.col = "black", # 设置标签颜色为黑色
tl.srt = 45, # 旋转标签45度以提高可读性
diag = FALSE, # 不显示对角线上的1.00
addCoef.col = "black", # 添加相关系数的颜色
number.cex = 0.8 # 调整相关系数文本大小
)
```
#### 综合评估
通过以下随机森林模型查看各因素对房价影响,重要性排序如下:
- neighborhood 建筑在Ames城市的位置
- gr_liv_area 地上居住面积
- year_built 房屋修建年份
- lot_area 占地面积
- lot_frontage 建筑离街道的距离
- ms_zoning 建筑性质(农业、商业、高/低密度住宅)
- bldg_type 住宅类别(联排别墅、独栋别墅...)
和我们购房的逻辑基本一致:面积,房子地段,年限
quarto-executable-code-5450563D
```r
library(randomForest)
df_clean <- df_clean %>%
mutate(
across(where(is.character) | where(is.factor), as.factor)
)
# 随机森林模型
rf_model <- randomForest(sale_price ~ lot_area + gr_liv_area + lot_frontage + year_built + ms_zoning + bldg_type + neighborhood, data = df_clean)
# importance(rf_model)
varImpPlot(rf_model)
```
### **各区域的房屋价格分析**
位置对房价影响第二,重点看一下。
#### 各位置房子数量、占比、房价中位数
共计25个区域,共1199套房子,NAmes、CollgCr、OldTown、Edwards、Somerst五个区域占了全市房子的49%。有可能是该市人口聚集区。
quarto-executable-code-5450563D
```r
# 假设 df_clean 是你的数据框,包含 sale_price 和 neighborhood 列
df_summary <- df_clean %>%
group_by(neighborhood) %>%
summarise(
cnt = n(),
median_sale_price = round(median(sale_price, na.rm = TRUE), 0),
mean_sale_price = round(mean(sale_price, na.rm = TRUE), 0),
.groups = 'drop'
) %>%
arrange(desc(cnt)) %>%
mutate(
pct = round(prop.table(cnt) * 100, 1),
cum_pct = round(cumsum(pct), 1) # 累计百分比列
)
# 打印结果
to_table(df_summary)
```
各区域房价房价中位数
quarto-executable-code-5450563D
```r
# 假设 df_summary 包含原始数据和 cnt 列
df_summary <- df_summary %>%
mutate(cnt_neg = -abs(cnt * 1500)) # 创建负数的房子数量列
# 创建左右堆叠条形图
ggplot(df_summary, aes(y = fct_reorder(neighborhood, median_sale_price))) +
# 左边: 房子数量 (用负数表示,所以它们朝左)
geom_col(aes(x = cnt_neg, fill = "房子数量"), width = 0.4, position = position_nudge(x = -0.2)) +
# 右边: 房价中位数
geom_col(aes(x = median_sale_price, fill = "房价中位数"),
data = df_summary %>% filter(!is.na(median_sale_price)), # 确保只使用有房价数据的行
width = 0.4, position = position_nudge(x = 0.2)) +
# 添加数值标签
geom_text(data = df_summary %>% filter(!is.na(median_sale_price)), # 确保只使用有房价数据的行
aes(x = median_sale_price,
label = round(median_sale_price, 0)), hjust = 1, position = position_nudge(x = 0.2)) +
geom_text(data = df_summary %>% filter(!is.na(cnt)), # 确保只使用有房子数量数据的行
aes(x = ifelse(!is.na(cnt_neg), cnt_neg, NA),
label = abs(cnt)), hjust = 1, position = position_nudge(x = -0.2)) +
scale_x_continuous(
expand = c(0, 0),
breaks = NULL, # 移除x轴断点
labels = NULL # 移除x轴标签
) +
scale_fill_viridis_d(option = "D", begin = 0.5, end = 1, direction = -1) + # 使用离散色阶并调整颜色为更浅的紫色
theme_classic() +
labs(x = NULL, y = NULL, fill = NULL) +
guides(fill = guide_legend(reverse=TRUE)) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1), # 明确设置x轴标签样式
axis.title.x = element_blank(), # 如果不需要x轴标题可以移除或设置为element_blank()
axis.line.x = element_line(color = "black") # 可选:添加x轴线
)
```
发现房价高的区域并不是房子最多的区域,这是为什么?
### 地上居住面积和房子价格关系
数据非正态分布,对数处理后再看。发现数据更接近正态分布了
#### **为什么要对数据进行对数处理?**
##### **1. 稳定方差**
- **异方差问题**:当变量的方差随着均值的变化而变化时(即存在异方差性),这可能会导致统计模型的假设不成立。对数变换可以帮助稳定方差,使得不同水平上的方差更加一致。
- **线性回归模型**:在线性回归中,残差应该具有恒定的方差。如果原始数据存在异方差,对数变换可以改善这一特性。
##### **2. 减少偏斜**
- **右偏分布**:许多实际中的数据集往往呈现出右偏(正偏)分布,例如收入、房价等。对数变换可以将这种偏斜的数据转换为更接近正态分布的形式,从而更容易进行统计分析和建模。
- **对称性**:对数变换可以使分布更加对称,这对于某些统计检验和模型假设是有利的。
##### **3. 线性化关系**
- **幂律或指数关系**:当两个变量之间存在幂律或指数关系时,直接绘制散点图可能难以看出它们之间的关系。通过对数变换,可以将这些非线性关系转化为线性关系,使得图形更容易解释,并且适合使用线性回归模型。
- **比例变化**:对数尺度下,距离表示的是相对变化而不是绝对变化。这有助于展示变量间的比例关系,尤其是在宽范围数值的情况下。
##### **4. 压缩极端值**
- **异常值影响**:对数变换可以有效压缩极端值的影响,使数据分布更加紧凑和平滑。这有助于减少异常值对模型拟合和结果解释的负面影响。
- **可视化效果**:在绘制图表时,对数变换可以使数据点更加均匀地分布在图表上,避免少数极大或极小值占据过多空间,从而使图形更具可读性和信息量。
##### **5. 经济学和金融学中的应用**
- **百分比变化**:在经济学和金融学中,经常使用对数来表示变量的百分比变化。例如,股票价格的对数差分可以近似看作是收益率。
- **弹性计算**:对数变换后的变量可以直接用于计算弹性(一个变量相对于另一个变量的百分比变化)。这在经济学中尤其有用,因为弹性是一个重要的概念。
##### **6. 提高模型性能**
- **预测精度**:对于一些机器学习算法,对数变换可以提高模型的预测精度。通过减少偏斜和稳定方差,模型能够更好地捕捉数据的真实模式。
- **梯度下降优化**:在训练神经网络等模型时,对数变换可以使损失函数的梯度更加平滑,有助于更快收敛。
quarto-executable-code-5450563D
```r
df_clean_log <- df_clean %>%
mutate(across(where(is.numeric) & !all_of(c("year_built", "unit_price")),
~ log(.), .names = "{col}_log"))
# 画图
# 应用函数到数据框并获取图形列表
df_clean_log_only <- df_clean_log %>%
select(ends_with("_log"))
density_plots_log <- plot_density_all_numeric(df_clean_log_only)
# 使用 patchwork 将所有图形组合在一起
combined_plot_log <- Reduce(`+`, density_plots_log)
# 打印组合后的图形
combined_plot_log
```
quarto-executable-code-5450563D
```r
df_clean %>%
ggplot(aes(x = gr_liv_area, y = sale_price)) +
geom_point(aes(colour = neighborhood)) +
geom_smooth(method = lm, se = TRUE, formula = "y ~ x")
```
### 占地面积和房子价格关系
不做对数处理时候的数据
quarto-executable-code-5450563D
```r
df_clean %>%
ggplot(aes(x = lot_area, y = sale_price)) +
geom_point(aes(colour = neighborhood)) +
geom_smooth(method = lm, se = TRUE, formula = "y ~ x")
```
做对数处理后,更接近线性关系。
- 为什么?有可能本来是指数关系嘛。
quarto-executable-code-5450563D
```r
df_clean_log %>%
ggplot(aes(x = lot_area_log, y = sale_price_log)) +
geom_point(aes(colour = neighborhood)) +
geom_smooth(method = lm, se = TRUE, formula = "y ~ x")
```
不同区域占地面积和价格关系
quarto-executable-code-5450563D
```r
df_clean_log %>%
ggplot(aes(x = lot_area_log, y = sale_price_log)) +
geom_point(colour = "blue") +
geom_smooth(method = lm, se = FALSE, formula = "y ~ x", fullrange = TRUE) +
facet_wrap(~neighborhood) +
theme(strip.background = element_blank())
```
### 房屋价格和居住面积关系
quarto-executable-code-5450563D
```r
df_clean_log %>%
ggplot(aes(x = gr_liv_area, y = sale_price_log)) +
geom_point(aes(colour = neighborhood)) +
geom_smooth(method = lm, se = FALSE, formula = "y ~ x")
```
不同区域房屋价格和居住面积散点图
quarto-executable-code-5450563D
```r
df_clean_log %>%
ggplot(aes(x = gr_liv_area_log, y = sale_price_log)) +
geom_point() +
geom_smooth(method = lm, se = FALSE, formula = "y ~ x", fullrange = TRUE) +
facet_wrap(~neighborhood) +
theme(strip.background = element_blank())
```