#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")
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州
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"
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"
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
由於我們事先已經將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")
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")
熱圖工具通常都會對矩陣的行與列分別作集群分析,在這個例子裡面,購買行為相似的州和顧客地理位置相似的產品會被檢在一起,以方便我們做觀察。
d3heatmap(log(51+X,10),col=cols)
Morph(log(51+X,10))
由於各州的顧客數量相差很多,州間並沒有相互比較的基礎,在熱圖裡面我們也很難觀察前三大州以外的地區;為了克服這個問題,我們可以用常態化的方式讓每一州的總營收都等於100,也就是說,我們讓矩陣之中的每一格都代表某一品類佔某一州總購買金額的百分比,這樣我們才能夠比較各州在品類購買比重上的異同。
d3heatmap(100*X/rowSums(X), Rowv=T, Colv=F, col=cols)
上圖中每一格的顏色代表某一品類佔某一州總購買金額的比例(越紅越大),我們可以觀察到,雖然所有地區的消費都集中在最左邊的品類,各州對各品類的消費比例還是有些差異,所以我們可以根據這些差異對各州做分群。
單方向常態化會有一個問題,我們在一個方向做常態化,就會破壞另一個方向數值之間的相對關係,所以我們對水平方向(州)做了常態化之後,垂直方向(品類間)的比較就變得沒有意義了,因此我們也不在品類間做分群。
當然,我們也可以在選擇品類這個方向做常態化,但是在這案例裏面,因為大部分的營收都集中在前幾大州,這樣做的用處不大。
Morph(100*X/rowSums(X),T,F,"row")
前面說過,單方向的常態化有一個缺點,我們對一個方向(州)做常態化之後,另外一個方向(品類)的數值就失去了比較的基礎;如果我們想要在兩個方向上同時做分類和比較,我們可以把矩陣的標準化殘差(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\)