“랜덤 포레스트를 활용한 VOD 수요예측”
WooJun Kang 영화진흥위에서 수집한 'VOD 월별 수요예측' 데이터 셋과 '박스오피스' 데이터 셋 그리고 웹 크롤링을 통해 변수를 추가했다. 이밖에도 네이버와 다음에서 크롤링한 변수들로 랜덤 포레스트 모델을 적합하고자 한다. 이를 바탕으로 VOD 수요예측 모델을 적합하고 어떠한 변수들이 중요하게 작용했는지 알아보고자 한다.
Load Library
library(tidyverse)
library(httr)
library(rvest)
library(corrplot)
library(randomForest)
library(urltools)
library(jsonlite)Import Data
vod <- read.csv(file = './VOD_data.csv',
header = TRUE,
stringsAsFactors = FALSE,
fileEncoding = 'CP949')
boxoffice <- read.csv(file = './Boxoffice.csv',
header = TRUE,
stringsAsFactors = FALSE,
fileEncoding = 'CP949') %>%
select(-감독)
DATA CLEANSING
1. VOD 이용횟수 (2015.01 ~ 2018.10)
영화진흥위원회에서 VOD 이용횟수가 해당 월 100위 안에 포함된 데이터를 다운받아 연도별로 취합했다. 영화가 월 별 상위 100위 안에 들지 못하면 집계가 안된다. 또한 데이터 마다 변수명이 달라 일괄적으로 합치지 못한다. 따라서 ‘FIMS코드’(영화고유식별번호)를 기준으로 다음달에 포함하지 않는 전월 영화를 다음달 데이터에 포함시키는 식으로 월별 데이터를 하나의 데이터 셋으로 구성했다.
str(vod)## 'data.frame': 1513 obs. of 54 variables:
## $ FIMS코드: int 20143985 20143981 20145382 20123421 20142023 20060319 20148728 20134122 20142843 20145083 ...
## $ 영화명 : chr "명기" "세인트 앤 솔저: 최강전차부대" "비르: 위대한 전사" "눈의 여왕" ...
## $ 제작연도: int 2014 2014 2010 2012 2014 2006 2013 2013 2014 2014 ...
## $ 제작국가: chr "한국" "미국" "인도" "러시아" ...
## $ 개봉일 : chr "20141230" "20141204" "20141230" "20130207" ...
## $ 감독 : chr "강현" "라이언 리틀" "아닐 샤르마" "막심 스베쉬니코브" ...
## $ 배우 : chr "김민영,이상훈,김민채,김민채,손영민" "아담 그레고리,바트 존슨" "살만 칸,소하일 칸" "박보영,이수근,최수민,장광" ...
## $ 등급 : chr "청소년관람불가" "15세이상관람가" "15세이상관람가" "전체관람가" ...
## $ X1501 : int 16976 16316 15769 13863 13863 13227 13084 12376 12297 12276 ...
## $ X1502 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1503 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1504 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1505 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1506 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1507 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1508 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1509 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1510 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1511 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1512 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1601 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1602 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1603 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1604 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1605 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1606 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1607 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1608 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1609 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1610 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1611 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1612 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1701 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1702 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1703 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1704 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1705 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1706 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1707 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1708 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1709 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1710 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1711 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1712 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1801 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1802 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1803 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1804 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1805 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1806 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1807 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1808 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1809 : int NA NA NA NA NA NA NA NA NA NA ...
## $ X1810 : int NA NA NA NA NA NA NA NA NA NA ...a) 영화배우
head(vod$배우)## [1] "김민영,이상훈,김민채,김민채,손영민"
## [2] "아담 그레고리,바트 존슨"
## [3] "살만 칸,소하일 칸"
## [4] "박보영,이수근,최수민,장광"
## [5] "카메론 디아즈,레슬리 만,케이트 업튼"
## [6] "벤 스틸러,로빈 윌리엄스"영화배우가 여러명 포함돼 있다. 크롤링할 때 영화명+주연배우로 검색할 것이기 때문에 가장 첫 번째 주연배우를 제외한 배우명을 제거한다.
vod$배우 <- str_remove_all(vod$배우, pattern = ',.*')b) 영화등급
table(vod$등급) %>% head(10)##
##
## 12
## 12세관람가
## 18
## 12세이상관람가
## 299
## 12세이상관람가,12세이상관람가
## 52
## 12세이상관람가,중학생이상관람가
## 1
## 15세 미만인 자는 관람할 수 없는 등급 ,15세이상관람가
## 2
## 15세관람가
## 13
## 15세관람가,15세이상관람가
## 2
## 15세이상관람가
## 487
## 15세이상관람가,15세이상관람가
## 11영화등급이 통일되지 않았다.
전체관람가
vod$등급[grep("전체", vod$등급)] <- "전체관람가"12세이상관람가
vod$등급[grep("12세", vod$등급)] <- "12세이상관람가"15세이상관람가
vod$등급[grep("15세", vod$등급)] <- "15세이상관람가"
vod$등급[grep("중학생", vod$등급)] <- "15세이상관람가"청소년관람불가
vod$등급[grep("청소년", vod$등급)] <- "청소년관람불가"
vod$등급[grep("연소자", vod$등급)] <- "청소년관람불가"
vod$등급[grep("고등학생", vod$등급)] <- "청소년관람불가"
vod$등급[grep("18", vod$등급)] <- "청소년관람불가"c) 제작국가
table(vod$제작국가) %>% head(10)##
## 노르웨이 대만
## 1 4
## 대만,홍콩 덴마크
## 1 1
## 덴마크,독일,프랑스,벨기에,영국 독일
## 1 6
## 독일,미국 독일,벨기에,룩셈부르크,아일랜드
## 2 1
## 독일,스위스 러시아
## 1 12제작국가의 경우, 국내제작 영화와 해외제작 영화로 구분했다.
vod$제작국가 <- ifelse(vod$제작국가 == '한국', '국내', '해외')d) 필요없는 열 제거
vod <- vod %>% select(-c(FIMS코드, 제작연도))e) 출시 이후 6개월 치 데이터 추출
정확한 VOD 출시일을 알 수 없어, 첫 집계된 달을 VOD 출시된 달로 가정했다. 15년도 1월 VOD 이용횟수가 집계된 경우는 15년도 1월에 VOD가 출시된 것인지, 14년도에 출시됐는데 집계된 것인지 확인할 수 없어 제거했다.
vod <- vod[is.na(vod$X1501), ]첫 집계된 달로부터 6개월간의 VOD 구매횟수를 목표변수로 선정했다.
result <- data.frame()
for(i in 1:nrow(vod)){
# print(i)
tmp_row <- vod[i, 7:52]
na_num <- sum(is.na(tmp_row))
if( na_num == 45 ){
output <- c(NA, NA, NA, NA, NA, NA)
} else {
na_idx <- which(!is.na(tmp_row))[1]
na_idx <- min(na_idx, 40)
output <- tmp_row[na_idx:(na_idx + 5)]
names(output) <- c("1", "2", "3", "4", "5", "6")
}
result <- rbind(result, output)
names(result) <- c("1",'2','3','4','5','6')
}
vod <- cbind(vod, result) %>% select(-contains('X'))표본집단이 적어 출시달로 부터 6개월간의 월별 구매횟수를 불러와 결측치가 하나 미만의 데이터만을 목표변수로 최종 선정했다.
result <- data.frame()
for (i in 1:nrow(vod)) {
# print(i)
tmp_row <- vod[i, 7:12]
na_count <- sum(is.na(tmp_row))
result <- rbind(result, na_count)
}
colnames(result) <- 'NA_count'
vod <- cbind(vod, result)
vod <- vod[vod$NA_count <= 1, ]
vod <- vod %>% select(-c(NA_count))f) 결측치 처리
6개월의 VOD 구매횟수 중 결측치가 두번째 달에서 다섯번째 달 사이에 존재하면 이전 달과 이후 달의 평균으로 대체하고, 첫째 달과 마지막 달에 결측치가 존재하면 바로 이후 달과 이전 달의 값으로 대체했다.
result <- data.frame()
for(i in 1:nrow(vod)){
# print(i)
tmp_row <- vod[i, 7:12]
num_na <- sum(is.na(tmp_row))
na_idx <- which(is.na(tmp_row))
if (num_na == 0) {
tmp_row <- tmp_row
}else if (na_idx > 1 & na_idx < 6) {
A <- tmp_row[na_idx-1]
B <- tmp_row[na_idx+1]
tmp_row[na_idx] <- (A + B) / 2
}else if(na_idx == 1){
tmp_row[na_idx] <- tmp_row[na_idx + 1]
}else {
tmp_row[na_idx] <- tmp_row[na_idx - 1]
}
result <- rbind(result, tmp_row)
}
vod$sum_vod <- apply(result, MARGIN = 1, FUN = sum)
vod <- vod %>% select(-c('1', '2', '3', '4', '5', '6'))
2. 동일 기간 박스오피스 데이터 셋
전국 스크린 수, 전국 관객 수, 장르를 영화명 기준으로 조인했다.
str(boxoffice)## 'data.frame': 9951 obs. of 4 variables:
## $ 영화명 : chr "명량" "신과함께-죄와 벌" "국제시장" "베테랑" ...
## $ 전국스크린수: chr "1,587 " "1,912 " "966 " "1,064 " ...
## $ 전국관객수 : chr "17,613,682 " "14,410,754 " "14,245,998 " "13,395,400 " ...
## $ 장르 : chr "사극" "판타지" "드라마" "액션" ...DB <- left_join(vod, boxoffice, by = c('영화명'))
3. 웹 크롤링
개봉일을 기준으로 영화명과 영화배우를 검색했을 때 개봉 전 30일과 개봉 후 30일 동안의 네이버 블로그 포스팅 수, 다음 뉴스 기사 수를 크롤링 했다.
a) 네이버 블로그 포스팅 수 크롤링
다음 블로그 포스팅 수도 크롤링을 했으나, 다음 포털에서도 네이버 블로그가 검색돼 수치가 네이버 블로그 포스팅 수와 매우 유사했다. 따라서 다음 블로그 포스팅 수는 변수로 사용하지 않았다.
keywords <- str_c(DB$영화명, DB$배우, sep = " ")
ref <- 'https://section.blog.naver.com/Search/Post.nhn?pageNo=1&rangeType=PERIOD&orderBy=sim&startDate=2016-04-12&endDate=2018-06-21&keyword=%EB%8F%85%EC%A0%84%20%EC%A1%B0%EC%A7%84%EC%9B%85'
naver_blog_30bf_count <- data.frame()
for (i in 1:nrow(DB)) {
# cat(i, '번째 실행중입니다..\n')
res <- GET(url = 'https://section.blog.naver.com/ajax/SearchList.nhn',
query = list(countPerPage = '7',
currentPage = '1',
endDate = DB$개봉일[i],
keyword = keywords[i] %>% url_encode() %>% toupper() %>% I(),
orderBy = 'sim',
startDate = DB$before_30days[i],
type = 'post'),
add_headers(referer = ref))
json <- res %>%
as.character() %>%
str_remove(pattern = "\\)\\]\\}\\',") %>%
fromJSON()
temp_count <- json$result$totalCount
naver_blog_30bf_count <- rbind(naver_blog_30bf_count, temp_count, stringsAsFactors = FALSE)
Sys.sleep(time = 0.5)
}
names(naver_blog_30bf_count) <- 'naver_blog_30bf_count'
DB <- cbind(DB, naver_blog_30bf_count)위와 같은 방법으로 개봉일 기준 30일 이후 블로그 포스팅 건수와 네이버 네티즌 평점, 네티즌 평점 참여수, 전문가 평점, 전문가 평점 참여수를 크롤링 했다.
b) 다음 뉴스 기사 수 크롤링
다음의 경우 날짜 형식을 ’20190101000000’와 같은 형식으로 바꿔주어야 했다.
bf30_date_for_daum <- DB$before_30days %>% str_remove_all(pattern = "-")
af30_date_for_daum <- DB$after_30days %>% str_remove_all(pattern = "-")
rel_date_for_daum <- DB$개봉일 %>% str_remove_all(pattern = "-")
daum_blog_30bf_count <- data.frame()
for (i in 1:nrow(DB)) {
# cat(i, '번째 실행 중입니다..\n')
res <- GET(url = 'https://search.daum.net/search',
query = list(DA = 'STC',
ed = str_c(rel_date_for_daum[i], '235959'),
https_on = 'on',
lpp = '10',
nil_suggest = 'btn',
period = 'u',
q = keywords[i] %>%
url_encode() %>%
I(),
sd = str_c(bf30_date_for_daum[i], '000000'),
w = 'blog') )
temp <- res %>% read_html() %>%
html_node(css = '#blogColl > div.coll_tit > div.sub_expander > span') %>%
html_text() %>%
str_split(pattern = ' / ', simplify = TRUE)
temp <- temp[2]
daum_blog_30bf_count <- rbind(daum_blog_30bf_count, temp, stringsAsFactors = FALSE)
Sys.sleep(time = 0.5)
}
names(daum_blog_30bf_count) <- 'daum_blog_30bf_count'
daum_blog_30bf_count[which(is.na(daum_blog_30bf_count)), ] <- 0
daum_blog_30bf_count <- daum_blog_30bf_count[ ,1] %>%
str_remove(pattern = '건') %>%
str_remove(pattern = '약 ') %>%
str_remove(pattern = ',')
DB <- cbind(DB, daum_blog_30bf_count)
EDA
str(DB)## 'data.frame': 318 obs. of 15 variables:
## $ 영화명 : chr "워킹걸" "마담 뺑덕" "엑소더스: 신들과 왕들" "퓨리" ...
## $ 제작국가 : chr "국내" "국내" "해외" "해외" ...
## $ 등급 : chr "청소년관람불가" "청소년관람불가" "12세이상관람가" "15세이상관람가" ...
## $ sum_vod : int 221002 65858 284750 250251 97971 275186 160250 169365 340111 119338 ...
## $ naver_blog_30bf_count: int 378 800 215 538 375 644 133 531 378 618 ...
## $ naver_blog_30af_count: int 598 1389 1221 2097 1195 1496 585 799 6691 2177 ...
## $ 전국스크린수 : int 308 536 865 590 500 466 615 321 206 890 ...
## $ 전국관객수 : int 149181 465749 1511145 1362114 1101678 790158 1661388 116119 4801355 4001813 ...
## $ 장르 : chr "코미디" "멜로/로맨스" "드라마" "액션" ...
## $ netizen : num 6.98 6.55 7.01 8.55 8.17 7.79 8.67 8.73 9.16 7.76 ...
## $ netizenNumber : int 209 558 1071 1332 1033 1199 3072 64 8268 4846 ...
## $ reporter : num 3.75 5.88 6.96 6.5 5.67 5.21 6.33 7 6 6.11 ...
## $ reporterNumber : int 4 6 6 2 3 7 5 5 1 11 ...
## $ daum_news_30bf_count : int 5110 3360 212 2100 118 4730 159 1670 247 4440 ...
## $ daum_news_30af_count : int 1240 1110 811 1150 339 1020 512 115 2080 1940 ...해외영화 181개, 국내영화 137개로 해외영화가 VOD콘텐츠 더 많이 활용됐다.
par(family = 'NanumGothic')
barplot(sort(table(DB$제작국가) , decreasing = TRUE),
col = c("skyblue", "pink"),
main = "국내/해외 영화 개수",
ylab = "개수",
ylim = c(0, 200))
vod 이용횟수가 500000이상 인 영화 중 국내에서 제작된 영화는 31개, 해외에서 제작된 영화는 9개로 국내 제작 영화가 많았으며, 제작국가별 평군 vod 이용횟수 역시 국내 제작 영화가 해외 제작 영화에 비해 140000 정도 높았다. vod 시장에서는 해외 제작 영화보다 국내 제작 영화가 인기가 더 좋았다.
DB %>% filter(sum_vod > 500000) %>% select(제작국가) %>% table()## .
## 국내 해외
## 31 9by(DB$sum_vod, DB$제작국가, mean, na.rm = T) %>% sort(decreasing = TRUE)## DB$제작국가
## 국내 해외
## 341666.1 203932.9영화 장르를 살펴보면, 액션영화가 83개로 가장 많았다.
par(family = 'NanumGothic')
barplot(sort(table(DB$장르) , decreasing = TRUE),
col = c("skyblue", "pink"),
main = "국내/해외 영화 개수",
ylab = "개수",
ylim = c(0, 200))
vod 구매횟수가 500000 이상인 것 중 액션 영화가 14개로 가장 많았다. 장르별 vod 평균 구매횟수는 범죄가 약 387000회로 가장 많았다. vod 시장에서는 다른 장르에 비해 범죄와 액션 장르의 영화가 강세를 보이고 있다.
DB %>% filter(sum_vod > 500000) %>%
select(장르) %>%
table() %>%
sort(decreasing = TRUE)## .
## 액션 드라마 범죄 애니메이션 사극 코미디
## 14 8 8 3 2 2
## 미스터리 스릴러 판타지
## 1 1 1by(DB$sum_vod, DB$장르, mean, na.rm = T) %>% sort(decreasing = TRUE)## DB$장르
## 범죄 판타지 다큐멘터리 미스터리 액션 사극
## 387065.6 386540.8 357584.5 327556.2 311349.0 304734.4
## 코미디 드라마 SF 스릴러 공포(호러) 어드벤처
## 296291.9 258448.4 212547.5 204652.8 188994.0 184185.8
## 애니메이션 멜로/로맨스 전쟁
## 172558.4 117033.0 71874.0상관계수그래프
par(family = 'NanumGothic')
DB %>%
select(sum_vod, naver_blog_30bf_count, naver_blog_30af_count, 전국스크린수, 전국관객수, netizen, netizenNumber, reporter, reporterNumber, daum_news_30bf_count, daum_news_30af_count) %>%
cor() %>%
corrplot(method = 'color') %>%
corrplot.mixed(lower = 'number', upper = "circle")
상관계수를 통해 알아본 결과 네이버 블로그와 다음 뉴스 기사 건수 모두 개봉전 30일보다 개봉 후 30일이 vod 시청 횟수에 영향을 많이 미치고 있다.
Modeling
랜덤 포레스트 모델 적합을 위해 캐릭터 변수를 팩터로 만들었다.
DB <- DB %>% mutate(제작국가 = as.factor(DB$제작국가),
등급 = as.factor(DB$등급),
장르 = as.factor(DB$장르))전체 데이터셋의 70%를 훈련용, 30%를 시험용 데이터로 분리한다. 같은 결과를 얻기 위해 seed를 고정해 준다.
set.seed(seed = 0)
index <- sample(x = 1:2,
size = nrow(DB),
prob = c(0.7, 0.3),
replace = TRUE)index가 1일 때 train, 2일 때 test에 할당한다.
train <- DB[index == 1, ] %>% select(-c('영화명'))
test <- DB[index == 2, ] %>% select(-c('영화명'))훈련용, 시험용 데이터셋의 목표변수 평균을 확인한다.
train$sum_vod %>% mean()## [1] 268636.3test$sum_vod %>% mean()## [1] 249247.5그리드 탐색을 위해 나무의 수와 입력변수의 수를 설정해 준다.
grid <- expand.grid(ntree = c(500, 1000, 1500, 2000),
mtry = c(3, 4, 5, 6, 7))
print(grid)## ntree mtry
## 1 500 3
## 2 1000 3
## 3 1500 3
## 4 2000 3
## 5 500 4
## 6 1000 4
## 7 1500 4
## 8 2000 4
## 9 500 5
## 10 1000 5
## 11 1500 5
## 12 2000 5
## 13 500 6
## 14 1000 6
## 15 1500 6
## 16 2000 6
## 17 500 7
## 18 1000 7
## 19 1500 7
## 20 2000 7나무의 수 4종과 입력변수 5종으로 설정했으므로 총 20개의 조합이 생성된다. 그리드 탐색을 하며 최적의 모형을 탐색한다.
tuned <- data.frame()
for(i in 1:nrow(grid)){
set.seed(seed = 0)
# cat('\n', i, '행 실행중...[ mtree:', grid[i, 'ntree'], ', mtry:', grid[i, 'mtry'], ']\n\n')
fit <- randomForest(x = train %>% select(-sum_vod),
y = train$sum_vod,
xtest = test %>% select(-sum_vod),
ytest = test$sum_vod,
ntree = grid[i, 'ntree'],
mtry = grid[i, 'mtry'],
importance = TRUE,
keep.forest = TRUE)
MSEs <- fit$mse
avgMSE <- mean(MSEs)
df <- data.frame(index = i, averageMSE = avgMSE)
tuned <- rbind(tuned, df)
}튜닝 결과 출력
print(cbind(grid, tuned))## ntree mtry index averageMSE
## 1 500 3 1 34387031025
## 2 1000 3 2 33896717186
## 3 1500 3 3 33763466276
## 4 2000 3 4 33676361444
## 5 500 4 5 33899682587
## 6 1000 4 6 33835417380
## 7 1500 4 7 33841399018
## 8 2000 4 8 33831119179
## 9 500 5 9 33931100401
## 10 1000 5 10 33885037815
## 11 1500 5 11 33925380007
## 12 2000 5 12 33980081575
## 13 500 6 13 36007472276
## 14 1000 6 14 35166425202
## 15 1500 6 15 34849477445
## 16 2000 6 16 34723830643
## 17 500 7 17 34221611627
## 18 1000 7 18 34468031634
## 19 1500 7 19 34511700378
## 20 2000 7 20 34503642388튜닝 결과 그래프
plot(tuned, xlab = '', ylab = 'Average of MSE')
abline(h = min(tuned$averageMSE), col = 'red', lty = 2)
# MSE 최소값 수평선 추가MSE가 최소값인 행번호
loc <- (tuned$averageMSE == min(x = tuned$averageMSE)) %>% which()
print(loc)## [1] 4best_para <- grid[loc,]
cat('MSE가 최소값이 하이퍼 파라미터는 ntree가 ', print(best_para$ntree), '이고, mtry가 ', print(best_para$mtry), '일때 이다.')## [1] 2000
## [1] 3
## MSE가 최소값이 하이퍼 파라미터는 ntree가 2000 이고, mtry가 3 일때 이다.베스트 모형 적합
best_model <- randomForest(x = train %>% select(-sum_vod),
y = train$sum_vod,
xtest = test %>% select(-sum_vod),
ytest = test$sum_vod,
ntree = best_para$ntree,
mtry = best_para$mtry,
importance = TRUE,
keep.forest = TRUE)
plot(best_model)
변수 중요도 테이블 & 그래프
par(family = 'NanumGothic')
importance(best_model)## %IncMSE IncNodePurity
## 제작국가 7.508025 1.503730e+11
## 등급 1.953072 3.207357e+11
## naver_blog_30bf_count 8.667474 6.044054e+11
## naver_blog_30af_count 7.892899 1.031374e+12
## 전국스크린수 17.353586 1.769088e+12
## 전국관객수 23.040744 1.972995e+12
## 장르 4.632952 9.160813e+11
## netizen 2.335482 5.494951e+11
## netizenNumber 12.829681 1.676867e+12
## reporter 7.790111 4.105648e+11
## reporterNumber 11.998499 6.005577e+11
## daum_news_30bf_count 9.434215 6.353176e+11
## daum_news_30af_count 13.344130 1.305170e+12varImpPlot(x = best_model, main = 'Random Forest Reg-Model with VOD Demend')
모형 성능 평가
source(file = '../machinelearning/Errors_fun.R')
# 성능평가를 위한 사용자 함수 불러오기train_pred <- best_model$predicted
train_real <- train$sum_vodgetErrors(real = train_real, pred = train_pred)## MSE RMSE MAE MAPE
## 1 33332948729 182573.1 112116.1 0.7592932mean(DB$sum_vod)## [1] 263270.8타겟변수인 vod의 수요가 평균 260000인데 비해 그리드 탐색을 통한 베스트 모델의 RMSE는 약 180000이다.