11  Як кластеризація підвищує точність моделей “з учителем” (kmeans + renadomForest)

Курс: Математичне моделювання в R

Увага. Для використання подібного підходу до підвищення точності прогнозів варто переконатися, що це працює.

# install.packages("carData")
library(randomForest)
library(cluster)
library(modelr)
library(dplyr)
randomForest 4.7-1.1

Type rfNews() to see new features/changes/bug fixes.


Attaching package: 'dplyr'


The following object is masked from 'package:randomForest':

    combine


The following objects are masked from 'package:stats':

    filter, lag


The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union


Sys.setlocale("LC_CTYPE", "ukrainian")
options(warn = -1)
'Ukrainian_Ukraine.1251'

11.1 Набір даних

Детальна інформація про набір даних вже описана у матеріалі “Дерева рішень. Регресія. Баланс кредитної карти” (Примітка. Додати лінк)

data <- read.csv("data/credit_card_balance.csv")

Переглянемо структуру даних:

str(data) 
'data.frame':   400 obs. of  12 variables:
 $ X        : int  1 2 3 4 5 6 7 8 9 10 ...
 $ Income   : num  14.9 106 104.6 148.9 55.9 ...
 $ Limit    : int  3606 6645 7075 9504 4897 8047 3388 7114 3300 6819 ...
 $ Rating   : int  283 483 514 681 357 569 259 512 266 491 ...
 $ Cards    : int  2 3 4 3 2 4 2 2 5 3 ...
 $ Age      : int  34 82 71 36 68 77 37 87 66 41 ...
 $ Education: int  11 15 11 11 16 10 12 9 13 19 ...
 $ Gender   : chr  "Male" "Female" "Male" "Female" ...
 $ Student  : chr  "No" "Yes" "No" "No" ...
 $ Married  : chr  "Yes" "Yes" "No" "No" ...
 $ Ethnicity: chr  "Caucasian" "Asian" "Asian" "Asian" ...
 $ Balance  : int  333 903 580 964 331 1151 203 872 279 1350 ...

Підготуємо дані до моделювання. Перетворимо категоріальні показники до факторів:

data$X <- NULL
data$Gender <-  factor(data$Gender)
data$Student <- factor(data$Student)
data$Married <- factor(data$Married)
data$Ethnicity <- factor(data$Ethnicity)

11.2 Тренувальна та тестова вибірки

Розділимо на тестову та тренувальну вибірки:

set.seed(2) 
train_index <- sample(nrow(data), size = 0.5*nrow(data))
train_data <- data[train_index, ]
test_data <- data[-train_index, ]
nrow(train_data)
nrow(test_data)
200
200

11.3 Побудова моделі на основі RandomForest

rf_m1 <-randomForest(Balance~.,data=train_data)
summary(rf_m1)
                Length Class  Mode     
call              3    -none- call     
type              1    -none- character
predicted       200    -none- numeric  
mse             500    -none- numeric  
rsq             500    -none- numeric  
oob.times       200    -none- numeric  
importance       10    -none- numeric  
importanceSD      0    -none- NULL     
localImportance   0    -none- NULL     
proximity         0    -none- NULL     
ntree             1    -none- numeric  
mtry              1    -none- numeric  
forest           11    -none- list     
coefs             0    -none- NULL     
y               200    -none- numeric  
test              0    -none- NULL     
inbag             0    -none- NULL     
terms             3    terms  call     
test_prediction1 <- round(predict(object=rf_m1, test_data))
head(test_prediction1)
2
1038
4
1331
5
433
6
1010
7
182
10
1224

Перевіримо детермінацію та похибки

rsquare(rf_m1, data = train_data)
rsquare(rf_m1, data = test_data)
0.973839956466162
0.883183673751305 
rmse(rf_m1, data = train_data)
rmse(rf_m1, data = test_data)
76.9630101327789
150.63563844498

11.4 Кластеризуємо числові дані

Для початку об’єднаємо усі дані в один датасет, памятаємо, що пропорція розбиття 280/120 значень:

data <- train_data |> bind_rows(test_data)

Згенеруємо, наприклад, 5 кластерів длише для числових показників без параметру Balance (чому без балансу?):

data_k <- data |>
    select(-Balance) |>
    select_if(is.numeric)
head(data_k)
A data.frame: 6 × 6
IncomeLimitRatingCardsAgeEducation
<dbl><int><int><int><int><int>
1 27.7943807301435 8
2 50.699397730428417
3180.3799310665367 8
4 73.327655547224315
5 30.413369029922515
6 13.433113411237014
 
set.seed(2)
clusters <- kmeans(data_k, 4)
clusters$cluster
  1. 3
  2. 3
  3. 1
  4. 2
  5. 3
  6. 4
  7. 2
  8. 2
  9. 3
  10. 3
  11. 3
  12. 3
  13. 4
  14. 2
  15. 3
  16. 4
  17. 4
  18. 3
  19. 3
  20. 3
  21. 3
  22. 4
  23. 4
  24. 2
  25. 4
  26. 4
  27. 3
  28. 2
  29. 3
  30. 3
  31. 3
  32. 3
  33. 4
  34. 3
  35. 4
  36. 2
  37. 2
  38. 2
  39. 3
  40. 3
  41. 3
  42. 2
  43. 3
  44. 2
  45. 4
  46. 2
  47. 2
  48. 3
  49. 4
  50. 3
  51. 1
  52. 4
  53. 2
  54. 2
  55. 4
  56. 4
  57. 4
  58. 1
  59. 4
  60. 3
  61. 3
  62. 3
  63. 4
  64. 3
  65. 2
  66. 2
  67. 4
  68. 3
  69. 3
  70. 3
  71. 3
  72. 2
  73. 4
  74. 3
  75. 4
  76. 4
  77. 3
  78. 3
  79. 2
  80. 4
  81. 4
  82. 4
  83. 1
  84. 4
  85. 3
  86. 4
  87. 3
  88. 1
  89. 3
  90. 4
  91. 3
  92. 3
  93. 3
  94. 3
  95. 3
  96. 4
  97. 4
  98. 3
  99. 3
  100. 2
  101. 3
  102. 2
  103. 3
  104. 2
  105. 4
  106. 2
  107. 2
  108. 4
  109. 2
  110. 1
  111. 3
  112. 4
  113. 3
  114. 4
  115. 2
  116. 4
  117. 4
  118. 4
  119. 3
  120. 1
  121. 3
  122. 3
  123. 3
  124. 3
  125. 3
  126. 2
  127. 4
  128. 2
  129. 3
  130. 4
  131. 4
  132. 4
  133. 2
  134. 3
  135. 3
  136. 4
  137. 4
  138. 1
  139. 3
  140. 2
  141. 4
  142. 4
  143. 4
  144. 2
  145. 4
  146. 3
  147. 4
  148. 3
  149. 3
  150. 4
  151. 3
  152. 4
  153. 4
  154. 4
  155. 1
  156. 4
  157. 4
  158. 4
  159. 2
  160. 4
  161. 3
  162. 4
  163. 4
  164. 2
  165. 3
  166. 4
  167. 2
  168. 3
  169. 3
  170. 3
  171. 2
  172. 4
  173. 2
  174. 3
  175. 4
  176. 4
  177. 4
  178. 2
  179. 3
  180. 3
  181. 2
  182. 2
  183. 4
  184. 3
  185. 2
  186. 4
  187. 1
  188. 4
  189. 1
  190. 4
  191. 4
  192. 3
  193. 2
  194. 3
  195. 4
  196. 3
  197. 3
  198. 1
  199. 2
  200. 4
  201. 2
  202. 1
  203. 3
  204. 2
  205. 4
  206. 2
  207. 4
  208. 3
  209. 2
  210. 2
  211. 4
  212. 2
  213. 3
  214. 3
  215. 4
  216. 3
  217. 3
  218. 4
  219. 2
  220. 3
  221. 4
  222. 4
  223. 2
  224. 3
  225. 3
  226. 4
  227. 3
  228. 4
  229. 3
  230. 3
  231. 4
  232. 3
  233. 3
  234. 4
  235. 4
  236. 3
  237. 3
  238. 3
  239. 3
  240. 3
  241. 3
  242. 4
  243. 4
  244. 2
  245. 2
  246. 4
  247. 3
  248. 4
  249. 3
  250. 1
  251. 3
  252. 4
  253. 2
  254. 2
  255. 4
  256. 3
  257. 4
  258. 4
  259. 4
  260. 4
  261. 2
  262. 2
  263. 4
  264. 4
  265. 4
  266. 4
  267. 3
  268. 1
  269. 3
  270. 4
  271. 3
  272. 3
  273. 3
  274. 3
  275. 4
  276. 3
  277. 4
  278. 2
  279. 4
  280. 4
  281. 2
  282. 3
  283. 3
  284. 3
  285. 2
  286. 3
  287. 4
  288. 3
  289. 1
  290. 4
  291. 3
  292. 2
  293. 4
  294. 3
  295. 4
  296. 3
  297. 1
  298. 4
  299. 3
  300. 3
  301. 3
  302. 4
  303. 3
  304. 2
  305. 2
  306. 2
  307. 3
  308. 3
  309. 2
  310. 4
  311. 3
  312. 4
  313. 4
  314. 4
  315. 4
  316. 4
  317. 4
  318. 4
  319. 3
  320. 2
  321. 3
  322. 4
  323. 4
  324. 3
  325. 4
  326. 3
  327. 3
  328. 3
  329. 4
  330. 3
  331. 2
  332. 4
  333. 4
  334. 2
  335. 2
  336. 4
  337. 4
  338. 4
  339. 4
  340. 3
  341. 1
  342. 4
  343. 4
  344. 3
  345. 4
  346. 3
  347. 2
  348. 3
  349. 3
  350. 2
  351. 3
  352. 3
  353. 2
  354. 3
  355. 2
  356. 3
  357. 4
  358. 4
  359. 4
  360. 4
  361. 1
  362. 4
  363. 3
  364. 3
  365. 3
  366. 3
  367. 3
  368. 4
  369. 1
  370. 3
  371. 3
  372. 4
  373. 3
  374. 1
  375. 4
  376. 3
  377. 2
  378. 3
  379. 3
  380. 1
  381. 4
  382. 3
  383. 3
  384. 3
  385. 2
  386. 2
  387. 3
  388. 4
  389. 3
  390. 3
  391. 3
  392. 3
  393. 4
  394. 3
  395. 4
  396. 3
  397. 2
  398. 3
  399. 4
  400. 3

Додамо кластери як фактори до даних:

data <- data |>
    mutate(cluster = clusters$cluster)

Розібємо знову на тестову та тренувальну вибірки:

train_data <- data[1:200,]
test_data <- data[201:400,]
rf_m2 <-randomForest(Balance~.,data=train_data)
summary(rf_m2)
                Length Class  Mode     
call              3    -none- call     
type              1    -none- character
predicted       200    -none- numeric  
mse             500    -none- numeric  
rsq             500    -none- numeric  
oob.times       200    -none- numeric  
importance       11    -none- numeric  
importanceSD      0    -none- NULL     
localImportance   0    -none- NULL     
proximity         0    -none- NULL     
ntree             1    -none- numeric  
mtry              1    -none- numeric  
forest           11    -none- list     
coefs             0    -none- NULL     
y               200    -none- numeric  
test              0    -none- NULL     
inbag             0    -none- NULL     
terms             3    terms  call     
test_prediction2 <- round(predict(object=rf_m2, test_data))
head(test_prediction2)
201
1026
202
1352
203
423
204
1036
205
173
206
1211
rsquare(rf_m1, data = train_data)
rsquare(rf_m1, data = test_data)
0.973839956466162
0.883183673751305 
rsquare(rf_m2, data = train_data)
rsquare(rf_m2, data = test_data)
0.974638302729307
0.892714294123845 
rmse(rf_m1, data = train_data)
rmse(rf_m1, data = test_data)
76.9630101327789
150.63563844498 
rmse(rf_m2, data = train_data)
rmse(rf_m2, data = test_data)
75.7779193630034
144.501399436682