資料彙整流程

Fig-1:交易資料彙整


1. 交易項目計錄:Z

rm(list=ls(all=T))
knitr::opts_chunk$set(paged.print=FALSE, comment = NA)
pacman::p_load(magrittr, readr, caTools, ggplot2, dplyr, vcd)
1.1 讀進資料
Z = read_csv("data/ta_feng_all_months_merged.csv") %>% 
  data.frame %>% setNames(c(
    "date","cust","age","area","cat","prod","qty","cost","price"))
Rows: 817741 Columns: 9
-- Column specification --------------------------------------------------------
Delimiter: ","
chr (5): TRANSACTION_DT, CUSTOMER_ID, AGE_GROUP, PIN_CODE, PRODUCT_ID
dbl (4): PRODUCT_SUBCLASS, AMOUNT, ASSET, SALES_PRICE

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
nrow(Z)
[1] 817741
tibble(Z)
# A tibble: 817,741 x 9
   date      cust     age   area       cat prod            qty  cost price
   <chr>     <chr>    <chr> <chr>    <dbl> <chr>         <dbl> <dbl> <dbl>
 1 11/1/2000 01104905 45-49 115     110411 4710199010372     2    24    30
 2 11/1/2000 00418683 45-49 115     120107 4710857472535     1    48    46
 3 11/1/2000 01057331 35-39 115     100407 4710043654103     2   142   166
 4 11/1/2000 01849332 45-49 Others  120108 4710126092129     1    32    38
 5 11/1/2000 01981995 50-54 115     100205 4710176021445     1    14    18
 6 11/1/2000 01741797 35-39 115     110122 0078895770025     1    54    75
 7 11/1/2000 00308359 60-64 115     110507 4710192225520     1    85   105
 8 11/1/2000 01607000 35-39 221     520503 4712936888817     1    45    68
 9 11/1/2000 01057331 35-39 115     320203 4715398106864     2    70    78
10 11/1/2000 00236645 35-39 Unknown 120110 4710126091870     1    43    53
# i 817,731 more rows
日期格式轉換
Z$date = as.Date(Z$date, format="%m/%d/%Y")
par(cex=0.8)
hist(Z$date,'weeks',freq=T,las=2)

年齡層級、郵遞區號
age.group = c("<25","25-29","30-34","35-39","40-44",
              "45-49","50-54","55-59","60-64",">65")
Z$age = c(paste0("a",seq(24,69,5)),"a99")[match(Z$age,age.group,11)]
Z$area = paste0("z",Z$area)

Fig-2:郵遞區號

par(mfrow=c(1,2),cex=0.7)
table(Z$age, useNA='ifany') %>% barplot(main="Age Groups", las=2)
table(Z$area,useNA='ifany') %>% barplot(main="Areas", las=2)

處理離群值
# Quantile of Variables
sapply(Z[,7:9], quantile, prob=c(.99, .999, .9995))
       qty   cost   price
99%      6  858.0 1014.00
99.9%   14 2722.0 3135.82
99.95%  24 3799.3 3999.00
# Remove Outliers
Z = subset(Z, qty<=24 & cost<=3800 & price<=4000) 
nrow(Z)  
[1] 817182
彙總訂單 Assign Transaction ID

把每一天、每一為顧客的交易項目彙總為一張訂單

Z$tid = group_indices(Z, date, cust) # same customer same day
Warning: The `...` argument of `group_indices()` is deprecated as of dplyr 1.0.0.
i Please `group_by()` first
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.
資料總覽
# No. cust, cat, prod, tid
sapply(Z[c("cust","cat","prod","tid")], n_distinct)
  cust    cat   prod    tid 
 32256   2007  23789 119422 


2. 交易計錄:X

交易資料彙整
X = Z %>% group_by(tid) %>% summarise(
  date = min(date),          # 交易日期  
  cust = min(cust),          # 顧客 ID
  age = min(age),            # 顧客 年齡級別
  area = min(area),          # 顧客 居住區別
  items = n(),               # 交易項目(總)數
  pieces = sum(qty),         # 產品(總)件數
  total = sum(price),        # 交易(總)金額
  gross = sum(price - cost)  # 毛利
) %>% data.frame
nrow(X) # 119422 
[1] 119422
處理離群值
# Check Quantile & Remove Outliers
sapply(X[,6:9], quantile, prob=c(.999, .9995, .9999))
       items   pieces     total    gross
99.9%     54  81.0000  9009.579 1824.737
99.95%    62  94.2895 10611.579 2179.817
99.99%    82 133.0000 16044.401 3226.548
# Remove Outliers
X = subset(X, items<=62 & pieces<95 & total<16000) # 119328
交易摘要
summary(X)    
      tid              date                cust               age           
 Min.   :     1   Min.   :2000-11-01   Length:119328      Length:119328     
 1st Qu.: 29855   1st Qu.:2000-11-29   Class :character   Class :character  
 Median : 59705   Median :2001-01-01   Mode  :character   Mode  :character  
 Mean   : 59712   Mean   :2000-12-31                                        
 3rd Qu.: 89581   3rd Qu.:2001-02-02                                        
 Max.   :119422   Max.   :2001-02-28                                        
     area               items            pieces           total        
 Length:119328      Min.   : 1.000   Min.   : 1.000   Min.   :    5.0  
 Class :character   1st Qu.: 2.000   1st Qu.: 3.000   1st Qu.:  227.0  
 Mode  :character   Median : 5.000   Median : 6.000   Median :  510.0  
                    Mean   : 6.802   Mean   : 9.222   Mean   :  851.6  
                    3rd Qu.: 9.000   3rd Qu.:12.000   3rd Qu.: 1080.0  
                    Max.   :62.000   Max.   :94.000   Max.   :15345.0  
     gross        
 Min.   :-1645.0  
 1st Qu.:   21.0  
 Median :   68.0  
 Mean   :  130.9  
 3rd Qu.:  168.0  
 Max.   : 3389.0  
每周交易次數
par(cex=0.8)
hist(X$date, "weeks", freq=T, las=2, main="No. Transaction per Week")


3. 顧客資料:A

顧客資料彙整
d0 = max(X$date) + 1
A = X %>% mutate(
  days = as.integer(difftime(d0, date, units="days"))
  ) %>% group_by(cust) %>% summarise(
    r = min(days),      # recency
    s = max(days),      # seniority
    f = n(),            # frquency
    m = mean(total),    # monetary
    rev = sum(total),   # total revenue contribution
    raw = sum(gross),   # total gross profit contribution
    age = min(age),     # age group
    area = min(area),   # area code
  ) %>% data.frame      
nrow(A) # 32241
[1] 32241
par(mfrow=c(1,2),cex=0.7)
table(A$age, useNA='ifany') %>% barplot(main="Age Groups",las=2)
table(A$area, useNA='ifany') %>% barplot(main="Areas",las=2)                

顧客摘要
summary(A) 
     cust                 r                s                f         
 Length:32241       Min.   :  1.00   Min.   :  1.00   Min.   : 1.000  
 Class :character   1st Qu.:  9.00   1st Qu.: 56.00   1st Qu.: 1.000  
 Mode  :character   Median : 26.00   Median : 92.00   Median : 2.000  
                    Mean   : 37.45   Mean   : 80.78   Mean   : 3.701  
                    3rd Qu.: 60.00   3rd Qu.:110.00   3rd Qu.: 4.000  
                    Max.   :120.00   Max.   :120.00   Max.   :85.000  
       m                rev              raw              age           
 Min.   :    8.0   Min.   :     8   Min.   : -784.0   Length:32241      
 1st Qu.:  365.0   1st Qu.:   707   1st Qu.:   75.0   Class :character  
 Median :  705.7   Median :  1750   Median :  241.0   Mode  :character  
 Mean   :  993.1   Mean   :  3152   Mean   :  484.6                     
 3rd Qu.: 1291.0   3rd Qu.:  3968   3rd Qu.:  612.0                     
 Max.   :12636.0   Max.   :127686   Max.   :20273.0                     
     area          
 Length:32241      
 Class :character  
 Mode  :character  
                   
                   
                   
par(mfrow=c(3,2), mar=c(3,3,4,2))
for(x in c('r','s','f','m')) 
  hist(A[,x],freq=T,main=x,xlab="",ylab="",cex.main=2)
hist(pmin(A$f,10),0:10,freq=T,xlab="",ylab="",cex.main=2)
hist(log(A$m,10),freq=T,xlab="",ylab="",cex.main=2)

🌷 偏態分佈的處理方法

  • 對數轉換 - log(A$m, 10)
  • 固定上限 - pmin(A$f, 10)


Check & Save
is.na(Z) %>% colSums
 date  cust   age  area   cat  prod   qty  cost price   tid 
    0     0     0     0     0     0     0     0     0     0 
is.na(X) %>% colSums
   tid   date   cust    age   area  items pieces  total  gross 
     0      0      0      0      0      0      0      0      0 
is.na(A) %>% colSums
cust    r    s    f    m  rev  raw  age area 
   0    0    0    0    0    0    0    0    0 
A0 = A; X0 = X; Z0 = Z
save(Z0, X0, A0, file="data/tf0.rdata")


4. 行銷企畫競賽

A.企畫項目
  • 1)利用既有和衍生的變數做顧客分群(標籤)
  • 2)根據顧客族群價值屬性,選取行銷重點、設定行銷目標
  • 3)製作模型:估計每一位顧客的:
    • 回購機率
    • 預期營收、預期獲利
    • 終生價值
  • 4)根據顧客族群特徵,設計(至少兩項)行銷方案
  • 5)對方案的成本、效益進行(可以透過參數調整的)假設
  • 6)設計模擬程式,藉以:
    • 選擇行銷方案
    • 設定方案參數
    • 選擇行銷對象
    • 估計成本效益
  • 7)做一個完整的行銷企劃報告:
    • 經營現況
    • 改善策略
    • 行銷方案
    • 預期成效
B.評分項目
  1. 能從資料中找出重要的現象、結構、趨勢
  2. 能善用資料視覺化呈現重要發現
  3. 能找出特殊的、有價值的顧客族群
  4. 能找到或導出有預測力的變數
  5. 能根據分析的結果選擇策略重點、設定策略(量化)目標
  6. 能提出有效、有創意的行銷方案
  7. 能設計出合理的假設
  8. 能正確演練市場模擬的程序,清楚表達策略規劃的邏輯
  9. 整份行銷企劃的整體(影片+文案)品質
  10. 投入資源執行這一份企劃的意願


5. 資料探索練習

類別資料的分類統計
mosaic(~area+age, data=A, shade=T)