close_btn
조회 수 326 추천 수 0 댓글 0
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
setwd('C:/Users/user/Desktop/tobigs/7주차 추천시스템')

dat <- read.csv('train.csv', header = TRUE)
str(dat)

###전처리
# V1, index, place, x, data_view 삭제
dat <- dat[, c(-1, -2, -9, -10, -11, -12)]
dat <- dat[, -10]
str(dat)

# NA 값 확인
sum(is.na(dat))
# No NA

table(dat$shelter)
table(dat$kind)

under_300_kind <- dimnames(table(dat$kind))[[1]][table(dat$kind) < 300]

# 범주의 레벨 축소

shelter_change <- function(x) {
  if(x %in% c('경기', '서울', '인천')) return('수도권')
  else if(x %in% c('경남', '경북', '대구', '부산', '울산')) return('경상도')
  else if(x %in% c('대전', '세종', '충북', '충남')) return('충청도')
  else if(x %in% c('전북', '전남', '광주')) return('전라도')
  else return(x)
}

kind_change <- function(x) {
  if(x %in% under_300_kind) return('etc')
  else return(x)
}

color <- as.vector(dat$color)
color_change <- function(x){
  if (length(as.numeric(gregexpr("/",x)[[1]]))<2) {return(x)
  } else return(substr(x,1,as.numeric(gregexpr("/",x)[[1]])[2]-1))
}
newcolor <- unname(sapply(color,color_change))

dat$shelter <- sapply(1:nrow(dat), function(j) shelter_change(dat$shelter[j]) )
dat$kind <- sapply(1:nrow(dat), function(j) kind_change(dat$kind[j]) )
dat$color <- as.factor(newcolor)

table(dat$shelter)
table(dat$kind)


# x, y 분리 / 데이터 팩터화  
factorization <- function(data) { 
  dat_temp <- lapply(data ,as.factor)
  dat_temp <- as.data.frame(dat_temp)
  dat_temp$kg <- as.numeric(dat_temp$kg)
  dat_temp$year <- as.numeric(dat_temp$year)
  return(dat_temp)
}

dat <- factorization(dat)

target_label <- dat$target
dat_x <- dat[, -9]


#######################################################################################################################
######################################################################################################################
### 사용 모델 정의
library(caret)
library(e1071)
library(rpart)
library(data.table)

## 변수를 나누어 주는 함수

train_test <- function(x, y) {
  index <- createDataPartition(y, p = 0.7, list = FALSE)
  train_x <- x[index, ]
  test_x <- x[-index, ]
  train_y <- y[index]
  test_y <- y[-index]
  
  return(list(train_x = train_x, test_x = test_x,
              train_y = train_y, test_y = test_y))
}

## NB 시뮬레이션 <zooming parameter>

NB_sim <- function(x, y, test_x) {
  
  # First Layer
  NB_grid_1 = expand.grid(fL = 0, usekernel = c(TRUE, FALSE), adjust = seq(0, 2, 0.5))
  model1 <- train(x, y,method = 'nb', trControl = trainControl(method = 'cv', number = 10), tuneGrid = NB_grid_1)
  
  # Second Layer
  model1$results <- na.omit(model1$results)
  temp <- model1$results$Accuracy
  candi <- sort(temp, index.return=TRUE, decreasing = TRUE)$ix[1:2]
  candi_kernel <- model1$results$usekernel[candi] 
  candi_adjust <- model1$results$adjust[candi]
  NB_grid_2 = expand.grid(fL = 0, usekernel = candi_kernel, adjust = c(seq(candi_adjust[1]-1, 
                                                                           candi_adjust[1]+1, 0.1), seq(candi_adjust[2]-1, candi_adjust[2]+1, 0.1) ))
  model2 <-train(x, y,method = 'nb', trControl = trainControl(method = 'cv', number = 10), tuneGrid = NB_grid_2)
  
  pred_prob <- predict(model2, test_x, type = 'prob')
  pred_raw <- predict(model2, test_x, type = 'raw')
  return(list(model2, pred_prob, pred_raw))


## CART 시뮬레이션

DT_sim <- function(x, y, test_x) {
  
  DTctrl <- trainControl(method="repeatedcv",number = 10, repeats = 3)
  DTModel <- train(x, y, method = "rpart", trControl = DTctrl)
  pred_prob <- predict(DTModel, test_x, type = 'prob')
  pred_raw <- predict(DTModel, test_x, type = 'raw')
  return(list(DTModel, pred_prob, pred_raw))
}


## RF 시뮬레이션

RF_sim <- function(x, y, test_x) {
  
  RFgrid <- expand.grid(mtry = seq(3, 15, by = 2))
  RFctrl <- trainControl(method="repeatedcv",number = 10, repeats = 3)
  RF_Model <- train(x, y, method = "rf", trControl = RFctrl, tuneGrid = RFgrid, ntree = 10)
  pred_prob <- predict(RF_Model, test_x, type = 'prob')
  pred_raw <- predict(RF_Model, test_x, type = 'raw')
  return(list(RF_Model, pred_prob, pred_raw))
}

## Bagging 시뮬레이션

BAG_sim <- function(x, y, test_x) {
  
  BAG_ctrl <- trainControl(method="repeatedcv",number = 10, repeats = 3)
  bag_model <- train(x, y, method="treebag", trControl = BAG_ctrl)
  pred_prob <- predict(bag_model, test_x, type = 'prob')
  pred_raw <- predict(bag_model, test_x, type = 'raw')
  return(list(bag_model, pred_prob, pred_raw))
}


## KNN 시뮬레이션

KNN_sim <- function(x, y, test_x) {
  set <- cbind.data.frame(y, x)
  colnames(set)[1] <- 'label'
  KNN_ctrl <- trainControl(method="repeatedcv", number = 5, repeats = 3)
  knn_model <- train(label ~ ., data = set, method = "knn", trControl = KNN_ctrl, preProcess = c("center","scale"))
  pred_prob <- predict(knn_model, test_x, type = 'prob')
  pred_raw <- predict(knn_model, test_x, type = 'raw')
  return(list(knn_model, pred_prob, pred_raw))
}

###################################################################################
### 모델저장: 
#데이터가 커서 시간이 꽤 걸렸기 때문에 save-recall 하였다.
set.seed(123)
target_label <- ifelse(target_label == 1, '1', '0')
target_label <- as.factor(target_label)
spliting <- train_test(dat_x, target_label)

train_x <- spliting[[1]]; train_y <- spliting[[3]];
test_x <- spliting[[2]]; test_y <- spliting[[4]]

NB_res <- NB_sim(train_x, train_y, test_x)
DT_res <- DT_sim(train_x, train_y, test_x)
BAG_res <- BAG_sim(train_x, train_y, test_x)
RF_res <- RF_sim(train_x, train_y, test_x)
KNN_res <- KNN_sim(train_x, train_y, test_x)

## 방법 평가할 모델 저장 
# saveRDS는 R에서 만든 object하나를 파일 형태로 저장할수 있다.
# 시간이 오래 걸려 만든 모델을 저장해 놓고 쓰면 좋을 듯
saveRDS(NB_res[[1]], file = 'NB_res.rds')
saveRDS(DT_res[[1]], file = 'DT_res.rds')
saveRDS(BAG_res[[1]], file = 'BAG_res.rds')
saveRDS(RF_res[[1]], file = 'RF_res.rds')
saveRDS(KNN_res[[1]], file = 'KNN_res.rds')

##최종 모델 저장
NB_final <- NB_sim(dat_x, target_label, test_x)
DT_final <- DT_sim(dat_x, target_label, test_x)
BAG_final <- BAG_sim(dat_x, target_label, test_x)
RF_final <- RF_sim(dat_x, target_label, test_x)
KNN_final <- KNN_sim(dat_x, target_label, test_x)

## 최종 모델 저장
saveRDS(NB_final[[1]], file = 'NB_final.rds')
saveRDS(DT_final[[1]], file = 'DT_final.rds')
saveRDS(BAG_final[[1]], file = 'BAG_final.rds')
saveRDS(RF_final[[1]], file = 'RF_final.rds')
saveRDS(KNN_final[[1]], file = 'KNN_final.rds')


### train-test 모델 Recall
tech <- c('NB', 'DT', 'BAG', 'RF', 'KNN')
models <- paste(tech, '_model')

for(j in 1:length(tech)){
  model_name <- paste0(tech[j], '_res', ".rds") 
  model <- readRDS(model_name)
  assign(models[j], model)
}

### 방법 평가
#################### 최적 모델의 정확도
pred_raw <- sapply(1:length(models), function(j) predict(get(models[j]), test_x, type ='raw')) 
acc_list <- sapply(1:length(models), function(j) confusionMatrix(pred_raw[, j], test_y)$overall[1])
weight <- as.vector(acc_list)

# 0.6618711 0.6658383 0.6691952 0.6788735 0.6458715
# --> RandomForest

#################### 일반적 투표
general_vote <- rep(0, nrow(test_x))

for(i in 1:length(models)) {
  general_vote <- general_vote + as.integer(pred_raw[, i])
}

general_vote_res <- ifelse(general_vote >= 3, 1, 0)
confusionMatrix(general_vote_res, test_y)$overall[1]
# 0.6820996 

####################  probability 투표의 정확도

pred_prob <- lapply(1:length(models), function(j) predict(get(models[j]), test_x, type ='prob')) 

weighted_class_vote <- matrix(0, nrow(test_x), 2)
cutoff <- 0.7

for(i in 1:length(models)) {
  temp <- pred_prob[[i]]
  vote_0 <- sapply(1:nrow(temp), function(j) ifelse(temp[j, 1] > cutoff, 1, 0))
  vote_1 <- sapply(1:nrow(temp), function(j) ifelse(temp[j, 2] > cutoff, 1, 0))
  weighted_class_vote[, 1] <- weighted_class_vote[, 1] + vote_0
  weighted_class_vote[, 2] <- weighted_class_vote[, 2] + vote_1
}

apply(weighted_class_vote, 1, sum)

weighted_class_vote_res <- sapply(1:nrow(weighted_class_vote), 
                                  function(j) ifelse(weighted_class_vote[j, 1] > weighted_class_vote[j, 2], 0, 
                                              ifelse(weighted_class_vote[j, 1] + weighted_class_vote[j, 2] == 0,
                                                     general_vote_res[j], 1)))

confusionMatrix(weighted_class_vote_res, test_y)$overall[1]

#0.685

##probability 투표 방법을 정하겠다.
#########################################################################################################
### 예측 데이터 전처리
test_set <- read.csv('test_nontarget.csv', header = TRUE)

test_set <- test_set[, c(-1, -2, -9, -10, -11, -12)]
test_set <- test_set[, -9]
str(test_set)

# NA 값 확인
sum(is.na(test_set))
# No NA

# 범주의 레벨 축소

color <- as.vector(test_set$color)
newcolor <- unname(sapply(color,color_change))

test_set$shelter <- sapply(1:nrow(test_set), function(j) shelter_change(test_set$shelter[j]) )
test_set$kind <- sapply(1:nrow(test_set), function(j) kind_change(test_set$kind[j]) )
test_set$color <- as.factor(newcolor)

levels(dat_x$color)  %in% levels(test_set$color)
levels(test_set$color) <- levels(dat_x$color)
levels(test_set$color)

# 데이터 팩터화  
test_set <- factorization(test_set)
str(test_set)
str(dat_x)
##########################################################################################################
### 최종예측

#### final model Recall
tech <- c('NB', 'DT', 'BAG', 'RF', 'KNN')
models <- paste(tech, '_model')

for(j in 1:length(tech)){
  model_name <- paste0(tech[j], '_final', ".rds") 
  model <- readRDS(model_name)
  assign(models[j], model)
}

levels(dat_x$color)  %in% levels(test_set$color)
levels(test_set$color) <- levels(dat_x$color)
levels(test_set$color)
#################################################

pred_raw <- sapply(1:length(models), function(j) predict(get(models[j]), test_set, type ='raw')) 
pred_prob <- lapply(1:length(models), function(j) predict(get(models[j]), test_set, type ='prob')) 

general_vote <- rep(0, nrow(test_set))

for(i in 1:length(models)) {
  general_vote <- general_vote + as.integer(pred_raw[, i])
}

general_vote_res <- ifelse(general_vote >= 3, 1, 0)

weighted_class_vote <- matrix(0, nrow(test_set), 2)
cutoff <- 0.7

for(i in 1:length(models)) {
  temp <- pred_prob[[i]]
  vote_0 <- sapply(1:nrow(temp), function(j) ifelse(temp[j, 1] > cutoff, 1, 0))
  vote_1 <- sapply(1:nrow(temp), function(j) ifelse(temp[j, 2] > cutoff, 1, 0))
  weighted_class_vote[, 1] <- weighted_class_vote[, 1] + vote_0
  weighted_class_vote[, 2] <- weighted_class_vote[, 2] + vote_1
}

apply(weighted_class_vote, 1, sum)

weighted_class_vote_res <- sapply(1:nrow(weighted_class_vote), 
                                  function(j) ifelse(weighted_class_vote[j, 1] > weighted_class_vote[j, 2], 0, 
                                                     ifelse(weighted_class_vote[j, 1] + weighted_class_vote[j, 2] == 0,
                                                            general_vote_res[j], 1)))
table(weighted_class_vote_res)

write.table(weighted_class_vote_res, file = 'prediction.csv', row.names = FALSE)
######################################################################################################

List of Articles
번호 제목 글쓴이 날짜 조회 수
공지 R 소스 공유 게시판 이용 관련 공지사항 1 DataMarket 2014.05.21 13222
92 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 김민정 민정e 2017.09.23 235
91 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 최서현 최서현 2017.09.22 203
90 투빅스 7&8기 7주차 과제 유기동물 과제 - 8기 조양규 dial123 2017.09.14 309
» 투빅스 7&8기 7주차 과제 유기동물입양예측 - 8기 김강열 김강열 2017.09.14 326
88 투빅스 7&8기 6주차 과제 word2vec - 8기 황다솔 다솔 2017.08.31 479
87 투빅스 7&8기 6주차 과제 TF-IDF 문서유사도 측정 - 8기 최서현 최서현 2017.08.31 367
86 투빅스 7&8기 5주차 과제 Selenium Crawling - 8기 김강열 김강열 2017.08.24 506
85 투빅스 7&8기 5주차 과제 Image Augmentation - 8기 김민정 김소희 최수정 황다솔 file 민정e 2017.08.24 458
84 투빅스 7&8기 5주차 과제 Beautiful Soup 이용한 Crawling - 8기 류호성 file 류호성 2017.08.24 456
83 투빅스 7&8기 4주차 과제 tree, RF, bagging, boosting 이용 분석 - 8기 조양규 file dial123 2017.08.17 510
82 투빅스 7&8기 4주차 과제 의사결정나무&랜덤포레스트 - 8기 김강열 김강열 2017.08.17 514
81 투빅스 7&8기 3주차 과제 클러스터링 구현 - 8기 권문정 김강열 이현경 조양규 1 이현경 2017.08.10 571
80 투빅스 7&8기 3주차 과제 PCA - 8기 이현경 file 이현경 2017.08.12 560
79 투빅스 7&8기 2주차 과제 연관성 분석 - 8기 조양규 file dial123 2017.08.03 571
78 투빅스 7&8기 2주차 과제 나이브베이즈 구현 - 8기 이현경 file 이현경 2017.08.03 531
77 투빅스 7&8기 2주차 과제 로지스틱/Ridge/Lasso&알고리즘 - 8기 김강열 file 김강열 2017.08.03 626
76 투빅스 7&8기 1주차 과제 알고리즘 - 8기 김강열 file 김강열 2017.07.27 672
75 투빅스 7&8기 1주차 과제 회귀분석 - 8기 황다솔 file 다솔 2017.07.27 820
74 투빅스 6&7기 8주차 과제 PCA(주성분 분석) - 7기 이동수 1 탱탱볼 2017.03.18 1679
73 투빅스 6&7기 8주차 과제 LBP 알고리즘 구현 - 7기 이광록 1 file 2017.03.16 1423
Board Pagination ‹ Prev 1 2 3 4 ... 5 Next ›
/ 5

나눔글꼴 설치 안내


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

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

설치 취소

Designed by sketchbooks.co.kr / sketchbook5 board skin

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5