TPM Project: LDA
Afris Setiya Intan Amanda (G1401201018)
7/23/2023
dataa<-read.csv("D:/MY COLLEGE/SEMESTER 6/TPM/DATA/ANSUR II FEMALE Public.csv")
dim(dataa)## [1] 1986 108#peubah respon <-DODRace
#dari 107 dipilih 94 peubah saja, hanya peubah numerik
#13 peubah yang tidak digunakan:
colnames(dataa[,c(1,95:103,106:108)])## [1] "SubjectId" "Gender" "Date"
## [4] "Installation" "Component" "Branch"
## [7] "PrimaryMOS" "SubjectsBirthLocation" "SubjectNumericRace"
## [10] "Ethnicity" "Heightin" "Weightlbs"
## [13] "WritingPreference"#menghapus peubah
data<-dataa[,-c(1,95:103,106:108)]
colSums(is.na(data))## abdominalextensiondepthsitting acromialheight
## 0 0
## acromionradialelength anklecircumference
## 0 0
## axillaheight balloffootcircumference
## 0 0
## balloffootlength biacromialbreadth
## 0 0
## bicepscircumferenceflexed bicristalbreadth
## 0 0
## bideltoidbreadth bimalleolarbreadth
## 0 0
## bitragionchinarc bitragionsubmandibulararc
## 0 0
## bizygomaticbreadth buttockcircumference
## 0 0
## buttockdepth buttockheight
## 0 0
## buttockkneelength buttockpopliteallength
## 0 0
## calfcircumference cervicaleheight
## 0 0
## chestbreadth chestcircumference
## 0 0
## chestdepth chestheight
## 0 0
## crotchheight crotchlengthomphalion
## 0 0
## crotchlengthposterioromphalion earbreadth
## 0 0
## earlength earprotrusion
## 0 0
## elbowrestheight eyeheightsitting
## 0 0
## footbreadthhorizontal footlength
## 0 0
## forearmcenterofgriplength forearmcircumferenceflexed
## 0 0
## forearmforearmbreadth forearmhandlength
## 0 0
## functionalleglength handbreadth
## 0 0
## handcircumference handlength
## 0 0
## headbreadth headcircumference
## 0 0
## headlength heelanklecircumference
## 0 0
## heelbreadth hipbreadth
## 0 0
## hipbreadthsitting iliocristaleheight
## 0 0
## interpupillarybreadth interscyei
## 0 0
## interscyeii kneeheightmidpatella
## 0 0
## kneeheightsitting lateralfemoralepicondyleheight
## 0 0
## lateralmalleolusheight lowerthighcircumference
## 0 0
## mentonsellionlength neckcircumference
## 0 0
## neckcircumferencebase overheadfingertipreachsitting
## 0 0
## palmlength poplitealheight
## 0 0
## radialestylionlength shouldercircumference
## 0 0
## shoulderelbowlength shoulderlength
## 0 0
## sittingheight sleevelengthspinewrist
## 0 0
## sleeveoutseam span
## 0 0
## stature suprasternaleheight
## 0 0
## tenthribheight thighcircumference
## 0 0
## thighclearance thumbtipreach
## 0 0
## tibialheight tragiontopofhead
## 0 0
## trochanterionheight verticaltrunkcircumferenceusa
## 0 0
## waistbacklength waistbreadth
## 0 0
## waistcircumference waistdepth
## 0 0
## waistfrontlengthsitting waistheightomphalion
## 0 0
## weightkg wristcircumference
## 0 0
## wristheight DODRace
## 0 0
## Age
## 0unique(data$DODRace)## [1] 2 3 1 6 4 5class(data$DODRace)## [1] "integer"data$DODRace<-as.factor(data$DODRace);class(data$DODRace)## [1] "factor"#peubah yang digunakan
colnames(data)## [1] "abdominalextensiondepthsitting" "acromialheight"
## [3] "acromionradialelength" "anklecircumference"
## [5] "axillaheight" "balloffootcircumference"
## [7] "balloffootlength" "biacromialbreadth"
## [9] "bicepscircumferenceflexed" "bicristalbreadth"
## [11] "bideltoidbreadth" "bimalleolarbreadth"
## [13] "bitragionchinarc" "bitragionsubmandibulararc"
## [15] "bizygomaticbreadth" "buttockcircumference"
## [17] "buttockdepth" "buttockheight"
## [19] "buttockkneelength" "buttockpopliteallength"
## [21] "calfcircumference" "cervicaleheight"
## [23] "chestbreadth" "chestcircumference"
## [25] "chestdepth" "chestheight"
## [27] "crotchheight" "crotchlengthomphalion"
## [29] "crotchlengthposterioromphalion" "earbreadth"
## [31] "earlength" "earprotrusion"
## [33] "elbowrestheight" "eyeheightsitting"
## [35] "footbreadthhorizontal" "footlength"
## [37] "forearmcenterofgriplength" "forearmcircumferenceflexed"
## [39] "forearmforearmbreadth" "forearmhandlength"
## [41] "functionalleglength" "handbreadth"
## [43] "handcircumference" "handlength"
## [45] "headbreadth" "headcircumference"
## [47] "headlength" "heelanklecircumference"
## [49] "heelbreadth" "hipbreadth"
## [51] "hipbreadthsitting" "iliocristaleheight"
## [53] "interpupillarybreadth" "interscyei"
## [55] "interscyeii" "kneeheightmidpatella"
## [57] "kneeheightsitting" "lateralfemoralepicondyleheight"
## [59] "lateralmalleolusheight" "lowerthighcircumference"
## [61] "mentonsellionlength" "neckcircumference"
## [63] "neckcircumferencebase" "overheadfingertipreachsitting"
## [65] "palmlength" "poplitealheight"
## [67] "radialestylionlength" "shouldercircumference"
## [69] "shoulderelbowlength" "shoulderlength"
## [71] "sittingheight" "sleevelengthspinewrist"
## [73] "sleeveoutseam" "span"
## [75] "stature" "suprasternaleheight"
## [77] "tenthribheight" "thighcircumference"
## [79] "thighclearance" "thumbtipreach"
## [81] "tibialheight" "tragiontopofhead"
## [83] "trochanterionheight" "verticaltrunkcircumferenceusa"
## [85] "waistbacklength" "waistbreadth"
## [87] "waistcircumference" "waistdepth"
## [89] "waistfrontlengthsitting" "waistheightomphalion"
## [91] "weightkg" "wristcircumference"
## [93] "wristheight" "DODRace"
## [95] "Age"dim(data)## [1] 1986 95#eksplorasi y (dodrace)
ggplot(data, aes(x=DODRace))+geom_bar(aes(fill = DODRace))
Rumpun
rumpun<-list(badan<-c(1, 2, 5, 8, 10, 11, 22, 34, 54, 55, 71, 75,
76, 77, 84, 85, 86, 87, 88, 89, 90, 91),
lengan<-c(3, 9, 33, 37, 38, 39, 40, 64, 67, 72,
73, 74, 80, 92),
kaki<-c(4, 6, 7, 12, 21, 35, 36, 41, 48, 49, 52, 56,
57, 58, 59, 60, 66, 78, 79, 81, 83, 93),
wajah<-c(13, 14, 15, 53, 61),
buttock<-c(16, 17, 18, 19, 20),
chest<-c(23, 24, 25, 26),
crotch<-c(27, 28, 29),
ear<-c(30, 31, 32),
tangan<-c(42, 43, 44, 65),
kepala<-c(45, 46, 47, 82),
hip<-c(50, 51),
neck<-c(62, 63),
shoulder<-c(68, 69,70))#korelasi (boleh dipertimbangkan untuk dimasukkan)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[1]]]), type = "lower", lab = FALSE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[2]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[3]]]), type = "lower", lab = FALSE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[4]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[5]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[6]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[7]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[8]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[9]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[10]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[11]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[12]]]), type = "lower", lab = TRUE)
ggcorrplot::ggcorrplot(cor(data[,rumpun[[13]]]), type = "lower", lab = TRUE)
#normality (bisa pilih salah satu saja untuk dimasukkan)
data[,c(1:16)]%>%
gather()%>%
ggplot(., aes(sample = value)) +
stat_qq()+
facet_wrap(vars(key), scales ='free_y')
data[,c(17:32)]%>%
gather()%>%
ggplot(., aes(sample = value)) +
stat_qq()+
facet_wrap(vars(key), scales ='free_y')
data[,c(33:48)]%>%
gather()%>%
ggplot(., aes(sample = value)) +
stat_qq()+
facet_wrap(vars(key), scales ='free_y')
data[,c(49:64)]%>%
gather()%>%
ggplot(., aes(sample = value)) +
stat_qq()+
facet_wrap(vars(key), scales ='free_y')
data[,c(65:80)]%>%
gather()%>%
ggplot(., aes(sample = value)) +
stat_qq()+
facet_wrap(vars(key), scales ='free_y')
data[,c(81:93,95)]%>%
gather()%>%
ggplot(., aes(sample = value)) +
stat_qq()+
facet_wrap(vars(key), scales ='free_y')
#split data
set.seed(333)
training.samples <- data$DODRace %>%
createDataPartition(p = 0.8, list = FALSE)
train.data <- data[training.samples, ]
test.data <- data[-training.samples, ]#proporsi setiap kelas di tiap data hasil split
ggplot(train.data, aes(x=DODRace))+geom_bar(aes(fill = DODRace))
ggplot(test.data, aes(x=DODRace))+geom_bar(aes(fill = DODRace))
library(MASS)
# Fit the model
model <- lda(DODRace~., data = train.data)#plot untuk data train (hasil LDA, dengan LD1 dan LD2 saja)
lda.data <- cbind(train.data, predict(model)$x)
ggplot(lda.data, aes(LD1, LD2)) +
geom_point(aes(color = DODRace))
#jika hanya divisualisasikan dan diamati dari 2 peubah saja
ggplot(test.data, aes(weightkg, Age)) +
geom_point(aes(color = DODRace))
#plot untuk data test
#(diamati dengan dua dimensi juga, namun hasil kombinasi linear 94 peubah, yaitu LD1 dan LD2)
lda.test <- cbind(test.data, predict(model, test.data)$x)
ggplot(lda.test, aes(LD1, LD2)) +
geom_point(aes(color = DODRace))
#transformasi dari n peubah ke k peubah
test.data[1:5,]## abdominalextensiondepthsitting acromialheight acromionradialelength
## 6 272 1428 326
## 15 265 1315 320
## 19 233 1374 342
## 21 325 1239 278
## 23 181 1335 307
## anklecircumference axillaheight balloffootcircumference balloffootlength
## 6 228 1326 229 201
## 15 194 1218 225 177
## 19 211 1281 232 184
## 21 217 1145 231 172
## 23 201 1240 220 170
## biacromialbreadth bicepscircumferenceflexed bicristalbreadth
## 6 356 342 283
## 15 365 339 279
## 19 393 335 270
## 21 342 336 306
## 23 330 262 249
## bideltoidbreadth bimalleolarbreadth bitragionchinarc
## 6 470 67 335
## 15 486 65 313
## 19 491 68 332
## 21 502 65 303
## 23 395 63 305
## bitragionsubmandibulararc bizygomaticbreadth buttockcircumference
## 6 297 147 1085
## 15 282 135 1000
## 19 283 135 1011
## 21 267 131 1107
## 23 266 126 867
## buttockdepth buttockheight buttockkneelength buttockpopliteallength
## 6 279 946 656 526
## 15 240 855 593 480
## 19 238 919 623 515
## 21 283 770 568 446
## 23 198 851 547 450
## calfcircumference cervicaleheight chestbreadth chestcircumference chestdepth
## 6 396 1485 285 1031 301
## 15 375 1379 280 989 267
## 19 382 1422 296 979 251
## 21 413 1280 308 1090 309
## 23 326 1388 244 857 209
## chestheight crotchheight crotchlengthomphalion
## 6 1275 864 634
## 15 1164 772 588
## 19 1211 835 630
## 21 1055 664 599
## 23 1164 770 593
## crotchlengthposterioromphalion earbreadth earlength earprotrusion
## 6 363 35 61 15
## 15 325 33 63 23
## 19 317 36 58 21
## 21 265 31 57 19
## 23 335 35 60 21
## elbowrestheight eyeheightsitting footbreadthhorizontal footlength
## 6 233 755 93 270
## 15 220 727 88 238
## 19 189 736 97 253
## 21 270 720 94 233
## 23 240 756 86 231
## forearmcenterofgriplength forearmcircumferenceflexed forearmforearmbreadth
## 6 358 297 509
## 15 324 277 525
## 19 345 276 533
## 21 296 290 575
## 23 306 246 436
## forearmhandlength functionalleglength handbreadth handcircumference
## 6 491 1145 78 188
## 15 442 1052 80 190
## 19 469 1099 79 188
## 21 409 1024 75 180
## 23 428 1011 74 177
## handlength headbreadth headcircumference headlength heelanklecircumference
## 6 198 146 570 194 333
## 15 178 147 586 194 308
## 19 187 146 592 206 310
## 21 169 144 560 195 305
## 23 174 138 536 185 293
## heelbreadth hipbreadth hipbreadthsitting iliocristaleheight
## 6 70 358 409 1080
## 15 64 338 397 978
## 19 65 344 408 1054
## 21 63 358 439 882
## 23 60 304 350 980
## interpupillarybreadth interscyei interscyeii kneeheightmidpatella
## 6 705 372 380 478
## 15 675 400 412 464
## 19 650 400 419 479
## 21 575 434 414 394
## 23 570 320 342 454
## kneeheightsitting lateralfemoralepicondyleheight lateralmalleolusheight
## 6 542 495 63
## 15 503 464 66
## 19 542 490 65
## 21 447 405 64
## 23 491 450 70
## lowerthighcircumference mentonsellionlength neckcircumference
## 6 423 126 354
## 15 377 112 354
## 19 403 123 335
## 21 386 112 341
## 23 329 113 303
## neckcircumferencebase overheadfingertipreachsitting palmlength
## 6 379 1412 124
## 15 379 1331 114
## 19 364 1391 114
## 21 382 1300 105
## 23 338 1316 109
## poplitealheight radialestylionlength shouldercircumference
## 6 401 271 1094
## 15 380 249 1116
## 19 413 264 1128
## 21 325 225 1119
## 23 385 236 919
## shoulderelbowlength shoulderlength sittingheight sleevelengthspinewrist
## 6 348 136 860 847
## 15 343 142 834 804
## 19 366 148 853 866
## 21 298 133 830 777
## 23 330 132 863 738
## sleeveoutseam span stature suprasternaleheight tenthribheight
## 6 592 1777 1707 1414 1141
## 15 548 1690 1599 1314 1037
## 19 593 1797 1679 1365 1102
## 21 500 1539 1517 1225 953
## 23 547 1602 1623 1315 1055
## thighcircumference thighclearance thumbtipreach tibialheight
## 6 674 196 803 474
## 15 639 177 769 450
## 19 647 175 778 473
## 21 695 191 707 385
## 23 492 155 723 441
## tragiontopofhead trochanterionheight verticaltrunkcircumferenceusa
## 6 127 922 1666
## 15 122 846 1554
## 19 123 899 1515
## 21 117 739 1639
## 23 121 843 1497
## waistbacklength waistbreadth waistcircumference waistdepth
## 6 466 333 968 255
## 15 464 319 929 244
## 19 411 308 868 214
## 21 478 373 1137 318
## 23 425 251 702 165
## waistfrontlengthsitting waistheightomphalion weightkg wristcircumference
## 6 367 1053 837 159
## 15 388 956 709 150
## 19 340 1019 741 155
## 21 388 837 800 160
## 23 354 972 491 146
## wristheight DODRace Age
## 6 844 2 44
## 15 755 3 30
## 19 789 2 33
## 21 759 1 31
## 23 787 1 31predict(model, test.data[1:5,])$x## LD1 LD2 LD3 LD4 LD5
## 6 4.9638320 -0.5023943 -0.14392057 2.3893084 0.3681452
## 15 2.6795638 -0.6614387 -1.00725633 -0.6685718 2.2578702
## 19 2.6456553 -1.5617252 -0.01093936 -2.0241913 0.6562887
## 21 -0.6169424 0.4349430 -1.23442831 -1.4329888 0.3193315
## 23 -1.0368921 -0.2672134 -0.35559866 -1.1584576 1.9552677#dugaan parameter untuk LD1-LD5 (lampiran)
View(model$scaling)
head(model$scaling)## LD1 LD2 LD3
## abdominalextensiondepthsitting 0.0025574669 -0.004612435 0.001681025
## acromialheight -0.0056336311 0.007920659 -0.009453522
## acromionradialelength -0.0004022301 -0.032883541 -0.031322332
## anklecircumference -0.0195195358 -0.027123853 0.001209518
## axillaheight 0.0016999668 -0.017357162 0.019493775
## balloffootcircumference -0.0112484049 0.011530030 -0.012096236
## LD4 LD5
## abdominalextensiondepthsitting 0.015990469 0.012642960
## acromialheight 0.020364343 0.001667664
## acromionradialelength -0.055936146 0.007191916
## anklecircumference 0.002948208 -0.008813162
## axillaheight -0.019379088 -0.004317102
## balloffootcircumference 0.005282350 0.015540854