[ Fastcampus Mini-project ] House Sales in King County, USA (Predict house price using Linear regression) - kaggle
통계를 배운지 3주 정도 지나고, 배운 내용을 바탕으로 하여 미니 프로젝트를 진행
집값에 영향을 미치는 요인을 찾고 가격을 예측
데이터 셋 : kaggle에서 제공하는 House Sales in King County
프로젝트 기간 : 08.03 ~ 08.09
rm(list=ls())
#' @title parallel coding
#' @author Jungchul HA
#' @version 1.0, 2017.08.21
#' @description 집값 예측 미니 프로젝
# 01. setting -------------------------------------------------------------
# import use library
library(dplyr)
library(readxl)
library(ggplot2)
library(ggmap)
library(DT)
library(maps)
library(corrplot)
library(caret)
library(car)
## King County
## 원본 데이터
House = readxl::read_excel("fs/house/kc_house.xlsx",
sheet = "data",
col_names = TRUE)
House$date<-(substr(House$date, 1, 8))
House$date = as.numeric(House$date)
House$per.price = House$price / House$sqft_living
# train / test 데이터 셋 분류
set.seed(1708)
ratio = sample(1:nrow(House), size = 0.30*nrow(House))
test = House[ratio,] #Test dataset 30% of total
train = House[-ratio,] #Train dataset 70% of total
# 분류된 모델을 바탕으로 분석 진행
# write.csv(train,
# file = "fs/house/train.csv",
# row.names = FALSE)
# write.csv(train,
# file = "fs/house/test.csv",
# row.names = FALSE)
#
# train = read.csv("fs/house/train.csv",
# header = TRUE)
#
# test = read.csv("fs/house/test.csv",
# header = TRUE)
# 02. EDA ----------------------------------------------------------------
summary(House)
View(House)
str(House)
colSums(is.na(House)) # 결측값은 0
# 02-1. 상관관계 분석 ---------------------------------------------------
train.num <- cor(train) ## House_num 생성 후 상관관계 분석치 할당
round(train.num, 3) ## 소수점 셋째자리까지 출력
corrplot::corrplot(train.num,
method = "number",
shade.col = NA,
tl.col = "black",
tl.srt = 50,
order = "hclust",
diag = FALSE)
pairs(train,
pch = 19,
bg = c("red", "green", "blue")) # 행렬모양 산점도
# 상관원계수가 클수록 크기가 크고 색깔이 진하다
# 양수면 파란색, 음수면 붉은색
corrplot(train)
corrplot(train, method = "number") # 수와 색깔로 표현
corrplot(train,
method = "color", # 색깔로 표현
col = col(200), # 색상 200개 선정
type = "lower", # 왼쪽 아래 행렬만 표기
order = "hclust", # 유사한 상관계수끼리 군집화
addCoef.col = "black", # 상관계수 색깔
tl.col = "black", # 변수명 색깔
tl.srt = 45, # 변수명 45도 기울임
diag = F)
round(cor(test),3)
test = train %>%
select(price, sqft_living, grade ,sqft_above, sqft_living15,
bathrooms, view, sqft_basement, bedrooms)
# 결과 : 5개의 변수가 price와 높은 상관관계를 보여줌
# price ~ sqft_living 0.702
# price ~ grade 0.667
# price ~ sqft_above 0.606
# price ~ sqft_living15 0.585
# price ~ bathrooms 0.525
# ------------------------- #
# price ~ view 0.397
# price ~ sqft_basement 0.324
# price ~ bedrooms 0.308
# price ~ waterfront 0.266
# price ~ floors 0.257
# price ~ yr_renovate 0.126
# price ~ sqft_lot 0.0897
# price ~ sqft_lot15 0.0824
# price ~ yr_built 0.054
# price ~ condition 0.0364
# per.price 와 나머지는 선형관계를 보이지는 않는다.
train1 = train
analysis = train %>%
select(price, zipcode, sqft_living, grade, bathrooms, long, lat, bedrooms)
# 양의 상관관계를 보이는 변수들 중 집을 보러 왔을때 신경쓰는 요소들을
# 변수로 사용
# waterfront의 경우 163개의 데이터가 있지만 전역에 퍼져있으며
# 집값의 경우도 비싼편은 아니라서 제외
# 02-2. zipcode를 바탕으로 파생변수 생성 ---------------------------------
## zipcode는 5자리로 구성되어 있으며,
## 주, 카운티, 도시 단위의 광범위한 지역을 나타내준다.
## 미국인들에게는 zipcode 자체가 '부와 명예'를 상징한다.(출처:LA중앙일보)
## zipcode(각 도시)마다 단위면적 당 가격(per.price)이
## 비슷한 가격대를 형성하고 있지 않을까?
## zipcode grouping 하여 파생변수로 활용해보자.
## 단위면적 당 price 계산 => per.price
analysis$per.price = analysis$price / analysis$sqft_living
# 최소 87.59 / 최대 810.14
## zipcode 별로 grouping
zipcode.price = analysis %>%
select(zipcode, per.price) %>%
group_by(zipcode) %>%
summarise(mean.price = mean(per.price),
max.price = max(per.price),
min.price = min(per.price),
median.price = median(per.price),
n = n())
head(zipcode.price, n=10)
## zipcode = 70개
## zipcode 별로 데이터의 개수 최소 34개 ~ 430개
# zipcode별 평균 - 중위수 차이
zipcode.price$dif.price = round(zipcode.price$mean.price - zipcode.price$median.price, digits = 2)
zipcode.price = zipcode.price[order(zipcode.price$dif.price),]
## 평균과 중위수의 차이가 많이 나면
## 해당 zipcode내에는 outlier로 예상되는 값이 존재 할 수도 있다 라고 생각.
## 단위 면적 가격 mean - median를 구해보니
## 나머지 -0.6 ~ 21
## 결론) zipcode별로 평당 가격이 큰 차이를 보이는 집은 별로 없다.
DT::datatable(zipcode.price)
## 100단위로 dummy변수 대입
zipcode.price$median.price = round(zipcode.price$median.price)
zipcode.price$dummy.median = as.numeric(substr(zipcode.price$median.price,1,1))*100
## zipcode.price에서 zipcode, dummy.median를 추출하여 mg데이터 생성
mg = zipcode.price %>%
select(zipcode, dummy.median)
## train과 mg를 zipcode 기준으로 left outer join
analysis1 = merge(analysis, mg, by = "zipcode", all.x=TRUE)
analysis1$dummy.median = as.factor(analysis1$dummy.median)
KingCounty = ggmap::get_map(location = c(lon=-122.3, lat=47.4),
zoom = 9)
KingCounty1 = ggmap(KingCounty) + geom_point(data = analysis1, aes(x = long, y = lat, colour = dummy.median))
KingCounty1
## 단위 면적 가격이 200이지만 상대적으로 가격대가 높은 지역과
## 붙어있는 3곳을 추가로 확인
## median.price 가 200~300 사이인 데이터만 추출
zipcode.price1 = zipcode.price %>%
filter(median.price >= 200 & median.price <300) %>%
select(zipcode, median.price)
## 나머지를 구해서 10의자리 계산
zipcode.price1$dummy.median = as.numeric(substr(zipcode.price1$median.price,1,2))%%10
DT::datatable(zipcode.price1)
analysis2 = merge(analysis, zipcode.price1, by = "zipcode", all.x = TRUE)
analysis2$dummy.median = as.factor(analysis2$dummy.median)
KingCounty2 = ggmap(KingCounty) + geom_point(data = analysis2, aes(x = long, y = lat, colour = dummy.median))
KingCounty2
## per.price 가 200대인 집들을 시각화 시켜봄.
## 200초반대 까지는 100에
## 200 중반은 200으로
## 200 후반 값을 가지는 8,9는 300에 같이 그룹핑
zipcode.price2 = zipcode.price
zipcode.price2 = within(zipcode.price2,{
dummy.median = numeric(0)
dummy.median [ median.price < 220] = 1
dummy.median [ median.price >= 221 & median.price <= 279 ] = 2
dummy.median [ median.price >= 280 & median.price <= 399 ] = 3
dummy.median [ median.price >= 400 & median.price <= 499 ] = 4
dummy.median [ median.price >= 500 & median.price <= 599 ] = 5
dummy.median [ median.price >= 600] = 6
})
DT::datatable(zipcode.price2)
mg1 = zipcode.price2 %>%
select(zipcode, dummy.median)
analysis3 = merge(analysis, mg1, by = "zipcode", all.x=TRUE)
analysis3$dummy.median = as.factor(analysis3$dummy.median)
KingCounty3 = ggmap(KingCounty) + geom_point(data = analysis3, aes(x = long, y = lat, colour = dummy.median))
KingCounty3
# 비싼 지역만 확대
KingCounty.zoom = ggmap::get_map(location = c(lon=-122.3, lat=47.6), zoom=11)
KingCounty4 = ggmap(KingCounty.zoom) + geom_point(data = analysis3, aes(x = long, y = lat, colour = dummy.median))
KingCounty4
## 가격을 재분류 하여 찍어주었고
## 가격대가 높은 지역만 확대!
# 03. Modeling(회귀분석) -------------------------------------
## 다중선형회귀분석
## 집값에 영향이 있다고 생각되는 변수 추출
result = analysis3 %>%
select(price, bedrooms, bathrooms, grade, sqft_living, dummy.median)
## price와 sqft_living 은 숫자 단위가 크므로 log를 취함
model.1 = lm(log(price) ~ bedrooms + bathrooms + grade + log(sqft_living) + factor(dummy.median), data = result)
summary(model.1)
## bathrooms 은 0.063로 변수 제외
model.2 = lm(log(price) ~ bedrooms + grade + log(sqft_living) + factor(dummy.median), data = result)
summary(model.2)
vif(model.2)
lm.beta::lm.beta(model.2)
## bedrooms : -0.040로 변수 제외
model.3 = lm(log(price) ~ grade + log(sqft_living) + factor(dummy.median), data = result)
summary(model.3)
vif(model.3)
lm.beta::lm.beta(model.3)
## 각 변수들간에 영향도도 있고
## Adjusted R-squared : 0.800
## waterfront는 163개 뿐인데 굳이 넣어야 될 필요성이 있을까?
## waterfront를 보유한 집들은 지도 전역에 골고루 퍼져있음
# 04. 모델 검증 ----------------------------------------------
vif(model.3)
## 다중공선성 문제도 없고
## 해당 모델을 최종 모델로 결정해서 test셋을 예측해보자
## 기존에 zipcode별로 그룹핑한 mg1 과 test 데이터를 merge 해서
## test 데이터에 dummy.median을 만들어주고
test = merge(test, mg1, by = "zipcode", all.x=TRUE)
test$log.price = log(test$price)
## test를 예측해보자
pred = predict(model.3,
newdata = test,
interval = "predict")
pred
## 예측된 값고 test데이터의 log.price와 비교해보면
## 둘 사이의 관계가 0.89 정도
pred = as.data.table(pred)
pred$fit.price = 10^(pred$fit)
### log n복구
colnames(pred)
pred.final = pred
test.final = test %>%
select(price, log.price)
final = cbind(test.final, pred.final)
final$result = ifelse( final$lwr<=final$log.price & final$log.price<=final$upr ,1,0)
table(final$result)
# 05. 기타(잔치 그래프) 확인 ----------------------------------------
analysis3[hatvalues(model.3) >= 0.025 , ]
# zipcode가 98039인 곳 가장 비쌈
out = train[c(11745,11812),]
DT::datatable(out)
out$per.price = out$price / out$sqft_living
## 다른 조건들에 비해 grade가 높아서 이상치로 판별됨
rm(list=ls())
train.out1 = train %>%
filter(zipcode == 98070)
mean(train.out1$per.price)
train.out2 = train %>%
filter(zipcode == 98146)
mean(train.out2$per.price)
zipcode.price3 = zipcode.price
zipcode.price = within(zipcode.price,{
dummy.mean = numeric(0)
dummy.mean [ mean.price < 220] = 1
dummy.mean [ mean.price >= 221 & mean.price <= 279 ] = 2
dummy.mean [ mean.price >= 280 & mean.price <= 399 ] = 3
dummy.mean [ mean.price >= 400 & mean.price <= 499 ] = 4
dummy.mean [ mean.price >= 500 & mean.price <= 599 ] = 5
dummy.mean [ mean.price >= 600] = 6
})
DT::datatable(zipcode.price3)
mg1 = zipcode.price3 %>%
select(zipcode, dummy.mean)
train3 = merge(train, mg1, by = "zipcode", all.x=TRUE)
train3$dummy.mean = as.factor(train3$dummy.mean)
model4 = lm(log(price) ~ grade + log(sqft_living) + factor(dummy.mean), data = train)
summary(model4)
lm.beta::lm.beta(model4)
vif(model4)
plot(model4)
names(model4)
out = train3[c(4827,6475,13894,14499),]
water = train3 %>%
filter(waterfront == 0)
model5 = lm(log(price) ~ grade + log(sqft_living) + factor(dummy.mean), data = water)
summary(model5)
lm.beta::lm.beta(model5)
vif(model5)
par(mfrow = c(2,2))
plot(model5)