1 Feature 선택 혹은 추출 1

Feature를 선택하는 것과 Feature를 추출하는 것은 다른 얘기가 된다. Feature를 선택하는 것을 feature seleciton, Feature를 추출하는 것은 feature extraction으로 피처 선택의 사례로 다양한 변수 선택기법을 들 수 있고, 피처 추출 사례로 주성분 분석(PCA)를 예로 들면 이해가 쉬을 듯 싶다.

1.1 데이터셋 - 미군 신체측정

미군 신체측정 데이터셋(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>

2 변수 선택

2.1 결측점

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

2.2 산포 거의 0

산포가 거의 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

2.3 상관계수

도량형이 달라 화씨 온도를 섭씨 온도로 바꾼다든가 파운드를 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

3 Feature 추출

Feature 추출은 PCA의 사례를 통해 이해하면 쉬울 듯 싶다. 즉 기존 변수를 조합해서 신규 변수를 추출하는 것을 생각하면 될 듯 싶다.

3.1 축소 차원

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()

3.2 Feature 추출

다음 단계로 정해진 차원에 맞춰 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()

3.3 추출된 Feature 시각화

추출된 Feature에 대한 시각화를 수행한다. PC1, PC2 추출된 Feature로 남자군인과 여성군인 특성차를 나름대로 확인할 수 있다.

soldier_df %>% 
  ggplot(aes(x=PC1, y=PC2, color=Gender)) +
    geom_point(alpha=0.3)

3.4 추출된 Feature 설명

추출된 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)