여러 모델에서 선택
우리가 스스로 물어 보는 질문중 하나는 pickup_dow와 pickup_hour 사이의 상호 작용이 예측 결과에 얼마나 영향을 미치는가 입니다. pickup_nb와 dropoff_nb 사이의 상호 작용 내용만 유지하고 두 번째 상호 작용을 삭제하면 예상치는 얼마나 떨어질까요? 이를 알아보기 위해 우리는 pickup_nb:dropoff_nb만 포함하는 rxLinMod를 사용하여 보다 단순화 된 모델을 만들 수 있습니다. 만들어진 단순 모델로 만들어진 새로운 예측 결과를 cbind를 사용하여 보다 복잡한 모델로 작성한 기존 예측 데이터에 추가합니다.
form_2 <- as.formula(tip_percent ~ pickup_nb:dropoff_nb)
rxlm_2 <- rxLinMod(form_2, data = mht_xdf, dropFirst = TRUE, covCoef = TRUE)
pred_df_2 <- rxPredict(rxlm_2, data = pred_df_1, computeStdErrors = TRUE, writeModelVars = TRUE)
names(pred_df_2)[1:2] <- paste(c('tip_pred', 'tip_stderr'), 2, sep = "_")
pred_df <- pred_df_2 %>%
select(starts_with('tip_')) %>%
cbind(pred_df_1) %>%
arrange(pickup_nb, dropoff_nb, pickup_dow, pickup_hour) %>%
select(pickup_dow, pickup_hour, pickup_nb, dropoff_nb, starts_with('tip_pred_'))
head(pred_df)
pickup_dow pickup_hour pickup_nb dropoff_nb tip_pred_2 tip_pred_1
1 Sun 1AM-5AM Chinatown Chinatown 6.782043 6.796323
2 Sun 5AM-9AM Chinatown Chinatown 6.782043 5.880284
3 Sun 9AM-12PM Chinatown Chinatown 6.782043 6.103625
4 Sun 12PM-4PM Chinatown Chinatown 6.782043 5.913130
5 Sun 4PM-6PM Chinatown Chinatown 6.782043 6.121957
6 Sun 6PM-10PM Chinatown Chinatown 6.782043 6.642192
위의 결과를 통해 단순 모델의 예측 결과값은 탑승 지역과 하차 지역이 같은 조합의 모든 요일과 모든 시간에서 동일하다는 것을 알 수 있습니다. 반면에 기존의 보다 복잡한 모델에 의한 예측 결과값은 4가지 변수의 모든 조합에 대해 고유하게 나타납니다. 즉, pickup_dow:pickup_hour를 모델에 추가하면 예측 결과에 추가적인 변형값이 반영됩니다. 우리는 이 변형값에 중요한 신호가 포함되어 있는지 또는 이것이 어느 정도의 노이즈 값인 경우인지를 알고 싶습니다. 이에 대한 답을 얻기 위해, pickup_dow와 pickup_hour로 나누어서 두 예측의 분포를 비교합니다.
ggplot(data = pred_df) +
geom_density(aes(x = tip_pred_1, col = "complex")) +
geom_density(aes(x = tip_pred_2, col = "simple")) +
facet_grid(pickup_hour ~ pickup_dow)
단순화 된 모델에 사용된 두 변수는 예측 결과값에 아무런 영향을 미치지 않기 때문에, 단순 모델은 전체적으로 동일한 분포를 보여 주지만, 더 복잡한 모델은 pickup_dow 및 pickup_hour의 각 조합에 대해, 일반적으로 분포가 조금 이동한 패턴으로, 약간 다른 분포를 보여줍니다 . 이러한 이동은 두 변수의 각 주어진 조합에서 pickup_dow 및 pickup_hour의 영향도를 나타냅니다. 이러한 이동은 방향성이 있기 때문에(우연이 아님) 중요한 신호(실제적인 중요성은 여전히 논쟁의 여지가 있지만)라고 단정하여도 이상이 없을 것입니다 . 만약 어떤 비즈니스 로직이 적용된다면, 단순화 된 내용을 선택할 수도 있습니다.
팁 예측값을 구간으로 나누어 봅시다. 구간값 선택에 참고하기 위해서, rxQuantile 함수를 사용할 수 있습니다.
rxQuantile("tip_percent", data = mht_xdf, probs = seq(0, 1, by = .05))
0% 5% 10% 15% 20% 25% 30% 35% 40% 45% 50% 55% 60% 65% 70% 75% 80%
-1 0 0 0 0 0 0 0 9 12 15 17 17 17 18 18 19
85% 90% 95% 100%
20 21 23 99
위의 결과를 근거로 하여, 8% 미만, 8%~12%, 12%~15%, 15%~18%, 18% 이상인지 여부에 따라 tip_percent를 구분할 수 있습니다. 동일한 정보를 보여주는 막대 그래프를 그릴 수도 있으며, 이럴 경우 해석하기가 조금 더 쉽습니다.
pred_df %>%
mutate_at(vars(tip_pred_1, tip_pred_2), funs(cut(., c(-Inf, 8, 12, 15, 18, Inf)))) %>%
ggplot() +
geom_bar(aes(x = tip_pred_1, fill = "complex", alpha = .5)) +
geom_bar(aes(x = tip_pred_2, fill = "simple", alpha = .5)) +
facet_grid(pickup_hour ~ pickup_dow) +
xlab('tip percent prediction') +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
위의 그래프를 보면, 단순화 모델과 비교할 때 복잡한 모델은 특정 요일 및 시간 조합(예:월요일부터 목요일까지러시아워 시간대)에 더 높은 팁을 지불하는 승객과 평균보다 낮은 승객수를 예측하는 경향이 있음을 알 수 있습니다.
예측 결과 점검
이제 모든 조합에 대한 예측 평균값을 플로팅하여 모델의 예측 결과를 시각화 할 수 있습니다.
ggplot(pred_df_1, aes(x = pickup_nb, y = dropoff_nb)) +
geom_tile(aes(fill = tip_pred_1), colour = "white") +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
scale_fill_gradient(low = "white", high = "red") +
coord_fixed(ratio = .9)
ggplot(pred_df_1, aes(x = pickup_dow, y = pickup_hour)) +
geom_tile(aes(fill = tip_pred_1), colour = "white") +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
scale_fill_gradient(low = "white", high = "red") +
coord_fixed(ratio = .9)
팁 비율을 예측하는 선형 모델(linear model)
하나는 pickup_nb와 dropoff_nb, 또 하나의 pickup_dow와 pickup_hour 사이에 상호작용 조건들를 포함하는 선형 모델을 만들어 보겠습니다. 여기에서 우리는 팁의 비율이 단순히 승객들이 어느 지역에서 승차했는지(pickup_nb), 어느 지역에서 하차 하였는지(dropoff_nb)가 아니라 승차와 하차의 쌍으로 부터 영향을 받는다는 것에 착안하였습니다. 또한 요일과 시간이 함께 팁에 영향을 미친다는 것을 추정 하였습니다. 예를 들어 일요일 9시 부터 12시 까지 사람들이 팁을 많이 준다는 것이, 모든 요일의 9시에서 12시 사이에는 높은 팁을 준다 또는 일요일이라면 언제라도 높은 팁을 준다 라는 것을 의미하지는 않습니다. 이러한 직관은 다음과 같이 rxLinMod 함수에 넘겨주는 모델 수식 인수로 인코딩됩니다.
tip_percent ~ pickup_nb : dropoff_nb + pickup_dow : pickup_hour
여기서 우리는 :을 사용하여 상호 작용 부분을 식별하고, +를 사용하여 추가 부분를 구분합니다.
form_1 <- as.formula(tip_percent ~ pickup_nb:dropoff_nb + pickup_dow:pickup_hour)
rxlm_1 <- rxLinMod(form_1, data = mht_xdf, dropFirst = TRUE, covCoef = TRUE)
모델 계수들(model coefficients)을 개별적으로 검사하는 것은 항목이 매우 많기 때문에 어려운 작업입니다. 또한 큰 데이터 세트를 사용하여 작업하는 경우, 표본의 크기가 크기 때문에, 실제로 큰 의미를 갖지 않지만 통계적으로 유의미한 것으로 나타나는 계수들이 많습니다. 따라서 여기에서는 우리의 예측이 어떻게 나타나는지를 살펴보기만 하겠습니다. 먼저 각각 변수들을 factor level의 list로 추출하여 expand.grid로 전달하여, 모든 가능한 factor level의 조합으로 데이터 집합을 만듭니다. 그런 다음 rxPredict를 사용하는 위 모델을 적용하여 tip_percent를 예측합니다.
rxs <- rxSummary( ~ pickup_nb + dropoff_nb + pickup_hour + pickup_dow, mht_xdf)
ll <- lapply(rxs$categorical, function(x) x[ , 1])
names(ll) <- c('pickup_nb', 'dropoff_nb', 'pickup_hour', 'pickup_dow')
pred_df_1 <- expand.grid(ll)
pred_df_1 <- rxPredict(rxlm_1, data = pred_df_1, computeStdErrors = TRUE, writeModelVars = TRUE)
names(pred_df_1)[1:2] <- paste(c('tip_pred', 'tip_stderr'), 1, sep = "_")
head(pred_df_1, 10)
tip_pred_1 tip_stderr_1 pickup_nb dropoff_nb pickup_dow pickup_hour
1 6.796323 0.16432197 Chinatown Chinatown Sun 1AM-5AM
2 10.741766 0.15853956 Little Italy Chinatown Sun 1AM-5AM
3 9.150114 0.09162002 Tribeca Chinatown Sun 1AM-5AM
4 10.174307 0.09819651 Soho Chinatown Sun 1AM-5AM
5 9.706202 0.07365164 Lower East Side Chinatown Sun 1AM-5AM
6 8.475197 0.06354026 Financial District Chinatown Sun 1AM-5AM
7 10.866035 0.07150005 Greenwich Village Chinatown Sun 1AM-5AM
8 10.997276 0.06831955 East Village Chinatown Sun 1AM-5AM
9 9.313165 0.12507373 Battery Park Chinatown Sun 1AM-5AM
10 10.613802 0.11624956 West Village Chinatown Sun 1AM-5AM
모델링 예제
주어진 행동을 모델링하는 것은 매우 복잡한 작업이 될 수 있습니다. 데이터 자체와 비즈니스 요구 사항에 따라 모델에 대한 우리의 선택이 달라지기 때문입니다. 일부 모델은 예측력이 높지만 해석하기가 쉽지 않으며 다른 모델은 반대의 경우가 될 수 있습니다. 또한, 모델을 작성하는 프로세스는, 반복적으로 수행하여 개선하는 방식 보다는, 많은 모델 중에서 선택하는 것과 같은 몇몇 단계와 관련될 수 있기 때문에, 우리는 결정된 모델에 대한 조정 작업을 수행할 수 있습니다.
다음 연습은 RevoScaleR이 제공하는 여러 가지 분석 함수들을 사용하여 고객이 여행에 대해 지급하는 팁의 금액을 예측하는 모델을 만드는 것으로 구성됩니다. 승차 및 하차 지역, 여행 날짜와 시간을 팁 금액에 가장 영향을 주는 변수로 사용합니다.
학습 목표
이 장을 마치게 되면 다음에 대하여 더 잘 이해하게 될 것입니다
- - RevoScaleR을 사용하여 모델을 작성하는 방법
- - 다양한 모델 간의 장단점을 이해
- - 시각화를 사용하여 특정 모델 중에서 결과를 선택하는 프로세스에 대한 가이드
- - (예측을 실행을 통하여) 데이터 셋에 대한 방금 만든 모델을 스코어링하는 방법
이 장은 모델을 실행하고 선택하는 데 꼭 필요한 전반적인 안내서는 아닙니다. 대신에 코드 구현을 예제로 통하여, 최종 목표로 향하기 위한 출발점을 제공합니다.
클러스터 만들기
앞의 그림이 너무 복잡해 보이면, 그 대안으로 k-means 클러스터링을 사용하여 위도와 경도를 기반으로 데이터를 클러스터링 할 수 있습니다. 이 때, 클러스터들에 대하여 동일한 영향이 미치도록 척도(scale)를 조정해야합니다(척도를 재조정하는 간단한 방법은 경도는 -74로, 위도는 40으로 나누는 것입니다). 클러스터가 만들어 지면, 각 클러스터를 구성하는 개별 데이터 포인트 대신에 지도에서 클러스터 중심을 지정하여 표시할 수 있습니다.
xydata <- transmute(mht_sample_df, long_std = dropoff_longitude / -74, lat_std = dropoff_latitude / 40)
start_time <- Sys.time()
rxkm_sample <- kmeans(xydata, centers = 300, iter.max = 2000, nstart = 50)
Sys.time() - start_time
# 중심 좌표에 대해 다시 원래 척도를 적용하여야 합니다.
centroids_sample <- rxkm_sample$centers %>%
as.data.frame %>%
transmute(long = long_std*(-74), lat = lat_std*40, size = rxkm_sample$size)
head(centroids_sample)
Time difference of 2.017159 mins
long lat size
1 -74.01542 40.71149 277
2 -74.00814 40.71107 443
3 -73.99687 40.72133 335
4 -74.00465 40.75183 475
5 -73.96324 40.77466 589
6 -73.98444 40.73826 424
위의 코드 에서는 kmeans 함수를 사용하여 샘플 데이터 세트 mht_sample_df에 대하여 클러스터를 생성 하였습니다. RevoScaleR에는 kmeans 함수에 해당하는 rxKmeans 함수가 있으며, rxKmeans은 data.frame은 물론 XDF 파일에 대해서도 작동합니다. 따라서 rxKmeans를 사용하여 mht_sample_df로 표시된 샘플대신 전체 데이터에 대하여 클러스터를 만들 수 있습니다.
start_time <- Sys.time()
rxkm <- rxKmeans( ~ long_std + lat_std, data = mht_xdf, outFile = mht_xdf,
outColName = "dropoff_cluster", centers = rxkm_sample$centers,
transforms = list(long_std = dropoff_longitude / -74, lat_std = dropoff_latitude / 40),
blocksPerRead = 1, overwrite = TRUE, # need to set this when writing to same file
maxIterations = 100, reportProgress = -1)
Sys.time() - start_time
clsdf <- cbind(
transmute(as.data.frame(rxkm$centers), long = long_std*(-74), lat = lat_std*40),
size = rxkm$size, withinss = rxkm$withinss)
head(clsdf)
Time difference of 2.529844 hours
long lat size withinss
1 -73.96431 40.80540 301784 0.00059328668
2 -73.99275 40.73042 171080 0.00007597645
3 -73.98032 40.76031 198077 0.00005138354
4 -73.98828 40.77187 134539 0.00011077493
5 -73.96651 40.75752 133927 0.00004789548
6 -73.98446 40.74836 186906 0.00005435595
지도 보기
ggmap 패키지를 사용하여 샘플 데이터를 시각적으로 검토해 볼 수 있습니다. 살펴보려는 부분을 충분히 확대하면, 승객이 자주 내리는 경향이 있는 특정한 지역을 볼 수 있습니다.
library(ggmap)
map_13 <- get_map(location = c(lon = -73.98, lat = 40.76), zoom = 13)
map_14 <- get_map(location = c(lon = -73.98, lat = 40.76), zoom = 14)
map_15 <- get_map(location = c(lon = -73.98, lat = 40.76), zoom = 15)
q1 <- ggmap(map_14) +
geom_point(aes(x = dropoff_longitude, y = dropoff_latitude),
data = mht_sample_df, alpha = 0.15, na.rm = TRUE, col = "red", size = .5) +
theme_nothing(legend = TRUE)
q2 <- ggmap(map_15) +
geom_point(aes(x = dropoff_longitude, y = dropoff_latitude),
data = mht_sample_df, alpha = 0.15, na.rm = TRUE, col = "red", size = .5) +
theme_nothing(legend = TRUE)
require(gridExtra)
grid.arrange(q1, q2, ncol = 2)
클러스터링 예제
k-means 알고리즘의 병렬 구현인 rxKmeans를 시작으로, 이제 부터 RevoScaleR의 분석 알고리즘을 다소간 살펴 보겠습니다. kmeans 함수와 다르게, rxKmeans는 XDF 파일, 플랫 파일, HDFS 또는 SQL Server에 저장된 데이터에 대하여 실행할 수 있습니다.
앞으로 살펴 보겠지만, 대규모 데이터 세트에 대하여 작업할 때, 알고리즘의 튜닝은 성능에 큰 영향을 줄 수 있습니다.
앞의 숫자들을 사용하여 plot으로 한꺼번에 쉽게 내용을 정리하여 표시할 수 있습니다. 이제 두 지역의 쌍들에 대하여 택시 운행이 어떻게 분포되어 있는지를 보여주는 plot차트를 그려보겠습니다.
ggplot(rxcs, aes(pickup_nb, dropoff_nb)) +
geom_tile(aes(fill = pct_all), colour = "white") +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
scale_fill_gradient(low = "white", high = "black") +
coord_fixed(ratio = .9)
plot 챠트는 Upper East Side를 오고 가는 운행이 대다수를 차지한다는 것을 보여 주는데, 이는 다소 의외의 결과입니다. 더하여, 가장 많은 운행은 Upper East Side, Upper West Side, Midtown 지역 (이 카테고리의 대부분은 미드 타운을 출발지 또는 목적지로 갖음)으로 왕복하는 것입니다. 위의 plot이 거의 대칭으로 나타나는 것도 다른 놀라운 사실입니다. 아마도 대부분의 승객은 택시를 "왕복"을 위해 타며, 목적지로 가기 위해 택시를 탄 이후에 돌아오기 위해 다른 택시를 이용한 것이 아닐까 가정해 봅니다. 이 점은 (아마도 분석에 시간을 포함시킴으로써) 추가적인 조사가 필요하지면, 여기에서는 이 부분을 다루지 않겠습니다.
다음으로 우리는 특정 지역(아래 그림에서 x 축의 한 지점)에서 출발하는 운행이, 다른 지역으로 어떻게 흩어지는지를 살펴 보겠습니다(x 축의 각 점에서 y 축을 따라 수직 기준의 색 그라데이션으로 표시됨).
ggplot(rxcs, aes(pickup_nb, dropoff_nb)) +
geom_tile(aes(fill = pct_by_pickup_nb), colour = "white") +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
scale_fill_gradient(low = "white", high = "steelblue") +
coord_fixed(ratio = .9)
우리는 대부분의 도심(downtown)에서 시작된 운행이 어떻게 다른 시내(downtown) 지역이나 미드 타운(midtown)지역(특히 Midrown)으로 이루어지고 있는지를 볼 수 있습니다. Midtown과 Upper East Side는 모든 지역의 공통된 목적지이며, Upper West Side는 대부분의 업타운(uptown) 지역의 공통 목적지입니다.
특정 지역(y 축의 한 지점으로 표시)으로 도착하는 운행에 대하여, 탑승이 시작된 곳들의 분포를 살펴봅니다(y 축의 각 지점에 대한 x 축의 수평 기준 색 그라데이션).
ggplot(rxcs, aes(pickup_nb, dropoff_nb)) +
geom_tile(aes(fill = pct_by_dropoff_nb), colour = "white") +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
scale_fill_gradient(low = "white", high = "red") +
coord_fixed(ratio = .9)
보시는 것처럼, 많은 운행들은 그들이 하차 장소에 관계 없이 미드 타운에서 출발합니다. Upper East Side와 Upper West Side 또한 업타운 지역으로 도착하는 운행의 일반적인 출발 지점 들입니다.
지역간 전체 및 한계 운행 분포(Total and marginal distribution trips)
이제 다음과 같은 중요한 질문에 주의를 집중해 보겠습니다.
- 일반적으로 어느 지역 사이에서 가장 운행이 활발하게 이루어지는가?
- 여행자가 특정 지역에서 출발할 경우, 가장 목적지가 되기 쉬운 지역은 어디인가?
- 특정 지역에 누군가가 방금 하차하였다면, 출발지로 가장 유력한 곳은 어느 지역인가?
위의 질문에 답하기 위해, 우리는 두 개 지역 사이의 운행 분포(또는 비율) 정보가 필요하며, 이는 먼저 전체 여행에 대한 백분율로, 다음으로 특정 이웃에서 출발하는 운행에 대한 백분율로, 마지막으로 특정 지역의 도착에 대한 백분율로서 계산되어야 합니다.
rxc <- rxCube( ~ pickup_nb:dropoff_nb, mht_xdf)
rxc <- as.data.frame(rxc)
library(dplyr)
rxc %>%
filter(Counts > 0) %>%
mutate(pct_all = Counts/sum(Counts) * 100) %>%
group_by(pickup_nb) %>%
mutate(pct_by_pickup_nb = Counts/sum(Counts) * 100) %>%
group_by(dropoff_nb) %>%
mutate(pct_by_dropoff_nb = Counts/sum(Counts) * 100) %>%
group_by() %>%
arrange(desc(Counts)) -> rxcs
head(rxcs)
# A tibble: 6 × 6
pickup_nb dropoff_nb Counts pct_all pct_by_pickup_nb
<fctr> <fctr> <dbl> <dbl> <dbl>
1 Upper East Side Upper East Side 3299324 5.738650 36.88840
2 Midtown Midtown 2216184 3.854700 21.84268
3 Upper West Side Upper West Side 1924205 3.346849 35.14494
4 Midtown Upper East Side 1646843 2.864422 16.23127
5 Upper East Side Midtown 1607925 2.796730 17.97756
6 Garment District Midtown 1072732 1.865847 28.94205
pct_by_dropoff_nb
<dbl>
1 38.28066
2 22.41298
3 35.15770
4 19.10762
5 16.26146
6 10.84888
첫 번째 행을 기준으로 볼 때, Upper East Side에서 Upper East Side 로의 운행이 맨해튼의 모든 택시 운행의 약 5 %를 차지한다는 것을 알 수 있습니다. Upper East Side에서 출발하는 모든 여행 중 약 36 %가 Upper East Side에서 하차합니다. Upper East Side에 도착하는 모든 여행 중 37 %가 또한 Upper East Side에서 출발한 것으로 나타났습니다.
지역 리팩토링
plot 챠트에서 보이는 것처럼, 서로 가까이 있는 지역 사이에서 많은 트래픽이 발생합니다. 멀리 떨어져 있는 지역 간의 운행의 경우, 시내 중심을 통과할 경우 발생하는 대부분의 트래픽을 주변의 우회 경로를 사용하여 피할 수 있기 때문에, 이러한 결과는 그리 놀라운 일이 아닙니다. 우리는 또한 일반적으로 미드 타운(midtown) 지역과 도심(downtown), 특히 차이나타운(Chinatown)과 리틀 이태리(Little Italy) 사이에서 높은 트래픽을 볼 수 있습니다.
위의 챠트를 그리기 위해서, pickup_nb 및 dropoff_nb에 대한 factor의 level 순서를 변경했습니다. 이러한 순서 변경은 데이터 자체에서 발생하는 것이 바람직 합니다. 그렇지 않으면 pickup_nb 또는 dropoff_nb와 관련된 챠트를 생성할 때마다 factor의 level 순서를 매번 변경해야만 합니다. 이제 순서를 변경하고 이 내용을 전체 데이터에 적용해 보겠습니다. 변경을 위한 다음 두 가지 옵션이 있습니다.
- rxDataStep을 transforms 인수와 함께 사용하고, Base R 함수 factor를 사용하여 factor의 level 순서를 바꿀 수 있습니다.
- rxFactor 함수와 factorInfo를 사용하여 factor의 level을 조작할 수 있습니다. rxFactors는 메타 데이터 수준에서 작동하기 때문에 더 빠르다는 장점이 있습니다. 단점은 Hadoop이나 Spark와 같은 다른 계산 컨텍스트에서는 작동하지 않을 수 있다는 것입니다.
두 가지 방법 모두 아래에서 보실 수 있습니다.
# factor의 level 순서를 바꾸기 위한 첫 번째 방법
rxDataStep(inData = mht_xdf, outFile = mht_xdf,
transforms = list(pickup_nb = factor(pickup_nb, levels = newlevels),
dropoff_nb = factor(dropoff_nb, levels = newlevels)),
transformObjects = list(newlevels = unique(newlevs)),
overwrite = TRUE)
# factor의 level 순서를 바꾸기 위한 두 번째 방법
rxFactors(mht_xdf, outFile = mht_xdf, factorInfo = list(pickup_nb = list(newLevels = unique(newlevs)), dropoff_nb = list(newLevels = unique(newlevs))), overwrite = TRUE)