1. 데이터 불러오기
df <- read.delim(file.choose(), sep="\t", stringsAsFactors = FALSE)
2. 자질 매핑 (sonority, anteriority 등)
sonority_map <- c("sto"=1, "aff"=2, "fri"=3, "nas"=4, "liq"=5, "glide"=6, "vow"=7)
ant_map <- c("lab"=1, "den"=2, "alv"=3, "pal"=4, "vel"=5, "glo"=6)
height_map <- c("low"=1, "mid"=2, "hig"=3)
front_map <- c("bac"=1, "cen"=2, "fro"=3)
map_to_numeric <- function(col, map) {
as.numeric(map[as.character(col)])
}
df$son_o1 <- map_to_numeric(df$manner_o1, sonority_map)
df$son_c1 <- map_to_numeric(df$manner_c1, sonority_map)
df$son_o2 <- map_to_numeric(df$manner_o2, sonority_map)
df$son_c2 <- map_to_numeric(df$manner_c2, sonority_map)
df$ant_o1 <- map_to_numeric(df$place_o1, ant_map)
df$ant_c1 <- map_to_numeric(df$place_c1, ant_map)
df$ant_o2 <- map_to_numeric(df$place_o2, ant_map)
df$ant_c2 <- map_to_numeric(df$place_c2, ant_map)
df$hei1 <- map_to_numeric(df$height1, height_map)
df$hei2 <- map_to_numeric(df$height2, height_map)
df$fro1 <- map_to_numeric(df$front1, front_map)
df$fro2 <- map_to_numeric(df$front2, front_map)
df$gen <- factor(df$gen, levels = c(-1, 1), labels = c("female", "male"))
3. 자질 추가 (Feature Engineering)
#이름 길이 (음절 수)
df$name_len <- nchar(as.character(df$name))
#첫 음절이 비음인지(nasal- m,n)
df$nasal_start <- ifelse(df$manner_o1 == "nas", 1, 0)
#이름에 활음(glide - w,j)이 있는지
df$has_glide <- ifelse(df$manner_o1 == "glide" | df$manner_o2 == "glide", 1, 0)
head(df[, c("name", "name_len", "nasal_start", "has_glide")])
## name name_len nasal_start has_glide
## 1 민준 2 1 0
## 2 서준 2 0 0
## 3 예준 2 NA NA
## 4 도윤 2 0 NA
## 5 주원 2 0 NA
## 6 시우 2 0 NA
- 6명 모두 보편적인 이름인 2음절에 부합 (성 제외 2음절)
1. 민준 - 비음 시작, 활음 X = 전형적인 남자 이름
2. 서준 - 비음 X, 활음 X = 전형적인 남자 이름
3. 예준 - 비음 X, 활음 X (but, ’예’가 활음일 수도 O) = ’준’으로
끝나는 이름은 남자가 더 흔함
4. 도윤 - 비음 X, 활음 X (but, ’윤’이 활음일 수도 O) = 중성적이지만
남자이름이 더 많음
5. 주원 - 비음 X, 활음 X (but, ’원’이 활음일 수도 O) = 남자 이름으로
많이 알려져 있음
6. 시우 - 비음 X, 활음 X (but, ’우’가 활음일 수도 O) = 중성적
느낌
세가지 자질만으로는 성별예측 정확도를 알기 어려움
그러나, 이름 분포도에 남자이름이 더 많음을 알 수
있음.
향후 여자 이름 데이터를 추가하면 결과가 다를 것..?
자질 추가를 통해 분석할 수 있지만, 이름만으로 성별 예측은
완전하지 않음.
4. 학습/테스트 나누기 (sample() 사용)
numeric_vars <- c("son_o1", "son_c1", "son_o2", "son_c2",
"ant_o1", "ant_c1", "ant_o2", "ant_c2",
"hei1", "hei2", "fro1", "fro2",
"name_len", "nasal_start", "has_glide")
df[numeric_vars][is.na(df[numeric_vars])] <- 0
set.seed(123)
train_idx <- sample(nrow(df), 0.7 * nrow(df))
df.train <- df[train_idx, ]
df.test <- df[-train_idx, ]
# 클래스 분포 확인
table(df.test$gen)
##
## female male
## 98 82
5. 다른 모델과 AUC 비교
rf.model <- randomForest(gen ~ ., data = df.train[, c(numeric_vars, "gen")])
rf.prob <- predict(rf.model, newdata = df.test, type = "prob")[, "male"]
nb.model <- naiveBayes(gen ~ ., data = df.train[, c(numeric_vars, "gen")])
nb.prob <- predict(nb.model, newdata = df.test, type = "raw")[, "male"]
tree.model <- rpart(gen ~ ., data = df.train[, c(numeric_vars, "gen")])
tree.prob <- predict(tree.model, newdata = df.test)[, "male"]
rf.roc <- roc(df.test$gen, rf.prob)
## Setting levels: control = female, case = male
## Setting direction: controls < cases
nb.roc <- roc(df.test$gen, nb.prob)
## Setting levels: control = female, case = male
## Setting direction: controls < cases
tree.roc <- roc(df.test$gen, tree.prob)
## Setting levels: control = female, case = male
## Setting direction: controls < cases
plot(rf.roc, col="blue", main="ROC 비교")
lines(nb.roc, col="green")
lines(tree.roc, col="purple")
legend("bottomright", legend=c("Random Forest", "Naive Bayes", "Decision Tree"),
col=c("blue", "green", "purple"), lwd=2)
cat("RF AUC: ", auc(rf.roc), "\n")
## RF AUC: 0.8012693
cat("NB AUC: ", auc(nb.roc), "\n")
## NB AUC: 0.7098059
cat("Tree AUC: ", auc(tree.roc), "\n")
## Tree AUC: 0.6844201
랜덤 포레스트 모델이 가장 좋음을 알 수 있음 (면적이 가장 넓음)
랜덤포레스트: 0.78 (가장 효과적인 모델, 비선형적 or 복잡한 구조
파악할 수 있음 -> 비교적 정확도 높음)
나이브베이즈: 0.71 (복잡한 이름 구조 파악 어려움)
의사결정나무: 0.68 (과적합 가능성 있음, 정확도 낮음)
6. 전형적인 성별 이름 추출
rf.prob.all <- predict(rf.model, newdata=df[, numeric_vars], type="prob")
df$male_prob <- rf.prob.all[, "male"]
top_male <- head(df[order(-df$male_prob), c("name", "male_prob")], 5)
top_female <- head(df[order(df$male_prob), c("name", "male_prob")], 5)
top_male
## name male_prob
## 144 승훈 1.000
## 219 진혁 1.000
## 24 승현 0.998
## 152 성훈 0.998
## 220 승환 0.998
top_female
## name male_prob
## 366 나연 0.004
## 371 아린 0.010
## 394 예림 0.010
## 436 유리 0.020
## 507 보미 0.024