[Fastcampus] 10. 집값 예측 miniproject

[ 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)