한국인 신체데이터로 다양한 분석하고 시각화 해보기

barplot( d[c(1:7),],names.arg=colnames(t(d)

주제 : 한국인 신체 데이터로 다양한 분석을 하고 시각화 해보자 !

엔트로피와 결정트리 그리기 

궁금증1 . 남자와 여자를 구분할 때 가장 큰 영향을 미치는 속성 무엇일까?

install.packages('FSelector')

library(FSelector)

install.packages("doBy")

library(doBy)

k<- read.csv('kbody3.csv',header=T)

k<- na.omit(k)

normalize <- function(x) {

 return((x - min(x)) / (max(x) - min(x)))

}

norm <- as.data.frame(lapply(k [,c(2:18)], normalize))

norm <- cbind(k [,c(1,19,20)], norm)

colnames(norm)

IG <- information.gain(gender~., norm[,-4]) #성별 컬럼을 뺀다. 

a<- data.frame(IG)

install.packages("doBy")

library(doBy)

d<-orderBy(~-attr_importance,a)

barplot( d[c(1:7),],names.arg=colnames(t(d))[c(1:7)])

결정트리를 그려보자 

tree1 <- rpart(gender~. , data= norm, control=rpart.control(minsplit=2) )

plot(tree1, compress = T , uniform = T , margin=0.1)

text(tree1, use.n = T , col = "blue")

궁금증2 . 나이에 가장 큰 영향을 미치는 컬럼이 키로 나왔다. 

이상하게 여겨져 키와 나이로 plot그래프를 그리니 

10대 이하 성장기인 연령의 키까지 포함되어 그래프가 아래와 같이 나오는것 같았다. 

20세 이상의 사람들만 추려서 나이에 가장 영향을 받는 속성 다시 뽑아보자 

e <- k[k$age >= 20 ,]

IG <- information.gain(age~., e) 

library(doBy)

d<-orderBy(~-attr_importance,a)

barplot( d[c(1:7),],names.arg=colnames(t(d))[c(1:7)])

20대 이상만 걸러내도 키가 가장 큰 영향을 미친다. 

plot으로 그려보면 

나이가 어려질 수록 평균키가 증가하는 경향을 볼 수 있다. 

IG <- information.gain(Basic_metabolism~., norm) #성별 컬럼을 뺀다. 

a<- data.frame(IG)

install.packages("doBy")

library(doBy)

d<-orderBy(~-attr_importance,a)

barplot( d[c(1:7),],names.arg=colnames(t(d))[c(1:7)])

기초 대사량과 관련이 깊은 속성은 ?

각 속성들로 남자와 여자를 구분하는 방법은 다양한 알고리즘으로 시도해보자 ! 

신경망, svm, knn  

신경망으로 !~

norm <- as.data.frame(norm)

quater3 <- sample(nrow(norm),round(0.75 * nrow(norm)))

k_train <- norm[quater3,]

nrow(k_train)

k_test <- norm[-quater3,]

nrow(k_test)

n <- colnames(k_train)

# energy_output ~ temperature + exhaust_vacuum + … 를 변수 f 에 집어넣기

f <- as.formula(paste("gender ~", paste(n[!n %in% "gender"], collapse = " + ")))

quater3 <- sample(nrow(norm),round(0.75 * nrow(norm)))

k_train <- norm[quater3,]

nrow(k_train)

k_test <- norm[-quater3,]

nrow(k_test)

model <- neuralnet(formula = f,  data = k_train, hidden= c(3,3))

model_results <- compute(model , k_test[-1])

predicted <- model_results$net.result

cor[predicted,k_test$gender]

model_results <- compute(model , k_test[-1])

predicted <- model_results$net.result

plot(model)

cor(predicted,k_test$gender)

 svm으로!

install.packages("kernlab")

library(kernlab)

ksvm <- ksvm(gender~ ., data = k_train, kernel = "rbfdot")

pred <- predict(ksvm , k_test)

agreement <- round(pred) == k_test $gender

table(agreement )

prop.table(table(agreement))

knn으로 ~

install.packages("class")

library(class)

pred <- knn(train = k_train, test = k_test, cl = k_train$gender, k=21)

library(gmodels)

CrossTable(x = k_test$gender, y = pred ,  prop.chisq=FALSE)

100% 분류!