close_btn
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
# 설맞이 분석과제
rm(list=ls())
setwd("C:/Users/user/Desktop/toBigs/설과제/설 데이터 분석 과제")

# package
if(!require(parallel)) install.packages("parallel"); library(parallel)
if(!require(data.table)) install.packages("data.table"); library(data.table)
if(!require(dplyr)) install.packages("dplyr"); library(dplyr)
if(!require(foreach)) install.packages("foreach"); library(foreach)
if(!require(doParallel)) install.packages("doParallel"); library(doParallel)
if(!require(DMwR)) install.packages("DMwR"); library(DMwR)
if(!require(rpart)) install.packages("rpart"); library(rpart)
if(!require(rpart.plot)) install.packages("rpart.plot"); library(rpart.plot)
if(!require(RWeka)) install.packages("RWeka")
if(!require(biglm)) install.packages("biglm"); library(biglm)
if(!require(neuralnet)) install.packages("neuralnet"); library(neuralnet)
if(!require(randomForest)) install.packages("randomForest"); library(randomForest)
if(!require(caret)) install.packages("caret"); library(caret)
if(!require(geosphere)) install.packages("geosphere"); library(geosphere)

# 병렬처리
# registerDoParallel(cores=detectCores(all.tests=TRUE))
registerDoParallel(cores=2)

# 데이터
#t.train <- read.csv("taxi_train.csv", stringsAsFactors = FALSE)
#t.test <- read.csv("taxi_test.csv",stringsAsFactors = FALSE)

taxi <- fread("taxi_train.csv", stringsAsFactors = FALSE)
taxi <- data.frame(taxi)
test <- fread("taxi_test.csv",stringsAsFactors = FALSE)
test <- data.frame(test)
names(test) <- names(taxi)[1:9]

# NA값 확인
sum(is.na(taxi))
sum(is.na(test))

# id,V1삭제
taxi <- taxi[,c(-1,-2)]
test <- test[,c(-1,-2)]

# 범주형 자료 수치로 변환
taxi$store_and_fwd_flag <- ifelse(taxi$store_and_fwd_flag == "Y", 1 , 0)
test$store_and_fwd_flag <- ifelse(test$store_and_fwd_flag == "Y", 1 , 0)

# 이상치 검정
train.p <- taxi %>% group_by(trip_duration) %>% summarise(n())

# 이상치 2개 발견
plot(train.p$trip_duration,train.p$`n()`)
boxplot(train.p$trip_duration)
3.png

# 2개 제거
taxi <- taxi[-which(taxi$trip_duration %in% sort(taxi$trip_duration,decreasing = T)[1:2]),]

# 파티션
set.seed(1)
idx <- sample(1:length(taxi$vendor_id),length(taxi$vendor_id)*.75,replace = F)
taxi.train <- taxi[idx,]
taxi.test <- taxi[-idx,]

#### 회귀분석,
# *회귀모형을 토대로 변수를 생성하고 다음 모델은 같은 변수 사용
# 회귀 모델 적합
ff <- trip_duration ~ vendor_id + passenger_count + pickup_longitude + 
  pickup_latitude + dropoff_longitude + dropoff_latitude + store_and_fwd_flag
lm.model <- biglm(ff ,data= taxi.train)
lm.pred <- predict(lm.model, taxi.test)

# 모델 평가
MAE <- function(actual, predicted) {
  mean(abs(actual - predicted))
}

MAE(taxi.test$trip_duration, lm.pred)
MAE(mean(taxi.test$trip_duration), lm.pred)
# 오차들의 평균이 593.27이다. 이는 모든값을 평균으로 예측했을 때의 MAE값=150보다 크다.
cor(taxi.test$trip_duration,lm.pred)
# 예측값과 정답의 상관계수 또한 0.09로 일치한다고 보기 힘들다.

# 모델 개선
# 변수추가,  pickup/dropoff 경,위도를 이용해서 실제 거리 계산
# https://cran.r-project.org/web/packages/geosphere/geosphere.pdf
taxi.train$distance <- distHaversine(taxi.train[1:length(taxi.train$vendor_id),3:4], taxi.train[1:length(taxi.train$vendor_id),5:6], r=6378.137)
taxi.test$distance <- distHaversine(taxi.test[1:length(taxi.test$vendor_id),3:4], taxi.test[1:length(taxi.test$vendor_id),5:6], r=6378.137)

# 회귀 모델 적합
ff2 <- trip_duration ~ vendor_id + passenger_count + pickup_longitude + 
  pickup_latitude + dropoff_longitude + dropoff_latitude + store_and_fwd_flag + distance
lm.model2 <- biglm(ff2 ,data= taxi.train)
lm.pred2 <- predict(lm.model2, taxi.test)

# 모델 평가
MAE(taxi.test$trip_duration, lm.pred2)
# 기존 MAE값 593.2773에서 460.2242로 감소, 변수가 의미있음을 확인하였다.
cor(taxi.test$trip_duration,lm.pred2)
# 기존 cor = 0.09 -> 0.16

# distance변수는 의미가 있어서 전체 데이터에 추가
taxi$distance <- distHaversine(taxi[1:length(taxi$vendor_id),3:4], taxi[1:length(taxi$vendor_id),5:6], r=6378.137)
test$distance <- distHaversine(test[1:length(test$vendor_id),3:4], test[1:length(test$vendor_id),5:6], r=6378.137)

## distance에 따른 이상치 제거
taxi.p <- taxi %>% group_by(trip_duration) %>% summarise(mean(distance))
plot(taxi.p, main = "duration:distance")
4.png
# 거리를 계산하고나니 의문점이 생겼다.
# 대부분의 데이터는 duration이 8000이하이나 8만 근처까지 가는것도 보인다.
# 이동 거리와 걸린 시간은 비례를 할 것이라 가정하에 duration이 8천에서 8만까지 10배가 증가한다면
# distance는 그에 비례해서 증가해야 정상이나 오히려 변함이 없음을 알 수 있다.
# 데이터가 기록될 당시 교통체증이나 기타 이유로 인해 이런 결과가 나올 수 있겠으나
# 현재 갖고있는 데이터에는 시간, 요일, 당시 교통량, 사고 등 비정상적인 경우에 대한 정보가 나와있지 않아
# 위치정보만을 갖고 있는 상태에선 무슨 상황에서 이러한 결과를 보이는지 판단이 불가능하다.
# 따라서 pickup, dropoff 위치와 distance를 제일 중요한 변수라고 두고 특정 수준 이상의 duration 범위를 갖는 행을 제외하거나
# 하나의 모델이 아닌 두개의 모델을 만들어야 할 것 같다
# 그런데 변수 설명에 의하면 duration의 단위는 1초이다. 
# 8만 이상의 수치는 24시간에 가까운 시간을 의미하므로 이는 정상적으로 수집된 자료라고 보기 힘들다.
# 따라서 두개의 모델을 만들지 않고 일정 수준 이상의 duration은 특이값으로 판단
taxi3 <- taxi[taxi$trip_duration >= 80000,]
length(taxi3$vendor_id)/length(taxi$vendor_id)
taxi3 <- taxi[taxi$trip_duration >= 10000,]
length(taxi3$vendor_id)/length(taxi$vendor_id)
# 8만이상의 duration을 갖는 행의 개수가 1343개 밖에 되지 않는다. 이는 전체의 0.0013에 해당하고 
# 범위를 넓혀 1만 이상의 자료의 개수는 1499개, 전체의 0.0014에 해당한다.
# 이정도 size는 제외시켜도 분석에 지장이 없을 것이라 생각된다.
# 확신을 갖기 위해 다음과 같이 조건에 해당하는 자료 비율과 상관계수의 변화를 확인
dit <- c(1000,5000,7500,10000,30000,length(taxi$vendor_id))
for (i in 1:length(dit)) {
  cat("duration:",dit[i],"이하 해당 비율: ", length(taxi[taxi$trip_duration <= dit[i],1])/length(taxi$vendor_id),
      "상관 계수: ",cor(taxi[taxi$trip_duration <= dit[i]& taxi$distance < 300,]$trip_duration,taxi[taxi$trip_duration <= dit[i] & taxi$distance < 300,]$distance),"\n")
}
#duration: 1000 이하 해당 비율:  0.7163297 상관 계수:  0.5846961 
#duration: 5000 이하 해당 비율:  0.997434 상관 계수:  0.7671625 
#duration: 7500 이하 해당 비율:  0.9984633 상관 계수:  0.7667336 
#duration: 10000 이하 해당 비율:  0.9985319 상관 계수:  0.7650782 
#duration: 30000 이하 해당 비율:  0.9985975 상관 계수:  0.7496873 
#duration: 1021048 이하 해당 비율:  1 상관 계수:  0.1630699
# 거리와 duration의 상관계수는 5000일때 정점을 찍고 그 이후론 내려간다
# 10000 이상의 데이터를 제외해도 자료개수에 크게 의미 없을것 같으므로 제외
taxi <- taxi[taxi$trip_duration < 10000,]
taxi.m <- taxi %>% group_by(trip_duration) %>% summarise(mean(distance))
plot(taxi.m, main = "duration < 10000 : distance")
5.png
# trip_duration이 증가함에 따라 거리가 증가하는 경향을 보인다.
# 그러나 운행시간 4000을 기준으로 그 이상인 경우엔 불확실하다.
# 4000 이상의 duration은 1시간 이상을 택시에서 보냈다는 것을 의미한다.
# 따라서 duration > 4000이면서, distance가 0에 근접하거나
# 차를 탔다고 생각하기 어려운 거리는 데이터 오류라 보고 제외시키겠다.
t40 <- taxi[taxi$trip_duration > 4000 & taxi$trip_duration <= 10000,"distance",drop=F]
t40$distance %>% summary
t40 <- subset(t40,t40$distance < 10)
taxi <- taxi[!rownames(taxi) %in% rownames(t40),]
taxi.m <- taxi %>% group_by(trip_duration) %>% summarise(mean(distance))
plot(taxi.m, main = "duration : distance")
6.png

# 이상치 제거 후 다시 적합
taxi.train <- taxi[idx,]
taxi.test <- taxi[-idx,]

ff2 <- trip_duration ~ vendor_id + passenger_count + pickup_longitude + 
  pickup_latitude + dropoff_longitude + dropoff_latitude + store_and_fwd_flag + distance
lm.model2 <- biglm(ff2 ,data= taxi.train)
lm.pred2 <- predict(lm.model2, taxi.test)

# 모델 평가
MAE(taxi.test$trip_duration, lm.pred2)
# 기존 MAE값 460.2242에서 283.2097로 상당히 낮아졌다.
cor(taxi.test$trip_duration,lm.pred2)
# 기존 cor = 0.16 -> 0.679

## 변수 추가, 위도차이와 경도차이
taxi.train$d.lat <- abs(taxi.train$pickup_latitude - taxi.train$dropoff_latitude)
taxi.train$d.lon <- abs(taxi.train$pickup_longitude - taxi.train$dropoff_longitude)

taxi.test$d.lat <- abs(taxi.test$pickup_latitude - taxi.test$dropoff_latitude)
taxi.test$d.lon <- abs(taxi.test$pickup_longitude - taxi.test$dropoff_longitude)

# 회귀 모델 적합
ff3 <- trip_duration ~ vendor_id + passenger_count + pickup_longitude + 
  pickup_latitude + dropoff_longitude + dropoff_latitude + store_and_fwd_flag + distance +
  d.lat + d.lon

lm.model3 <- biglm(ff3 ,data= taxi.train)
lm.pred3 <- predict(lm.model3, taxi.test)

# 모델 평가
MAE(taxi.test$trip_duration, lm.pred3)
# 기존 MAE값 283.2097에서 281.4863로 변수가 약하지만 의미있음을 확인하였다.
cor(taxi.test$trip_duration,lm.pred3)
# 기존 cor = 0.679 -> 0.684

# 위도와 경도의 차이는 의미가 있어 전체 데이터에 추가
taxi$d.lat <- abs(taxi$pickup_latitude - taxi$dropoff_latitude)
taxi$d.long <- abs(taxi$pickup_longitude - taxi$dropoff_longitude)

test$d.lat <- abs(test$pickup_latitude - test$dropoff_latitude)
test$d.long <- abs(test$pickup_longitude - test$dropoff_longitude)

# 변수 추가, 거리 이진 변수
# tree 모델 rpart의 첫번째 split 기준으로 나온 4.488 이용
taxi.train$distance448 <- ifelse(taxi.train$distance >= 4.48,1,0)
taxi.test$distance448 <- ifelse(taxi.test$distance >= 4.48,1,0)

# 모델 적합
ff4 <- trip_duration ~ vendor_id + passenger_count + pickup_longitude + 
  pickup_latitude + dropoff_longitude + dropoff_latitude + store_and_fwd_flag + distance +
  d.lat + d.lon + distance448

lm.model4 <- biglm(ff4 ,data= taxi.train)
lm.pred4 <- predict(lm.model4, taxi.test)

# 모델 평가
MAE(taxi.test$trip_duration, lm.pred4)
# 기존 MAE값 281.4863에서 281.3503로 거의 동일
cor(taxi.test$trip_duration,lm.pred4)
# 기존 cor = 0.679 -> 0.704, 상관계수가 올랐고 MAE도 매우 작은 값이지만 내려서 변수추가

# 전체데이터에 변수 추가
taxi$distance448 <- ifelse(taxi$distance >= 4.48,1,0)
test$distance448 <- ifelse(test$distance >= 4.48,1,0)

# 변수추가, 거리의 제곱
taxi.train$distance.p <- (taxi.train$distance)^2
taxi.test$distance.p <- (taxi.test$distance)^2

ff5 <- trip_duration ~ vendor_id + passenger_count + pickup_longitude + 
  pickup_latitude + dropoff_longitude + dropoff_latitude + store_and_fwd_flag + distance +
  d.lat + d.long  + distance448 + distance.p

lm.model5 <- biglm(ff5 ,data= taxi.train)
lm.pred5 <- predict(lm.model5, taxi.test)

# 모델 평가
MAE(taxi.test$trip_duration, lm.pred5)
# 기존 MAE값 281.3503에서 277.594로 감소
cor(taxi.test$trip_duration,lm.pred5)
# 기존 cor = 0.704 -> 0.609
# MAE는 감소했으나 상관계수가 감소, 그러나 MAE가 감소했기에 변수 삽입
taxi$distance.p <- (taxi$distance)^2
test$distance.p <- (test$distance)^2
# 거리이진변수와, 거리의 제곱은 넣지 않아도 크게 차이가 없을 것 같지만 MAE값이 작게나마 감소하므로 넣고 진행

### 회귀트리, 모델트리
# *변수는 위에서 추가한 것 동일하게 사용
# * 10000개의 자료로 학습
taxi.train <- na.omit(taxi.train)
taxi.test <- na.omit(taxi.test)
rpart.model <- train(trip_duration~., data = taxi.train[1:10000,], method="rpart")
rpart.pred <- predict(rpart.model,taxi.test, type = "raw")

# 시각화
# rpart.model2 <- rpart(trip_duration~.,data = taxi.train[1:10000,], cp = rpart.model$bestTune,minsplit = 10)
# rpart.plot(rpart.model2,digits = 4, fallen.leaves = TRUE ,type = 3, extra = 101)

# 평가
MAE(taxi.test$trip_duration, rpart.pred)
# rpart의 MAE는 332.02
cor(taxi.test$trip_duration,rpart.pred)
# 상관계수는 0.709이다.

# 모델트리
# 모델트리는 잎노드에 특정 값이 아닌 회귀 모델을 작성한다. 즉 각각의 분류마다 회귀모델을 생성
# 사용자의 JAVA 위치 지정
Sys.setenv(JAVA_HOME = 'C:\\Program Files\\Java\\jre-9.0.1')
library(rJava);library(RWeka)
m.model <- M5P(trip_duration~., data = taxi.train[1:10000,])
m.pred <- predict(m.model, taxi.test)

# 평가
MAE(taxi.test$trip_duration, m.pred)
# 모델트리의 MAE는 257.3108
cor(taxi.test$trip_duration, m.pred)
# 상관계수는 0.766

### rf
# 시간상의 문제로 1000개만 학습
# taxi.train <- na.omit(taxi.train)
# taxi.test <- na.omit(taxi.test)
rf.model <- train(trip_duration~., data = taxi.train[1:1000,], method="rf")
rf.pred <- predict(rf.model,taxi.test, type = "raw")

# 평가
MAE(taxi.test$trip_duration, rf.pred)
# rf의 MAE는 262.0352
cor(taxi.test$trip_duration, rf.pred)
# 상관계수는 0.80

### svm
# rf와 마찬가지로 1000개 학습
svm.model <- train(trip_duration~., data = taxi.train[1:1000,], method="svmRadial")
svm.pred <- predict(svm.model,taxi.test,type="raw")

# 평가
MAE(taxi.test$trip_duration, svm.pred)
# svmRadial의 MAE는 270.0591
cor(taxi.test$trip_duration, svm.pred)
# svmRadial의 상관계수는 0.767

### xgboost
xg.model <- train(trip_duration~., data = taxi.train[1:1000,], method="xgbTree")
xg.pred <- predict(xg.model, taxi.test)

# 평가
MAE(taxi.test$trip_duration, xg.pred)
# xgboost의 MAE는 265.8614
cor(taxi.test$trip_duration, xg.pred)
# 상관계수는 0.7989

### 위 결과를 바탕으로 test데이터 예측
# rf와 모델트리가 성능이 좋지만 데이터의 용량이 너무 큰 관계로 전체데이터는 돌아가질 않는것 같다. rf와 모델트리는 일부만 학습
# m.model <- M5P(trip_duration~., data = taxi)
# Error in .jcall(o, "Ljava/lang/Class;", "getClass") : 
#   java.lang.OutOfMemoryError: Java heap space

## 회귀분석, 전체 데이터 학습
ff5 <- trip_duration ~ vendor_id + passenger_count + pickup_longitude + 
  pickup_latitude + dropoff_longitude + dropoff_latitude + store_and_fwd_flag + distance +
  d.lat + d.long + distance448 + distance.p

lm.model5 <- biglm(ff5 ,data= taxi)
lm.pred5 <- predict(lm.model5, test, type = "raw")

# predict가 되지 않아 직접 계산
lm.summary <- summary(lm.model5);lm.summary
lm.beta <- lm.summary$mat[,1];lm.beta

registerDoParallel(cores = 2)
lm.predict <- foreach(i = 1:length(test$vendor_id), .combine = 'c') %dopar% {
  lm.beta[1] + lm.beta[2] * test[i,names(lm.beta[2])] + lm.beta[3] * test[i,names(lm.beta[3])] + 
    lm.beta[4] * test[i,names(lm.beta[4])] + lm.beta[5] * test[i,names(lm.beta[5])] +
    lm.beta[6] * test[i,names(lm.beta[6])] + lm.beta[7] * test[i,names(lm.beta[7])] + 
    lm.beta[8] * test[i,names(lm.beta[8])] + lm.beta[9] * test[i,names(lm.beta[9])] +
    lm.beta[10] * test[i,names(lm.beta[10])] + lm.beta[11] * test[i,names(lm.beta[11])] +
    lm.beta[12] * test[i,names(lm.beta[12])] + lm.beta[13] * test[i,names(lm.beta[13])]
}
names(lm.predict) <- 1:length(test$vendor_id)
predict <- data.frame(lm.predict)

## rf, 2000개 학습
set.seed(1)
idx.sample <- sample(1:length(taxi$vendor_id),2000,replace = F)
rf.model <- train(trip_duration~., data = taxi[idx.sample,], method = "rf")
rf.pred2 <- predict(rf.model, test, type = "raw")
predict <- cbind(predict,rf.pred2)

## 모델트리, 20만개 학습
set.seed(1)
idx.sample2 <- sample(1:length(taxi$vendor_id),200000,replace=F)
m.model2 <- M5P(trip_duration~., data = taxi[idx.sample2,])
m.pred2 <- predict(m.model2, test, type = "class")
predict <- cbind(predict,m.pred2)
names(predict) <- c("lm.pred","rf.pred","model.pred")

#> head(predict,10)
#     lm.pred   rf.pred model.pred
#1   509.4409  344.3962   311.6570
#2   725.9560  627.1004   737.0024
#3  1597.4975 1673.1139  1819.3421
#4   512.4153  511.2735   417.5261
#5   635.3740  844.8786   672.1245
#6   790.0388 1093.4044   979.8650
#7   779.7974  880.2509   799.8806
#8   476.7127  332.2194   338.6327
#9   669.2717  666.0816   836.9427
#10  631.8035  738.1440   872.7628

# csv파일 생성
write.csv(predict,"predict.csv",row.names = FALSE)


List of Articles
번호 제목 글쓴이 날짜 조회 수
공지 R 소스 공유 게시판 이용 관련 공지사항 1 DataMarket 2014.05.21 25223
110 투빅스 8&9기 8주차 LDA - 9기 전민규 file 전민규 2018.03.25 2298
109 투빅스 8&9기 8주차 SVM - 9기 최영제 file :) 2018.03.25 2033
108 투빅스 8&9기 8주차 과제 PCA -9기 신용재 file 신용재 2018.03.23 1961
107 투빅스 8&9기 7주차 과제 논문 요약 - 9기 배현주 file 배현주 2018.03.16 2064
106 투빅스 8&9기 7주차 과제 논문 요약 - 8기 김강열 file 김강열 2018.03.15 2093
105 투빅스 8&9기 7주차 과제 - 9기 김수지 file 김수지 2018.03.15 2085
104 투빅스 8&9기 6주차 과제 - 9기 서석현 file 스르륵 2018.03.08 2056
103 투빅스 8&9기 설 알고리즘 과제 - 9기 백광제 file 백광제 2018.02.25 2469
» 투빅스 8&9기 설 분석 과제 16' 뉴욕 택시 운행시간 예측 - 9기 최영제 :) 2018.02.24 2739
101 투빅스 8&9기 4주차 과제 Random Forest -9기 이잉걸 잉걸 2018.02.15 2379
100 투빅스 8&9기 4주차 과제 Naive Bayes Classification -9기 서석현 file 스르륵 2018.02.14 2338
99 투빅스 8&9기 3주차 과제 K-Nearest Neighbor, K-means 구현 -9기 신용재 1 신용재 2018.02.08 2841
98 투빅스 8&9기 3주차 과제 연관성 분석 - 9기 최영제 :) 2018.02.08 2550
97 투빅스 8&9기 2주차 과제 Gradient Descent, Softmax, Cross Entropy - 9기 서석현 file 스르륵 2018.02.02 2411
96 투빅스 8&9기 2주차 과제 회귀분석/로지스틱 - 9기 최영제 file :) 2018.02.02 2865
95 투빅스 8&9기 2주차 과제 Gradient Descent, Softmax, Cross Entropy - 9기 김명진 file kimji 2018.02.02 2290
94 투빅스 8&9기 1주차 과제 R 9기-신용재 file 신용재 2018.01.25 2685
93 투빅스 8&9기 1주차 과제 R 알고리즘 - 9기 서석현 file 스르륵 2018.01.25 2717
92 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 김민정 민정e 2017.09.23 4078
91 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 최서현 최서현 2017.09.22 3934
Board Pagination ‹ Prev 1 2 3 4 5 ... 6 Next ›
/ 6

나눔글꼴 설치 안내


이 PC에는 나눔글꼴이 설치되어 있지 않습니다.

이 사이트를 나눔글꼴로 보기 위해서는
나눔글꼴을 설치해야 합니다.

설치 취소

Designed by sketchbooks.co.kr / sketchbook5 board skin

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5