Feature를 선택하는 것과 Feature를 추출하는 것은 다른 얘기가 된다. Feature를 선택하는 것을 feature seleciton
, Feature를 추출하는 것은 feature extraction
으로 피처 선택의 사례로 다양한 변수 선택기법을 들 수 있고, 피처 추출 사례로 주성분 분석(PCA)를 예로 들면 이해가 쉬을 듯 싶다.
미군 신체측정 데이터셋(Anthropometric Survey of US Army Personnel, ANSUR 2)은 2012년 내부에 공개되었고 2017년에 대중에 공개되었다. 총 6,000명 군인(남자 4,082, 여자 1,986)에 대한 측정정보를 담고 있다.
library(tidyverse)
male_dat <- read_csv("http://tools.openlab.psu.edu/publicData/ANSUR_II_MALE_Public.csv")
female_dat <- read_csv("http://tools.openlab.psu.edu/publicData/ANSUR_II_FEMALE_Public.csv")
soldier_dat <- bind_rows(male_dat, female_dat)
soldier_dat %>% write_rds("data/soldier_dat.rds")
다운로드 받은 남녀 데이터를 결합하여 남자군인, 여자군인을 분류하는데 사용되는 X
설계행렬을 추출한다.
soldier_dat <- read_rds("data/soldier_dat.rds")
soldier_X_df <- soldier_dat %>%
select(-c("subjectid","SubjectId", "Gender", "Date", "Installation", "Component", "Branch", "PrimaryMOS", "SubjectsBirthLocation", "SubjectNumericRace", "Ethnicity", "DODRace", "Age", "Heightin", "Weightlbs", "WritingPreference"))
soldier_X_df
# A tibble: 6,068 x 93
abdominalextens… acromialheight acromionradiale… anklecircumfere…
<dbl> <dbl> <dbl> <dbl>
1 266 1467 337 222
2 233 1395 326 220
3 287 1430 341 230
4 234 1347 310 230
5 250 1585 372 247
6 263 1407 344 216
7 314 1476 343 257
8 304 1529 360 254
9 321 1457 339 230
10 227 1481 345 233
# … with 6,058 more rows, and 89 more variables: axillaheight <dbl>,
# balloffootcircumference <dbl>, balloffootlength <dbl>,
# biacromialbreadth <dbl>, bicepscircumferenceflexed <dbl>,
# bicristalbreadth <dbl>, bideltoidbreadth <dbl>,
# bimalleolarbreadth <dbl>, bitragionchinarc <dbl>,
# bitragionsubmandibulararc <dbl>, bizygomaticbreadth <dbl>,
# buttockcircumference <dbl>, buttockdepth <dbl>, buttockheight <dbl>,
# buttockkneelength <dbl>, buttockpopliteallength <dbl>,
# calfcircumference <dbl>, cervicaleheight <dbl>, chestbreadth <dbl>,
# chestcircumference <dbl>, chestdepth <dbl>, chestheight <dbl>,
# crotchheight <dbl>, crotchlengthomphalion <dbl>,
# crotchlengthposterioromphalion <dbl>, earbreadth <dbl>,
# earlength <dbl>, earprotrusion <dbl>, elbowrestheight <dbl>,
# eyeheightsitting <dbl>, footbreadthhorizontal <dbl>, footlength <dbl>,
# forearmcenterofgriplength <dbl>, forearmcircumferenceflexed <dbl>,
# forearmforearmbreadth <dbl>, forearmhandlength <dbl>,
# functionalleglength <dbl>, handbreadth <dbl>, handcircumference <dbl>,
# handlength <dbl>, headbreadth <dbl>, headcircumference <dbl>,
# headlength <dbl>, heelanklecircumference <dbl>, heelbreadth <dbl>,
# hipbreadth <dbl>, hipbreadthsitting <dbl>, iliocristaleheight <dbl>,
# interpupillarybreadth <dbl>, interscyei <dbl>, interscyeii <dbl>,
# kneeheightmidpatella <dbl>, kneeheightsitting <dbl>,
# lateralfemoralepicondyleheight <dbl>, lateralmalleolusheight <dbl>,
# lowerthighcircumference <dbl>, mentonsellionlength <dbl>,
# neckcircumference <dbl>, neckcircumferencebase <dbl>,
# overheadfingertipreachsitting <dbl>, palmlength <dbl>,
# poplitealheight <dbl>, radialestylionlength <dbl>,
# shouldercircumference <dbl>, shoulderelbowlength <dbl>,
# shoulderlength <dbl>, sittingheight <dbl>,
# sleevelengthspinewrist <dbl>, sleeveoutseam <dbl>, span <dbl>,
# stature <dbl>, suprasternaleheight <dbl>, tenthribheight <dbl>,
# thighcircumference <dbl>, thighclearance <dbl>, thumbtipreach <dbl>,
# tibialheight <dbl>, tragiontopofhead <dbl>, trochanterionheight <dbl>,
# verticaltrunkcircumferenceusa <dbl>, waistbacklength <dbl>,
# waistbreadth <dbl>, waistcircumference <dbl>, waistdepth <dbl>,
# waistfrontlengthsitting <dbl>, waistheightomphalion <dbl>,
# weightkg <dbl>, wristcircumference <dbl>, wristheight <dbl>
Feature 선택에 있어 가장 먼저 결측점이 있는지 파악하고 각 feature별로 결측점 비율을 파악해서 특정 결측비율이상되면 제외시키도록한다.
가장 먼저 데이터프레임 변수별로 결측값이 있는 다음 무명함수로 확인한다.
soldier_X_df %>%
select_if(function(x) any(is.na(x)))
# A tibble: 6,068 x 0
결측값 갯수를 각 변수별로 산출하고 이를 데이터프레임으로 변환시킨다. 다행히 결측값은 하나도 없는 것으로 판정되어 제거할 feature도 없다.
soldier_na_vec <- sapply(soldier_X_df, function(y) sum(length(which(is.na(y)))))
soldier_na_df <- tibble(na_cnt = soldier_na_vec)
soldier_na_df %>%
mutate(na_pcnt = na_cnt / nrow(soldier_na_df) * 100) %>%
arrange(desc(na_pcnt))
# A tibble: 93 x 2
na_cnt na_pcnt
<int> <dbl>
1 0 0
2 0 0
3 0 0
4 0 0
5 0 0
6 0 0
7 0 0
8 0 0
9 0 0
10 0 0
# … with 83 more rows
산포가 거의 0인 변수는 의미가 없다. 따라서 각 변수 분산을 구한 후에 분산이 0 혹은 분산이 거의 0인 변수를 제거한다. 이번 경우에도 산포가 0인 변수가 없어 제거할 변수가 없다.
soldier_X_df %>%
gather(variable, value) %>%
group_by(variable) %>%
summarise(variance = sd(value),
na_cnt = sum(length(which(is.na(value))))) %>%
arrange(variance)
# A tibble: 93 x 3
variable variance na_cnt
<chr> <dbl> <int>
1 earprotrusion 3.17 0
2 earbreadth 3.23 0
3 earlength 4.88 0
4 bimalleolarbreadth 5.34 0
5 heelbreadth 5.93 0
6 headbreadth 6.24 0
7 handbreadth 6.35 0
8 footbreadthhorizontal 6.66 0
9 tragiontopofhead 6.66 0
10 palmlength 7.14 0
# … with 83 more rows
도량형이 달라 화씨 온도를 섭씨 온도로 바꾼다든가 파운드를 KG으로 바꾸는 경우 동일한 정보를 변수를 달리하여 데이터프레임에 포함되는 경우가 있다. 이런 경우 상관계수는 0이 되고 키와 몸무게처럼 매우 상관관계가 높은 경우 BMI지수 등을 통해 따로 추출해내는 것이 여러모로 유리한 경우가 많다.
soldier_X_df
데이터프레임은 93 변수로 구성되어 있어 수작업으로 일일이 상관관계를 파악하는 것은 불가능하다고 보고 corrr
팩키지를 사용해서 상관관계를 계산하고 상관관계가 높은 변수를 뽑아낸다.
library(corrr)
soldier_X_df %>%
correlate() %>%
shave() %>%
stretch() %>%
arrange(desc(r))
# A tibble: 8,649 x 3
x y r
<chr> <chr> <dbl>
1 cervicaleheight stature 0.991
2 cervicaleheight suprasternaleheight 0.989
3 stature suprasternaleheight 0.989
4 acromialheight axillaheight 0.987
5 acromialheight suprasternaleheight 0.985
6 acromialheight cervicaleheight 0.984
7 eyeheightsitting sittingheight 0.982
8 axillaheight suprasternaleheight 0.981
9 acromialheight stature 0.980
10 axillaheight cervicaleheight 0.977
# … with 8,639 more rows
Feature 추출은 PCA의 사례를 통해 이해하면 쉬울 듯 싶다. 즉 기존 변수를 조합해서 신규 변수를 추출하는 것을 생각하면 될 듯 싶다.
prcomp
함수로 PCA를 수행하고 팔꿈치 그래프를 통해서 적절한 차원수를 결정한다.
soldier_pca <- soldier_X_df %>%
prcomp(scale = TRUE, center = TRUE)
soldier_pca_summary <- summary(soldier_pca)
soldier_pca_df <- soldier_pca_summary$importance %>%
tbl_df() %>%
mutate(names = rownames(soldier_pca_summary$importance)) %>%
gather(PC, value, -names) %>%
arrange(names, PC)
soldier_pca_df %>%
filter(str_detect(names, "Variance")) %>%
mutate(PC_dimension = parse_number(PC)) %>%
ggplot(aes(x=PC_dimension, y=value)) +
geom_point() +
geom_line()
다음 단계로 정해진 차원에 맞춰 Feature를 추출한다. 그리고 목적으로 하고 있는 예측할 변수(Gender
)를 붙여 basetable을 구성한다.
soldier_pca_X_df <- soldier_pca$x[,1:3] %>%
tbl_df
soldier_df <- soldier_dat %>%
select(Gender) %>%
bind_cols(soldier_pca_X_df)
soldier_df %>%
sample_n(100) %>%
DT::datatable()
추출된 Feature에 대한 시각화를 수행한다. PC1, PC2 추출된 Feature로 남자군인과 여성군인 특성차를 나름대로 확인할 수 있다.
soldier_df %>%
ggplot(aes(x=PC1, y=PC2, color=Gender)) +
geom_point(alpha=0.3)
추출된 Feature에 대해서 원본데이터에서 요인을 추가로 붙여 추가 설명도 가능하다. BMI 변수를 새로 도입하여 추가하는 것도 흥미로울 듯 싶은데, 기존에 있던 연령 정보를 활용하여 신규로 5개 연령집단으로 나눠 남녀군인을 겹쳐 추출된 Feature를 설명하는 것도 좋을 듯 싶다.
soldier_dat %>%
select(Component) %>%
bind_cols(soldier_pca_X_df) %>%
ggplot(aes(x=PC1, y=PC2, color=Component)) +
geom_point(alpha=0.3)
soldier_dat %>%
mutate(Age_group = ntile(Age, 5) %>% as.factor) %>%
select(Gender, Age_group) %>%
bind_cols(soldier_pca_X_df) %>%
ggplot(aes(x=PC1, y=PC2, color=Gender)) +
geom_point(alpha=0.3) +
facet_wrap(~Age_group)