Contents

  1. NA 체크 (N/A Check)
  2. 이상값 체크 (Outlier Checke)
  3. 현실성 체크 (Realistic Check)
  4. 개별 컬럼 시각화 (Single Feature Visualization)
  5. 파생변수 생성 (Feature Engineering)
  6. 연관관계 시각화 (Relationship Visaulization)

1. NA값 체크

모든 테이블의 N/A 값 확인을 위하여 N/A 검사기를 제작하여 확인한다.

1.1 회원정보(customer) 테이블 N/A 검사

## N/A 검사기
for( i in 1 : ncol(customer)){
  x <- sum(is.na(customer[,i])) 
  if (x != 0){ 
    y <- paste(colnames(customer)[i] ," : ", round(x/nrow(customer), 3) *100, "% 의 NA 비율 보유" )
    print(y) 
  } else{
    paste("N/A값이 없습니다.")
  } 
}
## [1] "HOM_PST_NO  :  6.8 % 의 NA 비율 보유"

1.2 쇼핑업종 상품구매정보(shopping) 테이블 N/A 검사

## N/A 검사기
for( i in 1 : ncol(shopping)){
  x <- sum(is.na(shopping[,i])) 
  if (x != 0){ 
    y <- paste(colnames(shopping)[i] ," : ", round(x/nrow(shopping), 3) *100, "%") 
    print(y) 
  } else{
    paste("N/A값이 없습니다.")
  } 
}

1.3 쇼핑 외업종 상품구매정보(nonshopping) 테이블 N/A 검사

## N/A 검사기
for( i in 1 : ncol(nonshopping)){
  x <- sum(is.na(nonshopping[,i])) 
  if (x != 0){ 
    y <- paste(colnames(nonshopping)[i] ," : ", round(x/nrow(nonshopping), 3) *100, "%") 
    print(y) 
    } else{
    paste("N/A값이 없습니다.")
  } 
}

1.4 카테고리(category) 테이블 N/A 검사

## N/A 검사기
for( j in 1 : ncol(category)){
  x <- sum(is.na(category[,c(j)])) 
  if (x != 0){ 
    y <- paste(colnames(category)[j] ," : ", round(x/nrow(category), 3) *100, "%") 
    print(y) 
  } else{
    paste("N/A값이 없습니다.")
  } 
}
NA 값 탐색 정리
  • 전체 테이블 중 customer 테이블의 “HOM_PST_NO” 컬럼만 6.8 %의 비율로 NA 값이 존재하는 것을 확인할 수 있었다.

2. 이상치 (Outlier) 체크

이상치의 정의

변수의 분포에서 비정상적으로 분포를 벗어난 값이다. 각 변수의 분포에서 비정상적으로 극단값을 갖는 경우나 자료에 타당도가 없는 경우, 비현실적인 변수값들이 이에 해당한다. [네이버 백과사전]

  • 뒤에서 탐색할 부분에서 이상치라고 부를만한 것이 발견되지 않았음

3. Realistic 여부 체크 (현실적인 데이터인가?)

3.1 BUY_AM이 0인 경우

## BUY_AM이 0인 경우 
buy_am_is_0 <- temp_sho[ temp_sho$BUY_AM == 0 , c(3,4,9,13,14,15) ]

pd_s_zero <- as.character(unique(buy_am_is_0$PD_S_NM))
paste(" 구매금액(BUY_AM)이 0원인 상품은" , pd_s_zero, "입니다.")
##  [1] " 구매금액(BUY_AM)이 0원인 상품은 HOT 입니다."                   
##  [2] " 구매금액(BUY_AM)이 0원인 상품은 컵얼음 입니다."                
##  [3] " 구매금액(BUY_AM)이 0원인 상품은 봉지얼음 입니다."              
##  [4] " 구매금액(BUY_AM)이 0원인 상품은 팬시용품 입니다."              
##  [5] " 구매금액(BUY_AM)이 0원인 상품은 슬러피원액 입니다."            
##  [6] " 구매금액(BUY_AM)이 0원인 상품은 기타판매용소모품 입니다."      
##  [7] " 구매금액(BUY_AM)이 0원인 상품은 공병공박스 입니다."            
##  [8] " 구매금액(BUY_AM)이 0원인 상품은 소주공병 입니다."              
##  [9] " 구매금액(BUY_AM)이 0원인 상품은 맥주공병 입니다."              
## [10] " 구매금액(BUY_AM)이 0원인 상품은 기타 입니다."                  
## [11] " 구매금액(BUY_AM)이 0원인 상품은 바디보습 입니다."              
## [12] " 구매금액(BUY_AM)이 0원인 상품은 BB/파운데이션/컴팩트류 입니다."
정리
  • 총 12종류의 0원 상품이 있었으며, 환급이 되는 공병, 편의점에서 음료를 구매했을 경우 추가로 주는 얼음등 제공품류는 0원으로 영수증에 기록됨

  • 차후 변수에서 따로 처리를 하지는 않는다. 이 또한 라이프스타일의 하나로 반영하기로 함.

3.2 BUY_CT가 이상하게 높은 경우 ( > 1000)

over_1000 <- temp_sho[temp_sho$BUY_CT >= 1000, c(10,13)] %>%
  group_by(PD_S_NM) %>%
  summarise( avgct = round(mean(BUY_CT)))

paste("BUY_CT가 1000 이상인 상품의 수는", nrow(over_1000), "개 입니다")
## [1] "BUY_CT가 1000 이상인 상품의 수는 93 개 입니다"
paste("그 중에서 20개만을 샘플로 보면 다음과 같습니다")
## [1] "그 중에서 20개만을 샘플로 보면 다음과 같습니다"
sample_n(over_1000, 20)
## # A tibble: 20 x 2
##           PD_S_NM avgct
##             <chr> <dbl>
##  1 호주산목초비육  1482
##  2 호주산곡물비육  1598
##  3     반건고등어  1110
##  4   수입냉동연어  1706
##  5   고당도바나나  1358
##  6     NB돼지고기  1437
##  7           석화  1094
##  8             마  1128
##  9           연근  1254
## 10       기타조개  2070
## 11         활어회  1055
## 12       한우채끝  1376
## 13       한우안심  1551
## 14       산지한우  1396
## 15           고추  1068
## 16         코다리  1016
## 17         명태알  1024
## 18         랍스터  1689
## 19         주꾸미  1452
## 20       일반수박  3256
정리
  • 대부분이 g이나 kg등으로 무게를 측정하는 상품류인 육류나 과일류인 것으로 미루어보아 BUY_CT 변수는 갯수뿐 아니라 무게도 나타내는 숫자가 섞여서 사용되고 있음을 알 수 있었다.

  • 따라서, BUY_CT 변수를 정제없이 feature로 사용하기엔 부적절함을 확인함

3.3 영수증번호 쇼핑업종 상품코드 모두같은데 금액이 다른 데이터 존재

rct_biz_pdc_same <- temp_sho %>%
  mutate( temp_div = paste(RCT_NO, BIZ_UNIT.x, PD_S_C.x, sep="-"),
          ct_multiple_am = BUY_AM*BUY_CT ) %>%
  select(temp_div, ct_multiple_am, PD_S_NM) %>%
  group_by(temp_div, PD_S_NM) %>%
  summarise( n = n() ) %>%
  filter( n >= 2)
## Warning in BUY_AM * BUY_CT: NAs produced by integer overflow
## [1] "영수증번호, 쇼핑업종, 상품코드가 같은 상품의 수는 399593 개 입니다"
## [1] "그 중에서 20개만을 샘플로 보면 다음과 같습니다"
##  [1] "트래디셔널"         "구강청정제"         "딸기"              
##  [4] "컵라면"             "수입과채혼합음료"   "과일음료"          
##  [7] "마켓피자"           "영캐주얼"           "다이소"            
## [10] "시금치"             "요리용치즈"         "참치회"            
## [13] "사과"               "옷걸이"             "기능성웰빙돼지고기"
## [16] "콘스낵"             "일반스낵"           "고추"              
## [19] "곡물가루"           "친환경채소(특약)"
정리
  • 한식의 경우 대표적인 예시였는데, 소카테고리의 경우 개별 제품을 대표하지 않을 수 있다는 사실을 알 수 있음

  • 가령, 한식이라고 PD_S_NM이 적혀있더라도 다른 한식의 종류가 더 있을 수 있다는 의미이다.

4. 개별 컬럼 시각화 ( Single Column Visualization )

4.1 고객정보(customer) 테이블

head(customer, 5) ## head를 통한 테이블 뷰 생성
##   ID GENDER AGE_PRD HOM_PST_NO
## 1  1      1   60PRD         52
## 2  2      2   60PRD         80
## 3  3      2   60PRD        620
## 4  4      1   60PRD        120
## 5  5      1   60PRD         NA
glimpse(customer) ## 컬럼 요약
## Observations: 20,000
## Variables: 4
## $ ID         <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...
## $ GENDER     <int> 1, 2, 2, 1, 1, 2, 2, 2, 2, 1, 1, 2, 2, 1, 2, 2, 2, ...
## $ AGE_PRD    <fctr> 60PRD, 60PRD, 60PRD, 60PRD, 60PRD, 60PRD, 60PRD, 6...
## $ HOM_PST_NO <int> 52, 80, 620, 120, NA, 58, 52, 480, 470, 55, 72, 61,...
summary(customer) ## 값 요약
##        ID            GENDER       AGE_PRD       HOM_PST_NO   
##  Min.   :    1   Min.   :1.000   20PRD:2339   Min.   :  0.0  
##  1st Qu.: 5001   1st Qu.:1.000   30PRD:5053   1st Qu.: 56.0  
##  Median :10000   Median :2.000   40PRD:5183   Median :130.0  
##  Mean   :10000   Mean   :1.609   50PRD:4744   Mean   :214.9  
##  3rd Qu.:15000   3rd Qu.:2.000   60PRD:2681   3rd Qu.:420.0  
##  Max.   :20000   Max.   :2.000                Max.   :630.0  
##                                               NA's   :1365
nrow(customer) ## customer 테이블 row 수
## [1] 20000

4.1.1 ID

ID의 갯수가 중복이 없는지 확인한다.

if (length(customer$ID) == length(unique(customer$ID))){
  print(paste("ID 갯수는 중복 없이", length(customer$ID),"개 입니다."))
}
## [1] "ID 갯수는 중복 없이 20000 개 입니다."

4.1.2 GENDER

tempGender <- customer$GENDER
tempGender <- ifelse(tempGender == 1, "남자", "여자")
prop.table(table(tempGender))
## tempGender
##    남자    여자 
## 0.39075 0.60925
ggplot(data.table(tempGender), aes(x=tempGender, color=tempGender, fill = tempGender) ) + 
  geom_bar(width=0.5) +
  ggtitle("LPOINT 회원 성별 분포")

4.1.3 AGE_PRD

prop.table(table(customer$AGE_PRD)) 
## 
##   20PRD   30PRD   40PRD   50PRD   60PRD 
## 0.11695 0.25265 0.25915 0.23720 0.13405
ggplot(customer, aes(x=AGE_PRD, color = AGE_PRD, fill = AGE_PRD)) + 
  geom_bar(width=0.5) +
  ggtitle("LPOINT 회원 연령 분포")

  • 롯데의 주요 고객층은 3~50대에 분포해있으며, 20대와 60대의 고객층이 상대적으로 적은 것을 시각적으로 확인할 수 있다.

4.1.4 HOM_PST_NO

ggplot(data = subset(customer, !is.na(HOM_PST_NO)), aes(x=HOM_PST_NO, color = HOM_PST_NO, fill = HOM_PST_NO)) +
  geom_histogram(binwidth = 5) + 
  ggtitle("HOM_PST_NO")

  • N/A값 데이터 탐색시에 유일하게 N/A 값이 발견된 컬럼이므로 ggplot 사용시 N/A 처리를 위하여 subset으로 N/A 값을 제거하고 그래프를 그려준다.

  • LPOINT 이용자가 확연히 몰려있는 지역이 있는 것을 확인할 수 있다.

  • 따라서, 이용자 500명 이상 지역 기준으로 뎁스를 한번 더 들어가 분석을 실행한다.

temp <- na.omit(customer) ## NA 값 핸들링
customer_idCount_byHOM_PST_NO <- sqldf(
  'select "HOM_PST_NO", count("ID")
  from temp
  group by HOM_PST_NO
  having count(ID) >= 500
  order by count(ID) desc') ## 500개 이상의 ID 값을 가지고 있는 지역을 추출

top5_custo <- customer[ customer$HOM_PST_NO %in% customer_idCount_byHOM_PST_NO$HOM_PST_NO,]

print(customer_idCount_byHOM_PST_NO)
##   HOM_PST_NO count("ID")
## 1        100        1004
## 2         55         914
## 3        160         595
## 4        470         594
## 5        130         539
## 6        480         504
## 7        460         503
  • 100, 55, 160, 470, 130, 480, 460 지역 (HOM_PST_NO) 순으로 높은 회원수 보유하고 있었다.
## 500명 이상의 연령분포
ggplot(top5_custo, aes(x=AGE_PRD, color = AGE_PRD, fill = AGE_PRD)) + 
  geom_bar(width=0.5) +
  ggtitle("LPOINT 회원 지역별 연령 분포") +
  facet_wrap(~ HOM_PST_NO)

## 500명 이상 보유 지역의 성별 분포
ggplot(top5_custo, aes(x=GENDER, color = GENDER, fill = GENDER)) + 
  geom_bar(width=0.5) +
  ggtitle("LPOINT 회원 지역별 성별 분포") +
  facet_wrap(~ HOM_PST_NO)

custo_HOM_PST_NO_55 <- customer %>% 
  filter(HOM_PST_NO==55)

paste("55번 지역의 성별 분포")
## [1] "55번 지역의 성별 분포"
prop.table(table(ifelse(custo_HOM_PST_NO_55$GENDER == 1, "남자","여자")))
## 
##      남자      여자 
## 0.3238512 0.6761488
paste("전체 지역의 성별 분포")
## [1] "전체 지역의 성별 분포"
prop.table(table(custo_HOM_PST_NO_55$AGE_PRD))
## 
##      20PRD      30PRD      40PRD      50PRD      60PRD 
## 0.04595186 0.16411379 0.28665208 0.27133479 0.23194748
  • 55번 지역 특이지역 발견
    • 여성비율이 전체 평균보다 약 6.7% 높고, 60대의 비율 높음, 30대의 비율 낮음
HOM_PST_NO 정리
  • 회원수가 500명 이상되는 지역을 7구역 추출하였으며, 이 중 55번 지역의 경우 성별 비율에서 전체데이터보다 여성의 비율이 7% 가량 높은 것을 확인할 수 있었다.

  • 차후 특정 지역을 타게팅한 모델링 시에 55번 지역에 맞춘 모델링을 별도로 할 경우 높은 예측력을 가질 수 있을 것으로 기대됨

4.2 쇼핑 업종 테이블 (shopping)

## 
Read 84.6% of 3641082 rows
Read 3641082 rows and 9 (of 9) columns from 0.160 GB file in 00:00:03
head(shopping, 5) ## head를 통한 테이블 뷰 생성
##      ID RCT_NO BIZ_UNIT PD_S_C BR_C    DE_DT DE_HR BUY_AM BUY_CT
## 1: 4008   2108   백화점    215    2 20150216    13  59600      2
## 2: 6379   2109   백화점     75   29 20150213    11  35000      1
## 3: 6379   2109   백화점    149    4 20150115    10  85000      1
## 4: 8002   2110   백화점    138   10 20151220    10  25000      1
## 5: 8002   2110   백화점    138   10 20151220    10  21000      1
glimpse(shopping) ## 컬럼 요약
## Observations: 3,641,082
## Variables: 9
## $ ID       <int> 4008, 6379, 6379, 8002, 8002, 8002, 7252, 5072, 5072,...
## $ RCT_NO   <int> 2108, 2109, 2109, 2110, 2110, 2110, 2111, 2112, 2112,...
## $ BIZ_UNIT <chr> "백화점", "백화점", "백화점", "백화점", "백화점", "백화점", "백화점", "백화점...
## $ PD_S_C   <int> 215, 75, 149, 138, 138, 558, 13, 223, 216, 121, 121, ...
## $ BR_C     <int> 2, 29, 4, 10, 10, 4, 29, 2, 2, 2, 2, 37, 37, 1, 2, 29...
## $ DE_DT    <int> 20150216, 20150213, 20150115, 20151220, 20151220, 201...
## $ DE_HR    <int> 13, 11, 10, 10, 10, 10, 10, 12, 12, 11, 11, 14, 14, 1...
## $ BUY_AM   <int> 59600, 35000, 85000, 25000, 21000, 79200, 5400, 15800...
## $ BUY_CT   <int> 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1,...
summary(shopping) ## 값 요약
##        ID            RCT_NO         BIZ_UNIT             PD_S_C      
##  Min.   :    1   Min.   :     1   Length:3641082     Min.   :   1.0  
##  1st Qu.: 3861   1st Qu.: 59806   Class :character   1st Qu.: 123.0  
##  Median : 7463   Median :135039   Mode  :character   Median : 437.0  
##  Mean   : 8332   Mean   :156403                      Mean   : 568.9  
##  3rd Qu.:12516   3rd Qu.:239189                      3rd Qu.: 993.0  
##  Max.   :20000   Max.   :481781                      Max.   :1627.0  
##       BR_C            DE_DT              DE_HR          BUY_AM         
##  Min.   :   1.0   Min.   :20141229   Min.   : 0.0   Min.   :        0  
##  1st Qu.:  11.0   1st Qu.:20150404   1st Qu.:14.0   1st Qu.:     2000  
##  Median :  36.0   Median :20150630   Median :16.0   Median :     4480  
##  Mean   : 185.4   Mean   :20150622   Mean   :16.3   Mean   :    24818  
##  3rd Qu.: 106.0   3rd Qu.:20150925   3rd Qu.:19.0   3rd Qu.:    10000  
##  Max.   :4828.0   Max.   :20151231   Max.   :23.0   Max.   :166030000  
##      BUY_CT        
##  Min.   :    1.00  
##  1st Qu.:    1.00  
##  Median :    1.00  
##  Mean   :   12.49  
##  3rd Qu.:    1.00  
##  Max.   :10050.00
paste("shopping 테이블의 총 데이터 건수 : ",nrow(shopping) )
## [1] "shopping 테이블의 총 데이터 건수 :  3641082"

4.2.1 ID

paste("ID 갯수는 중복 없이", length(unique(shopping$ID)),"개 입니다.")
## [1] "ID 갯수는 중복 없이 18550 개 입니다."
  • 전체 등록 회원 수는 20,000명이었던 반면, 실제 유통 구매데이터가 1건이라도 있는 회원 수는 18,550명으로 나타났다.
## 영수증 번호 유니크
temp <- unique(paste(shopping$RCT_NO,shopping$BIZ_UNIT))
cnt_customer_buying <- sum(temp==temp) ## 갯수 카운트

## 아이디 유니크
temp2 <- unique(customer$ID)
unique_customer_buying <- sum(temp2==temp2) ## id의 unique를 확인

avg_buying_count <- cnt_customer_buying / unique_customer_buying
paste("회원 한명당 평균 구매 건수는", round(avg_buying_count, 1), "건 입니다.")
## [1] "회원 한명당 평균 구매 건수는 52.6 건 입니다."

4.2.2 RCT_NO

ggplot(shopping, aes(x = RCT_NO, color = RCT_NO, fill = RCT_NO)) +
  geom_bar()

  • 영수증번호(RCT_NO)의 경우 25건 이상이 일정부분 이상치인 것으로 관측됨
rctCnt_over_25 <- shopping %>%
  group_by(RCT_NO, BIZ_UNIT) %>%
  summarise( cntRct = n() ) %>%
  filter( cntRct > 25 )

rctno_over_25 <- rctCnt_over_25$RCT_NO
paste("전체 영수증 중의 약 ",round(nrow(unique(rctCnt_over_25)) / length(unique(shopping$RCT_NO)), 3)*100, "% 가 25건 이상 구매함")
## [1] "전체 영수증 중의 약  1.3 % 가 25건 이상 구매함"
shopping_rctCnt_over_25 <- shopping[shopping$RCT_NO %in% rctno_over_25,]

## 평균 구매액
paste("전체 평균 구매액 : ", round(mean(shopping$BUY_AM), 1), "원" ) 
## [1] "전체 평균 구매액 :  24818.4 원"
paste("25건 이상 구매한 건의 평균 구매액 : ", round(mean(shopping_rctCnt_over_25$BUY_AM), 1), "원" )
## [1] "25건 이상 구매한 건의 평균 구매액 :  11824.3 원"
  • 전체 영수증 중 25건 이상 구매한 건의 특징 분석 결과, 오히려 많은 갯수를 구매한 영수증일수록 평균 거래금액이 약 만원가량 낮았다.
count_customer_shopping <-
  sqldf('select "ID", count("RCT_NO") as RCT_NO
        from shopping
        group by ID
        order by count(RCT_NO) desc'
  )

head(count_customer_shopping)
##      ID RCT_NO
## 1 16742   5469
## 2  9677   3417
## 3  9990   3306
## 4   178   3187
## 5 12178   2520
## 6  4443   2341
  • 횟수로 최고 VIP 16742 회원, 2015년 기준 5469번 결제했다.
id16742 <- sqldf('select "ID", sum("BUY_AM")
      from shopping
      where ID = 16742')

head(id16742)
##      ID sum("BUY_AM")
## 1 16742      13092690
id_BUYAM_rank <- sqldf('select "ID", sum("BUY_AM")
                       from shopping
                       group by ID
                       order by sum(BUY_AM) desc')

head(id_BUYAM_rank)
##      ID sum("BUY_AM")
## 1 13087     611749918
## 2  7278     342051200
## 3  2807     323160907
## 4  9038     310334084
## 5  6663     284605677
## 6  2363     273316980
  • 하지만, 구매 건수가 많다고 해서 구매금액 기준으로 높은 순위를 기록하지는 않았다.

4.2.3 BIZ_UNIT

prop.table(table(shopping$BIZ_UNIT))
## 
##     대형마트 드러그스토어       백화점     슈퍼마켓       편의점 
##  0.474334827  0.006119335  0.256163690  0.207160399  0.056221749
ggplot(shopping, aes(x=BIZ_UNIT, color = BIZ_UNIT, fill = BIZ_UNIT)) + 
  geom_bar(width=0.5) +
  ggtitle("LPOINT 회원 채널별 이용 건수 비율")

- 대형마트(47.4%)에서 주로 포인트 적립을 한다는 것을 알 수 있었다.

4.2.4 DE_DT

month <- substr(shopping$DE_DT, 5, 6)

shopping%>%
  ggplot(., aes(x=month, color=month, fill=month))+
  geom_bar()+
  ggtitle("월별 분포")

4.2.5 DE_HR

shopping%>%
  ggplot(., aes(x=DE_HR))+
  geom_bar()+
  ggtitle("시간별 분포")

4.2.6 BUY_AM, BUY_CT ~ 평균 이용금액, 평균 이용건수

## 이용금액
## 평균
sum(as.numeric(shopping$BUY_AM)) / length(unique(shopping$ID)) # 평균 4,871,479원
## [1] 4871479
## 중앙값
shopping%>%
  group_by(ID)%>%
  summarise(AMOUNT = sum(BUY_AM))%>%
  arrange(AMOUNT)%>%
  summarise(mid = median(AMOUNT)) # 중앙값 1,846,396원 
## # A tibble: 1 x 1
##       mid
##     <dbl>
## 1 1846396
## 사분위수  
id_amount <- shopping%>%
  group_by(ID)%>%
  summarise(AMOUNT = sum(BUY_AM))%>%
  arrange(AMOUNT)
quantile(id_amount$AMOUNT)
##        0%       25%       50%       75%      100% 
##       400    486750   1846396   4875316 611749918
  • 평균이 3사분위수와 거의 비슷한 수치를 보이고 있는데 이 말은 즉, 고객의 75%가 평균보다 적은 금액을 사용했고 상위 25%만이 평균보다 높은 금액을 사용한 것으로 해석된다.
## ID당 방문횟수
## 평균 방문횟수
x0 <- shopping %>%
  group_by(RCT_NO, BIZ_UNIT) %>%
  summarise( n = n())

round( nrow(x0) / length(unique(shopping$ID)) , 2 )
## [1] 56.68
## 중앙값
x <- shopping %>%
  mutate( temp = paste(RCT_NO, BIZ_UNIT)) %>%
  select(ID, temp, BUY_CT) %>%
  group_by(ID, temp) %>%
  summarise( count_ID_visit = length(BUY_CT) )

x <- x %>%
  group_by(ID) %>%
  summarise(count_visit_id = n())

paste("방문횟수의 중앙값은", median(as.vector(unlist(x[2]))) ,"입니다.")
## [1] "방문횟수의 중앙값은 35 입니다."
## 사분위수
quantile(as.vector(unlist(x[2])))
##   0%  25%  50%  75% 100% 
##    1   11   35   82 1192
quantile(as.vector(unlist(x[2])), 0.65)
## 65% 
##  59
data.table(sort(as.vector(unlist(x[2])))) %>%
  ggplot(. , aes(x= c(1:18550) , y = V1 )) +
  geom_line() +
  ggtitle("ID별 방문횟수 그래프") +
  labs(x = " ", y = "ID별 방문횟수")

정리
  • 사분위수에서 볼 수 있듯이, 평균은 약 65% 지점에 존재하므로 방문횟수가 많은 일부 ID가 평균을 끌어올렸음을 확인할 수 있었다.

  • 그래프에서 볼 수 있듯이, 그래프의 기울기가 급등하는 구간이 존재하므로 일부 헤비유져가 존재함을 알 수 있다.

4.3 쇼핑외 업종 테이블 (nonshopping)

head(shopping, 5) ## head를 통한 테이블 뷰 생성
##      ID RCT_NO BIZ_UNIT PD_S_C BR_C    DE_DT DE_HR BUY_AM BUY_CT
## 1: 4008   2108   백화점    215    2 20150216    13  59600      2
## 2: 6379   2109   백화점     75   29 20150213    11  35000      1
## 3: 6379   2109   백화점    149    4 20150115    10  85000      1
## 4: 8002   2110   백화점    138   10 20151220    10  25000      1
## 5: 8002   2110   백화점    138   10 20151220    10  21000      1
glimpse(shopping) ## 컬럼 요약
## Observations: 3,641,082
## Variables: 9
## $ ID       <int> 4008, 6379, 6379, 8002, 8002, 8002, 7252, 5072, 5072,...
## $ RCT_NO   <int> 2108, 2109, 2109, 2110, 2110, 2110, 2111, 2112, 2112,...
## $ BIZ_UNIT <chr> "백화점", "백화점", "백화점", "백화점", "백화점", "백화점", "백화점", "백화점...
## $ PD_S_C   <int> 215, 75, 149, 138, 138, 558, 13, 223, 216, 121, 121, ...
## $ BR_C     <int> 2, 29, 4, 10, 10, 4, 29, 2, 2, 2, 2, 37, 37, 1, 2, 29...
## $ DE_DT    <int> 20150216, 20150213, 20150115, 20151220, 20151220, 201...
## $ DE_HR    <int> 13, 11, 10, 10, 10, 10, 10, 12, 12, 11, 11, 14, 14, 1...
## $ BUY_AM   <int> 59600, 35000, 85000, 25000, 21000, 79200, 5400, 15800...
## $ BUY_CT   <int> 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1,...
summary(shopping) ## 값 요약
##        ID            RCT_NO         BIZ_UNIT             PD_S_C      
##  Min.   :    1   Min.   :     1   Length:3641082     Min.   :   1.0  
##  1st Qu.: 3861   1st Qu.: 59806   Class :character   1st Qu.: 123.0  
##  Median : 7463   Median :135039   Mode  :character   Median : 437.0  
##  Mean   : 8332   Mean   :156403                      Mean   : 568.9  
##  3rd Qu.:12516   3rd Qu.:239189                      3rd Qu.: 993.0  
##  Max.   :20000   Max.   :481781                      Max.   :1627.0  
##       BR_C            DE_DT              DE_HR          BUY_AM         
##  Min.   :   1.0   Min.   :20141229   Min.   : 0.0   Min.   :        0  
##  1st Qu.:  11.0   1st Qu.:20150404   1st Qu.:14.0   1st Qu.:     2000  
##  Median :  36.0   Median :20150630   Median :16.0   Median :     4480  
##  Mean   : 185.4   Mean   :20150622   Mean   :16.3   Mean   :    24818  
##  3rd Qu.: 106.0   3rd Qu.:20150925   3rd Qu.:19.0   3rd Qu.:    10000  
##  Max.   :4828.0   Max.   :20151231   Max.   :23.0   Max.   :166030000  
##      BUY_CT        
##  Min.   :    1.00  
##  1st Qu.:    1.00  
##  Median :    1.00  
##  Mean   :   12.49  
##  3rd Qu.:    1.00  
##  Max.   :10050.00
paste("nonshopping 테이블의 총 데이터 건수 : ",nrow(nonshopping) )
## [1] "nonshopping 테이블의 총 데이터 건수 :  178659"

4.3.1 ID

print(paste("쇼핑외업종을 이용한 고객은 ", length(unique(nonshopping$ID)),"명 입니다.", sep=''))
## [1] "쇼핑외업종을 이용한 고객은 17621명 입니다."

4.3.2 RCT_NO

prop.table(table(nonshopping$BIZ_UNIT))
## 
##         면세점       야구관람         여행사         영화관           카페 
##   0.0987075938   0.0028154193   0.0003862106   0.3360535993   0.2137647698 
##       테마파크 패밀리레스토랑     패스트푸드           호텔 
##   0.0705030253   0.0174186579   0.2393218366   0.0210288874
nonshopping %>%
  ggplot(. , aes(x=BIZ_UNIT, color = BIZ_UNIT, fill = BIZ_UNIT)) +
  geom_bar() +
  ggtitle("쇼핑외 업종 분포")

  • 주로 이용하는 쇼핑외업종은 영화관, 패스트푸드, 카페 순으로 나타났다.

4.3.3 CRYM

month <- substr(nonshopping$CRYM, 5, 6)

nonshopping %>%
  select(CRYM) %>%
  ggplot(., aes(x=month, color = month, fill = month)) +
  geom_bar() +
  ggtitle(" 월별 분포 ")

4.3.4 U_AM

temp <- sum(as.numeric(nonshopping$U_AM)) / length(unique(nonshopping$ID))
paste("1인당 고객당 비유통 평균 거래금액 : ", round(temp,1), "원")
## [1] "1인당 고객당 비유통 평균 거래금액 :  690969.8 원"
nonshopping %>%
  group_by(ID) %>%
  summarise(AMOUNT = sum(U_AM)) %>%
  ggplot(., aes(x=ID, y=AMOUNT)) +
  geom_line()

## 이용금액이 월등히 높은 고객 분석
nonshopping%>%
  group_by(ID)%>%
  summarise(AMOUNT = sum(U_AM))%>%
  arrange(desc(AMOUNT)) # 고객번호 16002
## # A tibble: 17,621 x 2
##       ID    AMOUNT
##    <int>     <int>
##  1 16002 358939042
##  2  6531 159791375
##  3  6207 144450199
##  4  1522  77452905
##  5   291  65521067
##  6 14858  59167863
##  7  1497  51070225
##  8 13014  45284700
##  9   483  45088310
## 10  1151  30696600
## # ... with 17,611 more rows
nonshopping[nonshopping$ID==16002, ] # 면세점만 이용했음
##        ID BIZ_UNIT   CRYM     U_AM U_CT
##  1: 16002   면세점 201504 50849507   67
##  2: 16002   면세점 201503 46202292   69
##  3: 16002   면세점 201505 36209031   47
##  4: 16002   면세점 201512 16731357   15
##  5: 16002   면세점 201510 12165358   10
##  6: 16002   면세점 201508 23777476   17
##  7: 16002   면세점 201509 16122565   12
##  8: 16002   면세점 201507 24658081   26
##  9: 16002   면세점 201511  8846315   11
## 10: 16002   면세점 201506 44386764   53
## 11: 16002   면세점 201501 42293614   58
## 12: 16002   면세점 201502 36696682   59
  • ID가 16002인 회원이 압도적으로 구매금액이 높은데, 모든 거래가 면세점 (B03)에서 이루어진 것을 알 수 있었다.

4.3.5 U_CT

temp <- nonshopping %>%
  group_by(ID) %>%
  summarise(COUNT = sum(U_CT)) %>%
  summarise(AVG_COUNT = mean(COUNT)) # 18.52398

paste("1인당 고객당 비유통 평균 거래건수 : ", round(temp,1), "건")
## [1] "1인당 고객당 비유통 평균 거래건수 :  18.5 건"
nonshopping%>%
  group_by(ID)%>%
  summarise(COUNT = sum(U_CT))%>%
  ggplot(., aes(x=ID, y=COUNT))+
  geom_line()

## 이용건수가 월등히 높은 고객 분석
nonshopping%>%
  group_by(ID)%>%
  summarise(COUNT=sum(U_CT))%>%
  arrange(desc(COUNT))
## # A tibble: 17,621 x 2
##       ID COUNT
##    <int> <int>
##  1   291   601
##  2  6207   470
##  3 16002   444
##  4 18429   336
##  5  3206   296
##  6  4445   261
##  7  1090   256
##  8  7093   242
##  9  1273   240
## 10  6922   239
## # ... with 17,611 more rows
nonshopping[nonshopping$ID==291, ]
##      ID   BIZ_UNIT   CRYM    U_AM U_CT
##  1: 291     면세점 201508 3542827   52
##  2: 291     면세점 201507 4517031   54
##  3: 291       카페 201504    8120    1
##  4: 291     면세점 201502 5772774   60
##  5: 291     면세점 201501 5335658   27
##  6: 291 패스트푸드 201508   14100    5
##  7: 291     면세점 201504 5583184   36
##  8: 291 패스트푸드 201506    5900    2
##  9: 291     면세점 201510 5465033   39
## 10: 291 패스트푸드 201503   30400   10
## 11: 291 패스트푸드 201505   54600    8
## 12: 291     면세점 201503 7291577   51
## 13: 291   테마파크 201501    6500    1
## 14: 291 패스트푸드 201512   34700    5
## 15: 291       카페 201509   11500    1
## 16: 291       호텔 201505   45200    1
## 17: 291 패스트푸드 201509   29900    7
## 18: 291 패스트푸드 201504   57900   13
## 19: 291 패스트푸드 201502   14200    6
## 20: 291     면세점 201511 5742657   50
## 21: 291     면세점 201512 3741056   33
## 22: 291 패스트푸드 201501   23800    3
## 23: 291       카페 201506   14400    1
## 24: 291 패스트푸드 201511   35100    6
## 25: 291       호텔 201504   42000    1
## 26: 291 패스트푸드 201510   32100    6
## 27: 291       카페 201505    7520    1
## 28: 291   테마파크 201502   24000    2
## 29: 291     면세점 201506 4660284   32
## 30: 291     면세점 201505 9222506   48
## 31: 291     면세점 201509 4128340   34
## 32: 291 패스트푸드 201507   26200    5
##      ID   BIZ_UNIT   CRYM    U_AM U_CT
temp <- nonshopping[nonshopping$ID==291, ]

temp %>%
  select(BIZ_UNIT, U_CT, U_AM) %>%
  ggplot(. , aes(x = BIZ_UNIT, y = U_CT, color = BIZ_UNIT, fill = BIZ_UNIT))+
  geom_bar(stat = "identity")

  • 구매 건수가 높은 ID의 경우에도 면세점 사랑은 계속 되었다.
nonshopping%>%
  group_by(MONTH=substr(nonshopping$CRYM,5,6),BIZ_UNIT)%>%
  summarise(COUNT=sum(U_CT))%>%
  ggplot(., aes(x=MONTH, y=COUNT, group=BIZ_UNIT, colour=BIZ_UNIT))+
  geom_line()+
  facet_wrap(~BIZ_UNIT)

  • 영화관의 이용건수가 6월부터 8월까지 가파르게 상승!
  • 베테랑 / 암살 등 흥행영화가 그 시기에 상영

4.3.6 BIZ_UNIT + CRYM + U_AM

nonshopping%>%
  group_by(MONTH=substr(nonshopping$CRYM,5,6),BIZ_UNIT)%>%
  summarise(AMOUNT=sum(U_AM))%>%
  ggplot(., aes(x=MONTH, y=AMOUNT, group=BIZ_UNIT, colour=BIZ_UNIT))+
  geom_line()+
  facet_wrap(~BIZ_UNIT)

  • 면세점의 이용금액이 8월에서 9월 사이 급격히 하락!
  • 메르스의 여파로 소비심리가 위축된 것으로 판단

4.3.7 DE_DT

shopping%>%
  group_by(month=substr(DE_DT, 5,6),BIZ_UNIT)%>%
  summarise(count=length(ID))%>%
  ggplot(., aes(x=month, y=count, group=BIZ_UNIT, color=BIZ_UNIT))+
  geom_line()

  • 면세점의 경우 시즌에 따른 변동 폭이 상대적으로 다른 계열사보다 더 크게 나타났다.
## 시간대별
shopping%>%
  group_by(DE_HR,BIZ_UNIT)%>%
  summarise(count=length(ID))%>%
  ggplot(., aes(x=DE_HR, y=count, group=BIZ_UNIT, color=BIZ_UNIT))+
  geom_line()

  • 대형마트나 슈퍼마켓의 경우 저녁 식사 시간(보통18시)이 지나면 고객이 좀 줄어드는 것을 확인할 수 있었다.

5. 파생변수 생성 (Feature Engineering)

5.1 테이블 병합

고객정보와 구매정보 merge
customer_shopping <- merge(customer, shopping, by="ID", all.y = TRUE)
customer_shopping$GENDER <- as.character(customer_shopping$GENDER)
customer_shopping$GENDER <- ifelse(customer_shopping$GENDER=='1','Male','Female')
고객정보와 쇼핑외업종 merge
customer_nonshopping <- merge(customer, nonshopping, by="ID", all.y = TRUE)
customer_nonshopping$GENDER <- as.character(customer_nonshopping$GENDER)
customer_nonshopping$GENDER <- ifelse(customer_nonshopping$GENDER=='1','Male','Female')

5.2 파생변수 생성

## 영수증번호와 업종 합친 파생변수 생성
customer_shopping$RCT_BIZ <- paste(customer_shopping$RCT_NO, customer_shopping$BIZ_UNIT, sep='')

## 월 변수 생성
customer_shopping$MONTH <- substr(customer_shopping$DE_DT, 5,6)
customer_nonshopping$MONTH <- substr(customer_nonshopping$CRYM, 5,6)

## 요일 변수 생성
customer_shopping$DE_DT <- as.character(customer_shopping$DE_DT)
customer_shopping$DE_DT <- as.Date(customer_shopping$DE_DT, "%Y%m%d")

customer_shopping$DAY <- paste(format(as.Date(customer_shopping$DE_DT)-1, '%w'),
                               format(as.Date(customer_shopping$DE_DT), '%A'), sep='')

6. 연관 관계 시각화 (Relationship Visulization)

6.1 성별에 따른 쇼핑업종/쇼핑외업종 이용건수 분석

6.1.1 성별 + 쇼핑업종 + 월별 + 이용건수(영수증번호와 업종 합친 파생변수 생성)

customer_shopping%>%
  group_by(BIZ_UNIT, MONTH, GENDER)%>%
  summarise(count = length(RCT_BIZ))%>%
  ggplot(., aes(x=MONTH, y=count, group=GENDER, colour=GENDER))+
  geom_line()+
  facet_wrap(~BIZ_UNIT)

  • 롯데마트의 8월에서 10월까지 이용객 수 하락은 가습기 살균제 사건의 여파로 추정할 수 있다.

  • 여행사와 호텔만 따로 비교 실시

customer_nonshopping%>%
  filter(BIZ_UNIT %in% c('여행사','호텔'))%>%
  group_by(BIZ_UNIT, MONTH, GENDER)%>%
  summarise(count = length(ID))%>%
  ggplot(., aes(x=MONTH, y=count, group=GENDER, colour=GENDER))+
  geom_line()+
  facet_wrap(~BIZ_UNIT)

  • 여행사와 호텔의 관계를 보기 위해 따로 봤지만 둘 사이의 관계는 딱히 찾을 수 없었다.

  • 다만 호텔은 남자가 오히려 이용건수가 많다.

6.1.2 성별 + 쇼핑업종 + 월별 + 이용건수(영수증번호와 업종 합친 파생변수 생성)

연령대에 따른 쇼핑업종/쇼핑외업종 이용 분석
연령대 + 쇼핑업종 + 월별 + 이용건수(영수증번호와 업종 합친 파생변수 생성)
customer_shopping%>%
  group_by(BIZ_UNIT, MONTH, AGE_PRD)%>%
  summarise(count = length(RCT_BIZ))%>%
  ggplot(., aes(x=MONTH, y=count, group=AGE_PRD, colour=AGE_PRD))+
  geom_line()+
  facet_wrap(~BIZ_UNIT)

  • 대형마트와 슈퍼마켓은 40대 고객이 가장 많았으나 백화점은 50대가 가장 많았다.
반응형
Posted by JoeSung
,
R_AIRBNB_Explaratory Data Analysis

[INDEX]

0. LOAD

1. EDA ( REFINE )

2. VISUALIZING

3. MODELLING

0. LOAD

For visualizing, get the “ggplot2”

library(ggplot2)
library(xgboost)
library(lattice)
library(caret)
library(magrittr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following object is masked from 'package:xgboost':
## 
##     slice
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

Load the airbnb data which are train and test.

train <- read.csv("train_users_2.csv", header = T)
test <- read.csv("test_users.csv", header = T)
air <- rbind(train[ ,-ncol(train)], test)

Check the row number of both table.

paste("train data :", nrow(train), ", test data :", nrow(test),
      "is available.")
## [1] "train data : 213451 , test data : 62096 is available."
paste("In total, train + test : ", nrow(air))
## [1] "In total, train + test :  275547"

1. EDA

Before we go with xgboost, we should take several questions such as 1. Is it realistic for data modelling? 2. Is “NA” values acceptable range? 3. Is Outlier values acceptable range?

1.0 ID delete for Explaratory Data Analysis

air <- air[,-1]

1.1 Finding Missing data

summary(air)
##  date_account_created timestamp_first_active  date_first_booking
##  2014-07-23:  1105    Min.   :2.009e+13                :124543  
##  2014-07-22:  1052    1st Qu.:2.013e+13      2014-05-22:   248  
##  2014-07-17:   978    Median :2.014e+13      2014-06-11:   231  
##  2014-07-24:   923    Mean   :2.013e+13      2014-06-24:   226  
##  2014-07-18:   892    3rd Qu.:2.014e+13      2014-05-21:   225  
##  2014-07-21:   888    Max.   :2.014e+13      (Other)   : 87978  
##  (Other)   :269709                           NA's      : 62096  
##        gender            age           signup_method     signup_flow    
##  -unknown-:129480   Min.   :   1.00   basic   :198222   Min.   : 0.000  
##  FEMALE   : 77524   1st Qu.:  28.00   facebook: 74864   1st Qu.: 0.000  
##  MALE     : 68209   Median :  33.00   google  :  2438   Median : 0.000  
##  OTHER    :   334   Mean   :  47.15   weibo   :    23   Mean   : 4.292  
##                     3rd Qu.:  42.00                     3rd Qu.: 1.000  
##                     Max.   :2014.00                     Max.   :25.000  
##                     NA's   :116866                                      
##     language          affiliate_channel   affiliate_provider
##  en     :265538   direct       :181571   direct    :181270  
##  zh     :  2634   sem-brand    : 36439   google    : 65956  
##  fr     :  1508   sem-non-brand: 20075   other     : 13036  
##  es     :  1174   seo          : 14362   facebook  :  3996  
##  ko     :  1116   other        :  9547   bing      :  3719  
##  de     :   977   api          :  8167   craigslist:  3475  
##  (Other):  2600   (Other)      :  5386   (Other)   :  4095  
##   first_affiliate_tracked   signup_app           first_device_type 
##  untracked    :143181     Android: 10519   Mac Desktop    :106328  
##  linked       : 62064     iOS    : 34593   Windows Desktop: 86948  
##  omg          : 54859     Moweb  : 10517   iPhone         : 39814  
##  tracked-other:  6655     Web    :219918   iPad           : 18036  
##               :  6085                      Other/Unknown  : 11167  
##  product      :  2353                      Android Phone  :  9458  
##  (Other)      :   350                      (Other)        :  3796  
##        first_browser  
##  Chrome       :78671  
##  Safari       :53302  
##  -unknown-    :44394  
##  Firefox      :38665  
##  Mobile Safari:29636  
##  IE           :24744  
##  (Other)      : 6135

time_first_active data form is different with date_account_created and date_first_booking, so should convert this into same date form.

1.2 Convert into dateform

air[,"timestamp_first_active"] <- trimws(air$timestamp_first_active) # remove white space
air[, "timestamp_first_active"] <- substr(air$timestamp_first_active, 1, 8) # trim hour, minutes and seconds
x <- air$timestamp_first_active
air$timestamp_first_active <- as.Date(x, "%Y%m%d") # convert string to date

1.3 Gender is unknown, so we need to convert this value as NA

train[, "gender"] <- gsub("-unknown-", NA , train[, "gender"])

1.4 Percentage of “NA” values

paste(" NA Percentages of each columns ")
## [1] " NA Percentages of each columns "
for( i in 1 : ncol(train)){
  x <- sum(is.na(train[,i]))
  if (x != 0){
    y <- paste(colnames(train)[i] ," : ", round(x/nrow(train), 3) *100, "%")
    print(y)
  }
}
## [1] "gender  :  44.8 %"
## [1] "age  :  41.2 %"

Each of Gender and Age has 45% and 41% of NA Values, So it isn’t enough for modelling. >> Let’s make them more fit

1.5 Refine age values

summary(train$age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##    1.00   28.00   34.00   49.67   43.00 2014.00   87990

There is weired values in age, which is “2014”. (Remeber, this is “age”)

x1 <- train[ train$age >= 120 & !is.na(train$age), "age"]
table(x1) 
## x1
##  132  150 1924 1925 1926 1927 1928 1929 1931 1932 1933 1935 1936 1938 1942 
##    1    1    2    1    1    1    2    2    3    3    1    1    2    1    1 
## 1947 1949 1952 1953 1995 2008 2013 2014 
##    2    3    1    1    1    1   39  710
sum(x1==x1) 
## [1] 781
x2 <- train[ train$age < 18 & !is.na(train$age), "age"]
table(x2) 
## x2
##  1  2  4  5 15 16 17 
##  2  7  3 45  8 26 67
sum(x2==x2) 
## [1] 158

There are 781 values who are higer than 120, and there are 158 values which stands for under 18 years even if airbnb doesn’t allow under 18 years. So we should change this whole values into mean value.

age_temp <- na.omit(train$age)
age_temp <- age_temp[age_temp > 18 & age_temp <= 120 ]
age_temp <- round(mean(age_temp),2)

Average age is 37.55 years.

train[ (train$age < 18 | train$age >= 120 ) & !is.na(train$age) , "age"]  <- age_temp
train[ is.na(train$age), "age"] <- age_temp
table(is.na(train[, "age"]))
## 
##  FALSE 
## 213451

Refine complete.

2. EDA - VISUALIZING

x <- data.frame(table(air$gender))
colnames(x) <- c("gender","count")

ggplot(x, aes(x=gender,y=count)) +
  geom_bar(stat="identity", width = 0.5, fill = "deepskyblue") +
  geom_text(aes(label=count), vjust = 1.5, color = "white", size = 3.7) +
  theme_minimal()

As we can see in this graph, gender is not the values which gives diffrences.

x2 <- data.frame(table(air$signup_method))
colnames(x2) <- c("signup_method","count")

ggplot(x2, aes(x=signup_method, y = count)) +
  geom_bar(stat="identity", width = 0.5, fill = "orangered2") +
  geom_text(aes(label = count), vjust = 1.5 , color = "black", size = 3.7) +
  theme_minimal()

3. Apply XGBoost

### TRAIN/TEST

train_temp <- air[1:nrow(train),]
train_temp$label <- train$country_destination

#test <- air[nrow(train_temp)+1:nrow(air),] # ?????? test set
### train_temp / test_temp??? train set 30%
set <- round(nrow(train_temp)*0.7)
temp_train <- train_temp[1:set,]
temp_test <- train_temp[(set+1):nrow(train_temp),]
#actual <- temp_test$label

df_train <- lapply(temp_train, as.numeric)
df_train <- as.data.frame(df_train)
df_train$label <- df_train$label-1

#temp_test <- na.omit(temp_test)
df_test <- lapply(temp_test, as.numeric)
df_test <- as.data.frame(df_test)
actual <- df_test$label

xgb_data <- xgb.DMatrix(data=data.matrix(df_train[,-ncol(df_train)]), label=df_train$label)
xgb <- xgb.train(data = xgb_data, 
                 eta = 0.3, ## eta : Learning Rate, x??? ????????? (default = 0.5)
                 max_depth = 3,  ## max_depth, decision tree??? ?????? ???????????????
                 nround = 73, ## the max number of iterations (weak learners number)
                 subsample = 0.8, ## Sample Number of each sample group (?????? 0.5~0.8, max??? 1??????.)
                 colsample_bytree = 0.8,
                 seed = 1,
                 eval_metric = "merror", ## merror Multiclass classification error rate. It is calculated as (# wrong cases) / (# all cases).
                 objective = "multi:softprob",
                 num_class = 12,
                 print_every_n = 10,
                 gamma=2,
                 min_child_weight=6,
                 lambda=1,
                 alpha=0
)
# temp_test : Check the accuracy
test_pred <- predict(xgb, newdata=data.matrix(df_test[,-ncol(df_test)]))
test_prediction <- matrix(test_pred, nrow = 12,
                          ncol=length(test_pred)/12) %>%
  t() %>%
  data.frame() %>%
  mutate(label = actual,
         max_prob = max.col(., "last"))

results <- table(test_prediction$label, test_prediction$max_prob)
accuracy <- sum(test_prediction$label == test_prediction$max_prob)/nrow(temp_test)
print(accuracy)  
## [1] 0.8835793


반응형
Posted by JoeSung
,

[예고편]


이전분석 - "1. 치킨집과 국내경제"

확인하기 : http://gigle.tistory.com/75


 "결론은 문이과를 나와도 너도나도 치킨집"


손석희 사장님도 어쩌면 곧 치킨집을..



"그러나 치킨집의 결말은.. 어땠을까?"





[결과물]


2005-2014 카페 창업/폐업 건수 비교


2005-2014 치킨집 창업/폐업 건수 비교


2005-2014 술집(호프간이주점) 창업/폐업 건수 비교


2005-2014 일식집 창업/폐업 건수 비교


2005-2014 한식음식점 창업/폐업 건수 비교



[요약]


- 2007년을 기점으로 치킨집 점주들과 카페 점주들은 희비가 엇갈렸다.

:: 치킨집의 폐업건수가 2007년도에 최대치, 서브프라임 모기지가 원인인 것으로 추측.

:: 그러나 카페 창업은 2007년 경제위기를 빗겨나갔다. 오히려 창업이 계속해서 증가, 폐업은 미미하게 증가

:: 한국 시장에서 그만큼 커피수요가 창출되었다는 것을 의미하기도.


- 따라서 2007년 이후에 별다른 소신 없이 치킨집 창업에 뛰어드는 것은 무모한 일이었다.

:: 차라리 카페를 하는 것이 현명




[Code]

환경 : R Studio

라이브러리 :

코드 :



show_line <- function() {

  

  market <- readline(prompt = "업종을 입력하세요")

  

  graphics.off()

  chic_sta <- create_cnt[ , market]

  chic_end <- drop_cnt[ , market]

  chic_range <- range(0, chic_sta, chic_end)

  

  head(create_cnt)

  lab_year <- create_cnt[,"X"]

  

  plot(chic_sta, type="o", col = "blue", ylim = chic_range, axes = FALSE, ann = FALSE, pch = 1)

  axis(1, at=1:10, lab=lab_year )

  axis(2)

  box()

  

  lines(chic_end, type="o", col = "red", lty = 3, pch = 22 )

  legend(5, chic_range[2] ,c("창업","폐업"),col=c("blue","red"),cex=0.8,pch=1:22,lty=1:3 )

  

  title(main = paste(market, "창업/폐업 현황") , col.main="red", font.main=4)

  

}


show_line()

반응형
Posted by JoeSung
,
0. Intro

[AirBnB CF]

1. 질문

 구매전환율은 회원가입을 한 이용자 중 실제 예약으로 이어진 이용자의 비율을 의미합니다. 에어비앤비 ( AirBnB) 이용자의 첫여행국가별, 성별 구매전환율을 구하고 1) 실제 예약으로 이어진 이용자가 얼마나 되는지, 2) 어떤 성별이 더 높은 예약율을 보이는지, 3) 어떤 국가가 가장 예약될 가능성이 높은지를 알려주세요.



2. 참고data


train_users_2.csv.zip



(출처 : www.kaggle.com)


3. 테이블생성스크립트

create table air_user 

(id  varchar2(50), 

 date_account_created  date, 

 timestamp_first_active  number, 

 date_first_booking   varchar2(50), 

 gender  varchar2(50), 

 age    number(10), 

 signup_method  varchar2(50), 

 signup_flow  number(10), 

 language  varchar(10), 

 affiliate_channel  varchar2(50), 

 affiliate_provider   varchar2(50), 

 first_affiliate_tracked  varchar2(50), 

 signup_app  varchar2(50), 

 first_device_type  varchar2(50), 

 first_browser  varchar2(50), 

 country_destination varchar2(10)); 



4. 분석쿼리

select 여행목적지, 남자, 여자, 알수없음, case when 여행목적지 is not null then 남자+여자+알수없음 end as TOTAL

   from 

   (

  select *

    from 

    (

select a.여행목적지, a.gender, round( ( a.cnt_book / b.country_total )*100,2 ) as booking_ratio  -- booking_ratio : 첫 예약자의 여행목적지별 성별 전환율

  from 

  (

    select country_destination as "여행목적지", gender, count(*) as cnt_book   -- cnt_book : Airbnb 첫 예약자의 여행목적지별, 성별 예약자 수

from air_user

where date_first_booking is not null  

group by country_destination, gender

  ) a

  inner join

  (

    select country_destination as "여행목적지", count(country_destination) as country_total  -- country_total : Airbnb 첫 예약자의 여행목적지별 예약자 수

from air_user

group by country_destination

  ) b

  on a.여행목적지 = b.여행목적지

    )

    pivot( sum(booking_ratio) for gender in ('MALE' as "남자",'FEMALE' as "여자",'-unknown-' as "알수없음"))


union all


select 'TOTAL' as 여행목적지,

 round(sum(regexp_count(upper(gender), '^MALE')) / count(*)*100, 2) as 남자,

 round(sum(regexp_count(upper(gender), 'FEMALE')) / count(*)*100, 2) as 여자,

 round(sum(regexp_count(upper(gender), '-UNKNOWN-')) / count(*)*100, 2) as 알수없음

    from air_user

    where date_first_booking is not null

);


5. 결과화면


[그림 1. 국가별 성별 전환율]


6. 결론


1.1 에어비앤비 (AirBnB)에 가입하는 회원의 10명 중 최소 3명은 실제 예약으로 이어짐

 남성의 경우 31.18%, 여성의 경우 35.98%가 그리고 성별을 알 수 없는 경우 32.64%의 이용자가 회원가입 이후 첫 예약까지 이어졌다. 기존의 전문 숙박업인 호텔, 모텔이 경쟁자로 있다는 것을 생각해 보았을 때 비전문적으로 운영되는 AirBnB의 숙박 서비스의 예약률은 상당히 높은 수치인 것으로 생각된다.


1.2 (성별 분석) 여성의 구매전환율이 남성의 구매전환율보다 약 4%가량 높게 나타남

 '여행은 살아보는거야'. AirBnB의 마케팅 메시지인 '현지인 처럼 살아보는 경험'이 이용자들에게 제대로 전달이 되고 있다고 가정했을 때, 이러한 메시지는 남성보다 여성에게 더 잘 소구된다고 판단할 수 있다. 따라서, 차후 마케팅을 진행시에 여성을 타겟으로한 마케팅 진행시에 좀 더 높은 ROI를 달성할 수 있을 것으로 기대된다.


1.3 (국가별 분석) 남성의 경우 독일(DE)에서, 여성의 경우 프랑스(FR)에서 첫 AirBnB를 경험할 확률이 가장 높음

 남성들의 경우 가장 매력을 느낀 여행 국가는 1. DE(독일) 2. NL(네덜란드) 3. AU (오스트레일리아) 순으로 나타났고, 여성들의 경우 가장 매력을 느낀 여행 국가는 1. FR(프랑스) 2. IT(이탈리아) 3. GB (영국) 순으로 나타났다. 이유를 wild guessing 했을 때, 독일의 경우 '맥주'문화가 남성들에게 어필하지 않았나 싶고 네덜란드의 경우 법적 규제가 약해 '마약'과 '성문화'가 용이한 점이 남성들에게 어필했을 것이라고 추측된다. 여성들의 경우 선호하는 국가가 패션, 뷰티로 대표되는 럭셔리 산업이 발전해있고 도시의 이미지가 세련되었다는 특징이 있다. 따라서, 쇼핑의 용이성과 도시가 주는 세련됨 자체가 여성들에게 어필했을 것이라고 추측해볼 수 있다.

 차후 마케팅 진행시에, '독일 여행을 계획 중인 남성'과 '프랑스 여행을 계획 중인 여성'을 타겟으로 가장 먼저 진행했을 때 상대적으로 높은 ROI를 기대해볼 수 있을 것으로 기대된다.



7. 연습문제

airbnb_practice.csv 데이터를 사용하여 회원가입을 한 시점을 기준으로 

첫 예약이 이루어지기 까지의 시간을 다음과 같은 구간으로 나누어서 유져 수를 구해주세요. 


 -1일 미만  ( 0 )

 -1일 이상~2일 미만 ( 1 )

 -2일 이상~3일 미만 ( 2 )

 -3일 이상~4일 미만 ( 3 )

 -4일 이상~5일 미만 ( 4 )

 -5일 이상~6일 미만 ( 5 )

 -6일 이상~7일 미만 ( 6 )

 -7일 이상 ( 7 )



 [data set]

   

air_practice.csv




 [테이블 생성]

 create table pra

 (id  varchar2(100),

  day_diff  number(20));


  ** id : 회원고유 아이디

  ** day_diff : 회원가입으로부터 구매까지 걸린 날짜수






** Git Hub : https://github.com/JoeUnsung/airbnb_sql/blob/master/airbnb_convsersion_analysis.sql


 



반응형
Posted by JoeSung
,


[결과]



- 국내에서 치킨집이 폐업하는 건수는 평균적으로 연간 4-500건 대에 머무릅니다.


- 그런데, 2007년에는 3579건으로 거의 7~8배에 가까운 치킨집이 폐업을 하게 됩니다.


- 특이값인데, 그러면 2007년에는 어떤 일이 있었던 걸까? >> 서브프라임 모기지가 일어났던 해이기 때문으로 추측하고 있습니다.


- 치킨집의 비즈니스 특성상, 필수재가 아니기 때문에 단위당 경제가 악화 됨에 따라 매출이 줄어드는 정도가 매우 큰 편입니다. 쉽게 말해, 형편이 어려워지면 사람들이 밥은 줄이지 않아도 치킨은 줄인다는 말입니다.




[과정]


--환경 : oracle 11g database, sqlgate for oracle


--데이터 csv 파일 

폐업건수.csv



--폐업건수 테이블 생성

 create table endup

   (year  number(20),

   barber  number(30),

   western  number(30),

   japan   number(30),

   chiken   number(30),

   beverage  number(30),

   korean   number(30),

   beer   number(30) );

   


--년도별 치킨집 폐업건수 중 가장 폐업건수가 많은 년도

select item, year, cnt, rank() over(order by cnt desc nulls last) as rank

   from

   (

     select *

      from endup

      unpivot( cnt for item in (BARBER, WESTERN, JAPAN, CHIKEN, BEVERAGE, KOREAN, BEER) )

   )

   where item in 'CHIKEN';

반응형
Posted by JoeSung
,

선행 블로깅

http://gigle.tistory.com/67



[결과물]



[코드]


[전국 댐 위치 시각화 with R]

:: 사용 코드

library(ggmap)

## ggmap이 버전이슈가 최근에 있어서 오류가 날지도 모른다.

## 그런 경우 install.packages("ggmap", type = "source") 를 통해 다시 설치하면 해결.

library(ggplot2)

a <- read.csv(file = "20170624.csv", sep = "," , header = TRUE)

## 파일을 불러오기

sub_a <- subset(a, TJL > 0, select = c("LON","LAT","TJL"))

## 위도와 경도만 가져와서 subset을 만듭니다.

str(sub_a)

cent <- c(lon = 127.8, lat = 35.8)


sub_a$test1 <- sub_a$TJL/1.7

sub_a

## 한국(남한)기준 위도 경도의 중심입니다.

map <- ggmap(get_googlemap(center = cent, zoom = 7, maptype='roadmap', color = 'bw'), extent = 'device')

## map 변수에 구글 지도(남한) 부분을 저장합니다.

map + geom_point(data = sub_a, aes(x=LON, y=LAT), colour = 'royalblue', alpha = 0.75, size = sub_a$TJL/1.3)

## size 변수를 통해 원의 크기를 조절 / alpha를 통해서 투명도를 조절 / data를 통해 사용할 데이터 가져오기


반응형
Posted by JoeSung
,