연속형 변수 ~ 범주형 변수(외래관광실태조사)

2018년 코로나 이전 방한관광객 데이터를 바탕으로 범주형 변수와 연속형 변수간 관계를 몇가지 분석해보았다. 

https://know.tour.go.kr/stat/fReportsOfForeignerDis19Re.do 요기서 다운 받으면 된다. 데이터가 재미있는게 많아서 아동청소년패널데이터와 함께 심심할 때 이것저것 해보기 좋다. 

 

1. 데이터 선택 

- 이유는 모르겠지만 그냥 일본, 중국, 대만, 베트남을 분석대상으로 삼았다. 코드북을 보면 여러 나라가 있으나 위 나라가 역시 숫자가 많다. 데이터 선택 방법은 여러가지가 있지만 R알못이라 나는 subset함수가 가장 편하다. if구문으로 전부 선택하려면 복잡하니 데이터를 많이 남겨도 아래 방법이 편하다. 

library(dplyr)
library(ggplot2)
#국가별로 묶기(일본, 중국, 대만, 베트남) ##https://know.tour.go.kr/stat/fReportsOfForeignerDis19Re.do
a1<-subset(a, a$D_COU1 == 1)
a2<-subset(a, a$D_COU1 == 2)
a3<-subset(a, a$D_COU1 == 5)
a4<-subset(a, a$D_COU1 == 19)
a<-rbind(a1,a2,a3,a4)

 

 

관광 패널은 친절하게도 범주형 변수가 정수형으로 다 되어 있다. 그렇지만 난 factor화 시키려 한다.

이외에 지출 금액이 3편차 이상은 결측화 하였다. 한국에 이렇게 돈을 많으 써주시는 분들이 있다는 것에 놀라고 감사하지만 분석을 위해서는 제거해야 한다.  

#명목 또는 범주형변수화
##id는 만들어주자
id<-seq(1,nrow(a))
d<-data.frame(id)

##국가
d$count<-factor(a$D_COU1, levels = c(1,2,5,19), labels = c("japan", "china", "thai", "viet"))

##성별
d$gen<-a$D_GEN%>%
  factor(., levels = c(1,2), labels = c("m","f"))

##연령
d$age<-a$D_AGE%>%
  factor(., levels = c(1,2,3,4,5,6), labels = c("15_20", "21_30", "31_40", "41_50", "51_60", "61_"))

##동행인
d$mate<-a$Q2A1%>%
  factor(., levels = c(1,2,3,4), labels = c("alone", "family", "friend", "coworker"))

##지출
d$pay_total<-a$Q14_1T%>%
  as.numeric()%>%
  ifelse(.>mean(.) + 3*sd(.), NA ,.)

그리고 데이터를 보면 결측치들이 있다. ggplot2패키지의 remove_missing 함수로 날려버리자

summary(d)
       id         count      gen         age             mate        pay_total       
 Min.   :   1   japan:1968   m:2387   15_20: 243   alone   :1687   Min.   :    7.71  
 1st Qu.:1615   china:2519   f:4070   21_30:2202   family  :2167   1st Qu.:  607.44  
 Median :3229   thai :1222            31_40:1510   friend  :1926   Median :  897.62  
 Mean   :3229   viet : 748            41_50:1060   coworker: 651   Mean   : 1253.59  
 3rd Qu.:4843                         51_60:1083   NA's    :  26   3rd Qu.: 1413.82  
 Max.   :6457                         61_  : 359                   Max.   :30008.94  
                                                                   NA's   :13       
                                                                   
                                                                   
###결측지 있는 친구들 삭제
d%>%
  remove_missing()->d
summary(d)
         id         count      gen         age             mate        pay_total       
 Min.   :   1   japan:1962   m:2376   15_20: 242   alone   :1682   Min.   :    7.71  
 1st Qu.:1609   china:2490   f:4042   21_30:2194   family  :2164   1st Qu.:  607.47  
 Median :3228   thai :1220            31_40:1495   friend  :1924   Median :  897.07  
 Mean   :3229   viet : 746            41_50:1054   coworker: 648   Mean   : 1253.81  
 3rd Qu.:4849                         51_60:1076                   3rd Qu.: 1413.71  
 Max.   :6457                         61_  : 357                   Max.   :30008.94  
Warning message:
Removed 39 rows containing missing values.

2. 테이블 만들기

테이블부터 만들어서 보자. 나는 눈이 어지러워 첫째자리에서 반올림 하였다.

##국가별 지출액
pay_coun<-round(tapply(d$pay_total, d$count, mean),-1)
print(pay_coun)
japan china  thai  viet 
  790  1710  1070  1260 
  
##성별별_지출액
pay_gen<-round(tapply(d$pay_total, d$gen, mean),-1)
print(pay_gen)
   m    f 
1190 1290 

##연령대별_지출액
pay_age<-round(tapply(d$pay_total, d$age, mean),-1)
print(pay_age)
15_20 21_30 31_40 41_50 51_60   61_ 
 1160  1250  1400  1220  1180  1030 
 
##동행인별_지출액
pay_mate<-round(tapply(d$pay_total, d$mate, mean),-1)
print(pay_mate)
   alone   family   friend coworker 
    1430     1120     1310     1070

국가별로 역시 중국... 연령은 대충 30대 그리고 혼자온 사람들이 많이 썼다. 뭐 당연한 결과이긴 하다.

추론 통계가 필요할까 하지만 해보자

 

3. 추론통계

#지출액~국가

one-way anova이고 레벨은 4개국이니 4다

대충 봐도 유의 할거 같깉 했지만 어쨌든 차이가 유의 하다.

l1<-aov(d$pay_total ~ d$count)
> summary(l1)
              Df    Sum Sq   Mean Sq F value Pr(>F)    
d$count        3 9.847e+08 328242157   180.1 <2e-16 ***
Residuals   6414 1.169e+10   1822970                   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

다중 비교를 해야하니 scheffe검정을 하였다.

##scheffe
library(DescTools)
ScheffeTest(l1)

  Posthoc multiple comparisons of means: Scheffe Test 
    95% family-wise confidence level

$`d$count`
                 diff      lwr.ci    upr.ci    pval    
china-japan  922.2281  808.258139 1036.1981 < 2e-16 ***
thai-japan   284.0579  146.405872  421.7100 2.9e-07 ***
viet-japan   467.7298  305.336741  630.1228 6.3e-14 ***
thai-china  -638.1702 -770.108028 -506.2323 < 2e-16 ***
viet-china  -454.4983 -612.076901 -296.9197 5.8e-14 ***
viet-thai    183.6719    8.201228  359.1425  0.0357 *  

---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

4. 시각화

나는 아무리 봐도 색감이 없다. 약간 보노보노 피피티 같이 나온다....

library(showtext)
pay_coun<-as.data.frame(pay_coun)
pay_coun$coun<-levels(d$count)

font_add("NANUM_H", regular = "폰트경로")
font_add("serious", regular = "폰트경로")
font_families()
showtext_auto()

gg<-c("#F0C659","#F08965", "#86A32C", "#E6F5BA")
ggplot(pay_coun, aes(coun, pay_coun))+
  geom_bar(stat = "identity", fill= gg)+
  labs(title="국가별 사용금액",
      x = "국가명",
      y = "쓴 돈")+
  theme(plot.title = element_text(color = "#B0F043", 
                                family = "NANUM_H", size = 30),
        axis.title.x = element_text(color = "#A37C4E", 
                                    family = "serious", size = 24),
        axis.title.y = element_text(color = "#5B88F0", 
                                    family = "serious", size = 24))