研究議題:哪一些品類在哪些州賣的比較好?



#if(!require(devtools)) install.packages("devtools")
#if(!require(morpheus)) devtools::install_github('cmap/morpheus.R')
pacman::p_load(dplyr, d3heatmap)
cols = colorRamp(c('seagreen','lightyellow','red'))

💡 請注意資料是放在上星期的資料夾裡面

load("../unit09/data/olist.rdata")



【A】準備資料

A1.顧客的地理分布(比率)
par(cex=0.8)
table(C$customer_state) %>% sort(decreasing=T) %>% prop.table %>% barplot(las=2)

table(C$customer_state) %>% sort(dec=T) %>% prop.table %>% cumsum %>% round(2) %>% head(15)
  SP   RJ   MG   RS   PR   SC   BA   DF   ES   GO   PE   CE   PA   MT   MA 
0.42 0.55 0.67 0.72 0.77 0.81 0.84 0.86 0.88 0.90 0.92 0.93 0.94 0.95 0.96 

超過80%的顧客都集中在前6州

A2. Pull C$customer_state into I$state via O
I = left_join(O[,1:2], C[,c(1,5)])[-2] %>%   # merge state into `O`
  rename(state=customer_state) %>%           # use a shoter name
   right_join(I)                             # then merge to `I`
Joining, by = "customer_id"
Joining, by = "order_id"
A3. Pull TPC$product_category_name_english into I$category via O
I = left_join(P, TPC)[,c(1,10)] %>%                     # merge name into `P``
  rename(category = product_category_name_english) %>%  # use a shorter name
  right_join(I)                              # merge into `I`
Joining, by = "product_category_name"
Joining, by = "product_id"
A4. Make a State\(\times\)Category Matrix
X = xtabs(price ~ state + category, I)    # sum(price) per cat., per st.
X = X[order(-rowSums(X)),]                # arrange rows and ...
X = X[,order(-colSums(X))]                # columns in decending order
(rowSums(X)/sum(X)) %>% cumsum %>% {which(. < .95)} %>% last # 15
[1] 15
(colSums(X)/sum(X)) %>% cumsum %>% {which(. < .95)} %>% last # 32
[1] 32
X = as(X[1:15, 1:32], "matrix")        # keep 15 states & 32 categorie
colnames(X) = substr(colnames(X),1,12) # use shorter names



【B】保持原有行列次序

由於我們事先已經將X矩陣的行列次序依降冪排列,我們可以以原有的次序畫出熱圖

d3heatmap(X,F,F,col=cols)

<
但是這樣做的話,我們只能看到顧客最多的哪一州(SP)和賣得最好的幾個品類。

Morph = function(x, row=T, col=T, dendro="both", ...) {morpheus(
  x, Rowv=row, Colv=col, dendrogram=dendro, colorScheme=list(
  scalingMode="fixed", values=c(min(x),(min(x)+max(x))/2,max(x)) 
  ), ...) } 
Morph(X, F, F, "none")


【B】對數轉換 Log Transformation

range(X[X > 0])
[1]     49.99 478284.52
par(mfrow=c(1,2), cex=0.8)
hist(X)
hist(log(51+X,10))

因為log(0) = -Inf,所以取對數之前我們常需要先加進去一個數值,通常我們會選用矩陣中最小的數字。

d3heatmap(log(51+X,10),F,F,col=cols)

<

Morph(log(51+X,10),F,F,"none")


【C】行列集群 Clustering over Rows and Columns

熱圖工具通常都會對矩陣的行與列分別作集群分析,在這個例子裡面,購買行為相似的州和顧客地理位置相似的產品會被檢在一起,以方便我們做觀察。

d3heatmap(log(51+X,10),col=cols)

<

Morph(log(51+X,10))


【D】單方向常態化 1D-Normalization

由於各州的顧客數量相差很多,州間並沒有相互比較的基礎,在熱圖裡面我們也很難觀察前三大州以外的地區;為了克服這個問題,我們可以用常態化的方式讓每一州的總營收都等於100,也就是說,我們讓矩陣之中的每一格都代表某一品類佔某一州總購買金額的百分比,這樣我們才能夠比較各州在品類購買比重上的異同。

d3heatmap(100*X/rowSums(X), Rowv=T, Colv=F, col=cols)

<

上圖中每一格的顏色代表某一品類佔某一州總購買金額的比例(越紅越大),我們可以觀察到,雖然所有地區的消費都集中在最左邊的品類,各州對各品類的消費比例還是有些差異,所以我們可以根據這些差異對各州做分群。

單方向常態化會有一個問題,我們在一個方向做常態化,就會破壞另一個方向數值之間的相對關係,所以我們對水平方向(州)做了常態化之後,垂直方向(品類間)的比較就變得沒有意義了,因此我們也不在品類間做分群。

當然,我們也可以在選擇品類這個方向做常態化,但是在這案例裏面,因為大部分的營收都集中在前幾大州,這樣做的用處不大。

Morph(100*X/rowSums(X),T,F,"row")


【E】雙向比例 Standardized Residuals

前面說過,單方向的常態化有一個缺點,我們對一個方向(州)做常態化之後,另外一個方向(品類)的數值就失去了比較的基礎;如果我們想要在兩個方向上同時做分類和比較,我們可以把矩陣的標準化殘差(standardized residuals)畫成熱圖

m = (rowSums(X) %o% colSums(X))/sum(X)   # cells' expected value 
r = (X - m)/sqrt(m)    # standerdized residuals
r[r > 100] = 100       # adjust the outlier
hist(r)                # check distribution

cols = colorRamp(c('#008000','#f8f8f8','#f8f8f8','#b32400'))
d3heatmap(r,col=cols)

<

Morph(r)


這個圖形可以從兩個方向做判讀,

  • 在水平方向,紅(綠)色代表該州在該品類的消費明顯的高(低)於期望值
  • 在垂直方向,紅(綠)色代表該品類在該州的營收明顯的高(低)於期望值

\(E_{i,j} = P_i \times P_j \times R, \quad P_i = R_i/R, \quad P_j = R_j/R\)

  • \(E_{i,j}\): Expected Revenue of Category-\(j\) in State-\(i\)
  • \(P_i\): Marginal Probability of State-\(i\)
  • \(P_j\): Marginal Probability of Category-\(j\)
  • \(R_i\): Total Expenditure in State-\(i\)
  • \(R_j\): Total Revenue of Category-\(j\)
  • \(R\): Grant Total Revenue