데이터사이언스_3주차_R

데이터 탐색의 예

weight_height <- read.csv("C:/Users/cksgo/Documents/weight_height.csv") #csv파일 읽어오기
male_wh_us <- weight_height[weight_height$Gender=="Male",] #Male만 추출
female_wh_us <- weight_height[weight_height$Gender=="Female",] #Female만 추출

#inch를 cm로, lb를 kg로 변경
male_wh <- data.frame(Gender=male_wh_us[,1], Height_cm=male_wh_us[,2]*2.54, Weight_kg=male_wh_us[,3]*0.453592)
female_wh <- data.frame(Gender=female_wh_us[,1], Height_cm=female_wh_us[,2]*2.54, Weight_kg=female_wh_us[,3]*0.453592)

#head()를 이용하여 잘 변경되었는지 확인
head(male_wh)
head(female_wh)

#결측값이 있는지 확인
table(is.na(male_wh))
table(is.na(female_wh))

#데이터 요약 통계랑 출력
summary(male_wh)
summary(female_wh)

데이터요약

> summary(male_wh)
    Gender            Height_cm       Weight_kg     
 Length:5000        Min.   :148.4   Min.   : 51.21  
 Class :character   1st Qu.:170.6   1st Qu.: 78.87  
 Mode  :character   Median :175.3   Median : 84.84  
                    Mean   :175.3   Mean   : 84.83  
                    3rd Qu.:180.3   3rd Qu.: 90.88  
                    Max.   :200.7   Max.   :122.47  
> summary(female_wh)
    Gender            Height_cm       Weight_kg    
 Length:5000        Min.   :137.8   Min.   :29.35  
 Class :character   1st Qu.:157.2   1st Qu.:55.76  
 Mode  :character   Median :161.9   Median :61.74  
                    Mean   :161.8   Mean   :61.63  
                    3rd Qu.:166.5   3rd Qu.:67.50  
                    Max.   :186.4   Max.   :91.73  

#데이터 표준편자 확인
sd(male_wh$Height_cm)
sd(male_wh$Weight_kg)
sd(female_wh$Height_cm)
sd(female_wh$Weight_kg)

#극단치 확인
#극단치를 제거할 것인가?
b1 <- boxplot(male_wh$Height_cm)$stats
b2 <- boxplot(male_wh$Weight_kg)$stats
b3 <- boxplot(female_wh$Height_cm)$stats
b4 <- boxplot(female_wh$Weight_kg)$stats

#극단치 범위에 포함되는 데이터 개수 파악
table(male_wh$Height_cm < b1[1,])
table(male_wh$Height_cm > b1[5,])
table(male_wh$Weight_kg < b2[1,])
table(male_wh$Weight_kg > b2[5,])
table(female_wh$Height_cm < b3[1,])
table(female_wh$Height_cm > b3[5,])
table(female_wh$Weight_kg < b4[1,])
table(female_wh$Weight_kg > b4[5,])
#상하위 0.3% 내외의 극단치들이 존재
#극단치를 제거하기로 결정

#극단치 제거
male_wh$Height_cm <- ifelse(male_wh$Height_cm < b1[1,] | male_wh$Height_cm > b1[5,], NA, male_wh$Height_cm)
male_wh$Weight_kg <- ifelse(male_wh$Weight_kg < b2[1,] | male_wh$Weight_kg > b2[5,], NA, male_wh$Weight_kg)
female_wh$Height_cm <- ifelse(female_wh$Height_cm < b3[1,] | female_wh$Height_cm > b3[5,], NA, female_wh$Height_cm)
female_wh$Weight_kg <- ifelse(female_wh$Weight_kg < b4[1,] | female_wh$Weight_kg > b4[5,], NA, female_wh$Weight_kg)
male_wh_ev <- na.omit(male_wh)
female_wh_ev <- na.omit(female_wh)

#극단치를 제거한 데이터의 요약 통계량 출력
summary(male_wh_ev)
summary(female_wh_ev)
#평균과 중앙값에는 유의미한 변화가 없음

#극단치를 제거한 데이터 표준편자 확인
sd(male_wh_ev$Height_cm)
sd(male_wh_ev$Weight_kg)
sd(female_wh_ev$Height_cm)
sd(female_wh_ev$Weight_kg)
#전체적으로 표준편차가 0.3정도 줄었음을 확인

#남성의 키/몸무게 상관관계 확인
cor(male_wh_ev$Height_cm, male_wh_ev$Weight_kg, method = "pearson")
#0.8508444

#여성의 키/몸무게 상관관계 확인
cor(female_wh_ev$Height_cm, female_wh_ev$Weight_kg, method = "pearson")
#0.8410599

#남성의 키-몸무게 상관관계가 여성의 키/몸무게 상관관계보다 약간 더 강한 양의 상관관계임을 확인

#남성의 키-몸무게 상관관계 그래프 및 추세선
plot(Weight_kg ~ Height_cm, data = male_wh_ev, xlab = "키(cm)", ylab = "몸무게(kg)")
abline(lm(Weight_kg ~ Height_cm, data = male_wh_ev), col = "blue", lwd = 3)

#여성의 키-몸무게 상관관계 그래프 및 추세선
plot(Weight_kg ~ Height_cm, data = female_wh_ev, xlab = "키(cm)", ylab = "몸무게(kg)")
abline(lm(Weight_kg ~ Height_cm, data = female_wh_ev), col = "red", lwd = 3)

##그래프 그리기
tm <- weight_height [weight_height $Gender=="Male",]
tf <- weight_height [weight_height $Gender=="Female",]

#키에 관한 그래프프
ggplot () +
  geom_histogram(data = tm,aes(x=Height),fill="blue",alpha=.3,bins = 50) +  
  geom_histogram(data = tf,aes(x=Height),fill="red",alpha=.3,bins = 50) +
  geom_vline(aes(xintercept = mean(tm$Height)),
             color="blue", linetype="dashed", size=1) +
  geom_vline(aes(xintercept = mean(tf$Height)),
             color="red", linetype="dashed", size=1)

#몸무게에 관한 그래프
ggplot () +
  geom_histogram(data = tm,aes(x=weight),fill="blue",alpha=.3,bins = 50) +  
  geom_histogram(data = tf,aes(x=weight),fill="red",alpha=.3,bins = 50) +
  geom_vline(aes(xintercept = mean(tm$weight)),
             color="blue", linetype="dashed", size=1) +
  geom_vline(aes(xintercept = mean(tf$weight)),
             color="red", linetype="dashed", size=1)

#키의 cut off 구하기
meanresult = 10000;meanheight = 0
for(i in 1:(max(tc1$Height))){
  #mean보다 여자 키가 클때 error1
  error1cnt = count(tm[tf$Height>i,])
  #mean보다 남자 키가 작을때 error2
  error2cnt = count(tm[tm$Height<i,])
  if (error1cnt+error2cnt < meanresult){
    meanresult = error1cnt+error2cnt
    meanheight = i
  }
}
meanheight 
meanresult #최소 에러 갯수

#몸무게의 cut off 구하기
meanweightresult = 10000;meanweight = 0
for(i in 1:(max(tc1$weight))){
  #mean보다 여자 키가 클때 error1
  error1cnt = count(tm[tf$weight>i,])
  #mean보다 남자 키가 작을때 error2
  error2cnt = count(tm[tm$weight<i,])
  if (error1cnt+error2cnt < meanweightresult){
    meanweightresult = error1cnt+error2cnt
    meanweight = i
  }
}
meanweight 
meanweightresult
#최소 에러 갯수 가 height가 더 적음으로, Height를 사용하는것이 최적


#cut off를 구한 키 그래프
ggplot () +
  geom_histogram(data = tm,aes(x=Height),fill="blue",alpha=.3,bins = 50) +  
  geom_histogram(data = tf,aes(x=Height),fill="red",alpha=.3,bins = 50) +
  geom_vline(aes(xintercept = meanheight),
             color="black", linetype="dashed", size=1) 
             

#cut off를 구한 몸무게 그래프
ggplot () +
  geom_histogram(data = tm,aes(x=weight),fill="blue",alpha=.3,bins = 50) +  
  geom_histogram(data = tf,aes(x=weight),fill="red",alpha=.3,bins = 50) +
  geom_vline(aes(xintercept = meanweight),
             color="black", linetype="dashed", size=1) 

library(ggplot2)

ggplot() + 
  geom_point(data = tm,aes(x=Height,y=weight),color="blue",alpha=.2)+ 
  geom_smooth(method = "lm",formula = y~splines::ns(x, 2)) +
  geom_point(data = tf,aes(x=Height,y=weight),color="red",alpha=.2)+
  #geom_abline(slope = slope,intercept = int) +
  geom_smooth(data = tf,aes(x=Height,y=weight),color="red",method = "lm",formula = y~x)+
  geom_vline(aes(xintercept = meanheight),
           color="black", linetype="dashed", size=1)+ 
  geom_hline(yintercept = meanweight)

#Height 선을 직선 경계 결정선으로 사용

직선 경계 결정선을 어떻게 구해야할지 생각

ggplot() + geom_point(mapping = aes(x=Height_cm, y=Weight_kg), data = male_wh_ev, col="blue", alpha = 0.5) + geom_point(mapping = aes(x=Height_cm, y=Weight_kg), data = female_wh_ev, col="red", alpha = 0.5) + geom_abline(intercept=90, slope=-0.1)
#y=-x+240 그래프를 기준으로 남/여 구분
#산점도의 형태가 길게 늘어진 형태라 기울기가 0에 가까울 수록 정확한 결과를 가져올 것이라 생각
#기울기를 -0.1이라 잡고 가장 적은 오류를 가져올 것이라 판단되는 y절편을 선택

임의로 직선을 그릴수 있을 것

###예측함수 생성###
forecast_both<-c()
both_guess <- function(matrix){
  for (i in 1:nrow(matrix)){
    x <- matrix[i,1]
    y <- matrix[i,2]
    if (y>=-0.1*x+90){
      forecast_both <- rbind(forecast_both,"Male")
    }
    else{
      forecast_both <- rbind(forecast_both,"Female")
    }
  }
  forecast_both <- data.frame(forecast_both)
}

#본래 성별과 예측 성별 병합
result_both <- data.frame(Original = both_wh[,1], Forecast = both_guess(both_wh[,-1]))

#table함수를 이용하여 오류 값 개수 파악
table(result_both[,1]==result_both[,2])

#904개의 오류
#9.15% 오류율을 가지는 모델

################### ###
###항공대에 적용하려면 어떻게 해야할까?###

#항공대의 성비가 남:여=5:1정도라고 가정했을 때, 두가지 상황이 존재한다.

#1, 남 여 합쳐 1만명의 데이터가 주어졌을 때 (즉, 수집된 데이터의 성비가 5:1일 때)
#2, 남 여 각각 5천명의 데이터가 주어졌을때 (즉, 수집된 데이터의 성비가 1:1일 때)

#1번의 상황에서 전세계 남/여의 구분 예측모델을 작성하기 위해서는 여성의 분포를 5배 해주는 것이 맞다고 생각. 하지만 항공대생들의 키/몸무게 분포를 확인하기 위해서는 그대로 반영.

#2번의 상황에서 전세계 남/여의 구분 예측모델을 작성하기 위해서는 스케일링 없이 작성해도 된다고 생각. 하지만 항공대생들의 키/몸무게 분포를 확인하기 위해서는 남자의 분포를 5배 늘려줘야한다고 생각.
```