R語言-上海二手房數據分析

案例:通過分析上海的二手房的數據,分析出性價比(地段,價格,未來的升值空間)來判斷哪個區位的二手房性價比最高

1.載入包

library(ggplot2)
library(Hmisc)
library(car)
library(caret)

2.加載數據集

houses <- read.csv('E:\\Udacity\\Data Analysis High\\R\\R_Study\\二手房分析案例\\鏈家二手房.csv',sep=',',header=T)

3.查看數據集

describe(houses)

數據集有以下幾個字段構成

## 小區名稱
## 戶型
## 面積
## 區域
## 樓層
## 朝向
## 價格.W.
## 單價.平方米.
## 建築時間

探究影響房價的主要因素是什么

4.查看戶型的分布

type_freq <- data.frame(table(houses$戶型))
type_p <- ggplot(data=type_freq,aes(x=reorder(Var1,-Freq),y=Freq))+
  geom_bar(stat='identity',fill='steelblue')+
  theme(axis.text.x = element_text(angle = 30,vjust = 0.5))+
  xlab('戶型')+
  ylab('套數')
type_p

　　結論:戶型的分布不符合正態分布

　　　　 需要對戶型的數據進行清洗,找出主要的戶型

5.對戶型數據進行清洗

# 把低於一千套的房型設置為其他
type <- c('2室2廳','2室1廳','3室2廳','1室1廳','3室1廳','4室2廳','1室0廳','2室0廳','4室1廳')

houses$type.new <- ifelse(houses$戶型 %in% type,as.character(houses$戶型),'其他')
type_freq <- data.frame(table(houses$type.new))
# 繪圖
type_p <- ggplot(data = type_freq, mapping = aes(x = reorder(Var1, -Freq),y = Freq)) + 
  geom_bar(stat = 'identity', fill = 'steelblue') + 
  theme(axis.text.x  = element_text(angle = 30, vjust = 0.5)) + 
  xlab('戶型') + ylab('套數')
type_p

　　結論:2室2廳,2室1廳,3室2廳是上海比較多的二手房戶型

6.樓層數據清洗

# 新建floor變量,使用ifelse來判斷具體的樓層
houses$floor <- ifelse(substring(houses$樓層,1,2) %in% c('低區','高區','中區'),substring(houses$樓層,1,2),'低區')
# 計算百分比
percent <- paste(round(prop.table(table(houses$floor))*100,2),'%',sep = '')
df <- data.frame(table(houses$floor))
df <- cbind(df,percent)
df

7.建築時間清洗

# 自定義眾數函數
stat.mode <- function(x, rm.na = TRUE){
  if (rm.na == TRUE){
    y = x[!is.na(x)]
  }
  res = names(table(y))[which.max(table(y))]
  return(res)
}
# 自定義函數，實現分組替補
my.impute <- function(data, category.col = NULL, 
                      miss.col = NULL, method = stat.mode){
  impute.data = NULL
  for(i in as.character(unique(data[,category.col]))){
    sub.data = subset(data, data[,category.col] == i)
    sub.data[,miss.col] = impute(sub.data[,miss.col], method)
    impute.data = c(impute.data, sub.data[,miss.col])
  }
  data[,miss.col] = impute.data
  return(data)
}
# 將建築時間中空白字符串轉換為缺失值
houses$建築時間[houses$建築時間 == ''] <- NA
#分組替補缺失值，並對數據集進行變量篩選

final_house <- subset(my.impute(houses, '區域', '建築時間'),select = c(type.new,floor,面積,價格.W.,單價.平方米.,建築時間))
#構建新字段builtdate2now，即建築時間與當前2016年的時長
final_house <- transform(final_house, builtdate2now = 2016-as.integer(substring(as.character(建築時間),1,4)))
#刪除原始的建築時間這一字段
final_house <- subset(final_house, select = -建築時間)

8.查看房價和面積的正態分布

# 自定義正態分布的函數
# 自定義繪圖函數 
norm.test <- function(x, breaks = 20, alpha = 0.05,
plot = TRUE){
if(plot == TRUE)
{#設置圖形界面（多圖合為一張圖）
opar <- par(no.readonly = TRUE)
layout(matrix(c(1,1,2,3),2,2,byrow = TRUE),
width = c(2,2),heights = c(2,2))
#繪制直方圖
hist(x, freq = FALSE, breaks = seq(min(x),
max(x), length = breaks), main = 'x的直方圖',
ylab = '核密度值')
#添加核密度圖
lines(density(x), col = 'red', lty = 1, lwd = 2)
#添加正態分布圖
x <- x[order(x)]
lines(x, dnorm(x, mean(x), sd(x)),
col = 'blue', lty = 2, lwd = 2.5)
#添加圖例
legend('topright',
legend = c('核密度曲線','正態分布曲線'),
col = c('red','blue'), lty = c(1,2),
lwd = c(2,2.5), bty = 'n')
#繪制Q-Q圖
qqnorm(x, xlab = '實際分布', ylab = '正態分布',
main = 'x的Q-Q圖', col = 'blue')
qqline(x)
#繪制P-P圖
P <- pnorm(x, mean(x), sd(x))
cdf <- 0
for(i in 1:length(x)){cdf[i] <- sum(x <= x[i])/length(x)}
plot(cdf, P, xlab = '實際分布', ylab = '正態分布',
main = 'x的P-P圖', xlim = c(0,1),
ylim = c(0,1), col = 'blue')
abline(a = 0, b = 1)
par(opar)
}
#定量的shapiro檢驗
if (length(x) <= 5000) {
shapiro <- shapiro.test(x)
if(shapiro$p.value > alpha)
print(paste('定量結果為：', 'x服從正態分布，',
'P值 =',round(shapiro$p.value,5), '> 0.05'))
else
print(paste('定量結果為：', 'x不服從正態分布，',
'P值 =',round(shapiro$p.value,5), '<= 0.05'))
shapiro
}
else {
ks <- ks.test(x,'pnorm')
if(ks$p.value > alpha)
print(paste('定量結果為：', 'x服從正態分布，',
'P值 =',round(ks$p.value,5), '> 0.05'))
else
print(paste('定量結果為：', 'x不服從正態分布，',
'P值 =',round(ks$p.value,5), '<= 0.05'))
ks
}
}

# 面積的正態檢驗
norm.test(houses$面積)

# 價格的正態檢驗
norm.test(houses$價格.W.)

　　結論:房價和面積均不服從正態分布,因此不能對其進行做線性回歸模型

9.查看上海地區二手房的均價

avg_price <- aggregate(houses$單價.平方米.,by=list(houses$區域),FUN=mean)
p <- ggplot(data=avg_price,aes(x=reorder(Group.1,-x),y=x,group=1))+
  geom_area(fill='lightgreen')+
  geom_line(colour = 'steelblue', size = 2)+
  geom_point()+
  ylab('均價')
p

 

　　　　 　　結論:靜安區和徐匯區的價格較高

10.模型構建

　　在對房屋進行建模的時候,首先使用聚類把不同類型的房子給划分出來,我選擇面積,房價,單價/㎡來進行聚類的划分

　　10.1 聚類的個數

# 模型構建
tot.wssplot <- function(data,nc,seed=1234){
# 計算距離的平方和
  tot.wss <- (nrow(data)-1) * sum(apply(data,2,var))
  for(i in 2:nc){
    set.seed(seed)
    tot.wss[i] <- kmeans(data,centers = i,iter.max = 100)$tot.withinss
  }
  plot(1:nc,tot.wss,type='b',xlab = 'Number of Cluster',
       ylab = 'Within groups sum of squares',col='blue',lwd=2,
       main='choose best clusters')
}
# 找出判斷聚類的三個主要的指標
stander <- data.frame(scale(final_house[,c('面積','價格.W.','單價.平方米.')]))
# 做出聚類個數圖
tot.wssplot(stander,15)

　　結論:分成5個類的模型的效果會比較好

 　　10.2聚類

set.seed(1234)
clust <- kmeans(x=stander,centers = 5,iter.max = 100)
table(clust$cluster)

　　結論:每個聚類的結果

　10.3查看聚類的結果

# 查看每個戶型的平均面積
aggregate(final_house$面積,list(final_house$type.new),FUN=mean)

# 比較每個類中的面積,單價,每平米價格
aggregate(final_house[,3:5],list(clust$cluster),FUN=mean)

　　結論:

　　　　第1組是地段型的房子,地段位於上海的核心區域,每平米的單價是最高的

　　　　第2組是面積型的房子,地段稍遜於第1組,面積都在350平米以上,屬於享受階層買得起的房子

　　　　第3組是均衡型的房子,地段和面積均屬於發展中的狀態,房價漲勢穩定,將來的發展空間較大

　　　　第4組是廉價型的房子,面積和價格都相對比較低,地段和面積相對較低

　　10.4聚類的散點圖

p <- ggplot(data=final_house[,3:5],aes(x=面積,y=單價.平方米.,color=factor(clust$cluster)))+
  geom_point(pch=20,size=3)+
  scale_color_manual(values = c('red','blue','green','black','orange'))
p

11建模

　　11.1 將類別變量變成因子類型

final_house$floor <- factor(final_house$floor)
final_house$type.new <- factor(final_house$type.new)
final_house$clsuter <- factor(clust$cluster)

　　11.2構建公式

# 選擇出所有的因子變量
factors <- names(final_house)[sapply(final_house, class)=='factor']
formal <- f <- as.formula(paste('~',paste(factors,collapse = '+')))
dummy <- dummyVars(formula = formal,data=final_house)
pred <- predict(dummy,newdata=final_house)
head(pred)

　　11.3建模

final_house2 <- cbind(final_house,pred)
# 選擇需要建模的因子
model_data <- subset(final_house2,select=-c(1,2,3,8,17,18,24))
fit1 <- lm(價格.W. ~ .,data=model_data)
summary(fit1)

　　結論:建造時間和2室1廳的影響不明顯,需要對模型進行修改

　　11.4修改模型

#由於房價不符合正態分布,所以要對價格取對數
powerTransform(fit1)
fit2 <- lm(log(價格.W.) ~ .,data=model_data)
summary(fit2)

　　結論:R²的值得到了提高,並且建造時間和2室1廳的影響已經計入到模型中去

　　11.5查看最終模型的診斷結果

opar <- par(no.readonly = TRUE)
par(mfrow = c(2,2))
plot(fit2)
par(opar)

　　結論:符合線性回歸模型的假設