Rを通じて統計学を学ぶ備忘録ブログ

SPSSからRに移行したい私のような人向けのR解説ブログ兼学習用備忘録。

大学の時にもっと勉強しておけばよかったマーケティング・リサーチ〜その10〜

大学の時にもっと勉強しておけばよかったマーケティング・リサーチの10話目です。今回はRMF分析です。

CRMを利用したマイクロマーケティング

今回はRFM分析について見ていきます。RFM分析は、CRM(Customer Relationship Management)における分析手法の1つです。また、CRMは、企業と顧客における関係を構築し、顧客ロイヤリティーを向上させていく取り組みのことです。 マクロマーケティングは、マスマーケティングとは趣が異なります。マスマーケティングは「成長市場において、市場シェアを拡大するために不特定多数を対象に展開されるもの」ですが、マクロマーケティングは「自社への利益に貢献する消費者のみを対象に展開し、顧客シェア、顧客ロイヤリティーの向上を目指すもの」です。 昨今、なぜマイクロマーケティングCRMや顧客ロイヤリティーという言葉が注目されているのでしょうか・・・1つ目の理由として、経営の安定化に繋がると考えられているからです。パレートの法則が示すように、売り上げの80%は優良顧客の20%が占めているため、優良顧客を維持していくこと、優良顧客に引き上げることが経営において重要な要素になるからです。 2つ目の理由としては、FSP(Frequent Shoppers Program)です。FSPによって、大量のデータを獲得できるようになったためと言われています。FSPは、サービスの利用、購入に対してポイントなどを発行し、顧客にポイントが溜まる喜びを提供することで、ブランドチェンジを防ぎ、かつ、CRMにも活用するマーケティング手法のことです。 従って、FSPで獲得したデータを利用しながら、RFM分析を通じて、優良顧客の維持、ひいては優良顧客への引き上げのための施作を検討してきます。

RFM分析とは

RFM分析は、【R】Recency(最新の購買日)、【F】Frequency (累積の購買回数)、【M】Monetary(累積の購買金額)の3つの頭文字をとったもので、RFMの指標を基準に顧客を並べ替え、グループ化した上で、各グループの特徴を探ることで、各グループにあった最適な施作を見つけ出すものです。以下、各指標の概要です。各指標のどこで区切るかが問題になりますが、10等分するデシル分析や予め区切りを決まる方法など、いくつかあります。

Recency(最新の購買日)

購買日の近さをもとに、顧客をグループ化します。購買日が近い方が、購買日が遠い顧客よりも、よい顧客と考えます。

Frequency (累積の購買回数)

購買回数の量をもとに、顧客をグループ化します。購買回数が多いほどよい顧客と考えます。

Monetary(累積の購買金額)

購買金額の量をもとに、顧客をグループ化します。購入金額の量が多いほど、良い顧客と考えます。

RFMの解釈

顧客を分析する中で、【R】が一番重要な指標と言われております。その理由は【F,M】が高くても【R】が低い(=最近、買ってない)場合、他者に乗り換えている場合もありますし、他者に取り込まれた顧客は施作の対象とする必要がないからです。また、【F】が低い(回数はない)が【M】が高い場合、【F】を高める施作をすることで、大金を落としてくれるようになるかもしれません。このように、指標ごとに顧客をグループ化し、その顧客群にあった施作を検討することがRFM分析では求められます。 以下、例です。 ・【R】が高い場合、将来的な利益貢献そしてくれる可能性がある。 ・【R】が低い場合、【F, M】が高くても、すでにブランドスイッチしているかもしれない。 ・【R】が同じ場合、【F】が高いほどよい顧客。 ・【R】が同じ場合、【F, M】が高いほど購買力がある顧客。 ・【F, R】が高い場合、【M】が低い顧客は良くない顧客。 ・【F】に着目して、購買回数が低い顧客への施作を検討。 ・【F】が低く、【M】が高い場合、1回あたりの金額が多いので、それを意識した施作を検討。 ・【F】が変動しない、または下がっている場合、すでにスイッチしているかもしれない。 ・【R, F, M】が低い場合、顧客を捨てることも検討。

上記のように、各指標をもとに顧客への施作を検討しつつ、新規顧客の獲得もしつつ、顧客ロイヤリティーを高めていくことになります。

RFM分析の実践

今回使用する仮想データは、年齢、性別、顧客ID、累積購買金額、累積購買頻度、最新の購買日、メルマガクーポンへの反応についての仮想データがあるとします。RMF分析を行うためには、各指標をある基準をもとに分割してランク付けをする必要があります。今回は、意図的に定めた区切りを用いて分割します。

分散分析

では、分散分析を行っていきます。分散分析の手法についての解説は、以下のページを参考にしていいただければ幸いです。 http://rtokei.tech/multivariate-analysis/20150920%E7%AC%AC%EF%BC%96%EF%BC%91%E5%9B%9E_%E3%83%9E%E3%83%AB%E3%83%81%E3%83%AC%E3%83%99%E3%83%AB%E5%88%86%E6%9E%90%E3%81%A8%E5%88%86%E6%95%A3%E5%88%86%E6%9E%90/

> Dataset <- read.csv("Dataset.csv" , header = TRUE, stringsAsFactors = TRUE)
> library(mvtnorm)
> library(survival)
> library(TH.data)
> library(multcomp)
> library(RcmdrMisc)

> Dataset <- within(Dataset, {Monetary_Rank <- recode(Monetary, '0:49999="M1";
                                    50000:99999="M2"; 
                                    100000:299999="M3"; 
                                    300000:499999="M4"; 
                                    else="M5"',
                                    as.factor.result=TRUE)})
  
> Dataset <- within(Dataset, 
                  {Frequency_Rank <- Recode(Frequency, '1="F1";
                                    2="F2";
                                    3:9="F3";
                                    10:29="F4"; 
                                    else="F5"',
                                    as.factor.result=TRUE)})
  
> Dataset <- within(Dataset, 
                  {Recency_Rank <- Recode(Recency, 
                   '0:30="R5";
                   31:60="R4";
                   61:90="R3";
                   91:180="R2";
                   else="R1"', 
                   as.factor.result=TRUE)})
  
> head(Dataset)

  Age    Sex Customer Monetary Frequency Recency Coupon Monetary_Rank Frequency_Rank Recency_Rank
1  28   Male        1   379809         3     168     no            M4             F3           R2
2  49 Female        2    85553        10     120     no            M2             F4           R2
3  37 Female        3   215398        19      51    yes            M3             F4           R4
4  41 Female        4   109736         7      56     no            M3             F3           R4
5  15 Female        5   113721         9      36     no            M3             F3           R4
6  60   Male        6   319797        12      35    yes            M4             F4           R4

> ggplot(data = Dataset) + 
  geom_boxplot(aes(x = Recency_Rank, y = Monetary, fill = Recency_Rank)) +
  facet_grid(. ~ Sex)
Rplot02

> ggplot(data = Dataset) + 
  geom_boxplot(aes(x = Recency_Rank, y = Frequency, fill = Recency_Rank)) +
  facet_grid(. ~ Sex)
Rplot

Recency_Rank(最新の購買日)が近い男性顧客ほど、累積の金額が1万円ほど多いことがわかりますが、女性顧客についてはR2以外は特に差は見られませんし、Recency_Rank(最新の購買日)が近い男女ともに、Frequencyも大きくなっているいことがわかります。 この図で見られた差は偶然かどうか、Monetary(累積購買金額)についてRecency_Rank(最新の購買日)ごとに、差があるかどうか、分散分析を行って確認してみます。今回は男性にわけて確認してみます。2要因分散分析の下記に載せておきます。

> Dataset_Male <- subset(Dataset, Dataset$Sex=="Male")
> Dataset_Female <- subset(Dataset, Dataset$Sex=="Female")

> ANOVA <- aov(Monetary ~ Recency_Rank, data = Dataset_Male)
> summary(ANOVA)

              Df    Sum Sq   Mean Sq F value   Pr(>F)    
Recency_Rank   4 7.253e+11 1.813e+11   7.497 7.43e-06 ***
Residuals    457 1.105e+13 2.419e+10                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

with(Dataset, numSummary(Monetary, groups = Recency_Rank, statistics = "mean"))

       mean   n
R1 230212.0  26
R2 211326.5 147
R3 261000.8  72
R4 282786.9 256
R5 305174.4 299

> pairwise.tests <- glht(ANOVA, linfct = mcp(Recency_Rank = "Tukey"))
> print(summary(pairwise.tests)) # pairwise tests

     Simultaneous Tests for General Linear Hypotheses

Multiple Comparisons of Means: Tukey Contrasts


Fit: aov(formula = Monetary ~ Recency_Rank, data = Dataset_Male)

Linear Hypotheses:
             Estimate Std. Error t value Pr(>|t|)    
R2 - R1 == 0    22498      42194   0.533   0.9822    
R3 - R1 == 0    74389      46932   1.585   0.4844    
R4 - R1 == 0    84395      40789   2.069   0.2173    
R5 - R1 == 0   124776      40754   3.062   0.0173 *  
R3 - R2 == 0    51890      30980   1.675   0.4272    
R4 - R2 == 0    61897      20514   3.017   0.0199 *  
R5 - R2 == 0   102278      20446   5.002   <0.001 ***
R4 - R3 == 0    10007      29037   0.345   0.9966    
R5 - R3 == 0    50387      28988   1.738   0.3886    
R5 - R4 == 0    40380      17361   2.326   0.1258    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Adjusted p values reported -- single-step method)

> print(confint(pairwise.tests)) # confidence intervals

     Simultaneous Confidence Intervals

Multiple Comparisons of Means: Tukey Contrasts


Fit: aov(formula = Monetary ~ Recency_Rank, data = Dataset_Male)

Quantile = 2.6969
95% family-wise confidence level

Linear Hypotheses:
             Estimate    lwr         upr        
R2 - R1 == 0  22498.1417 -91297.1743 136293.4576
R3 - R1 == 0  74388.5750 -52185.2120 200962.3620
R4 - R1 == 0  84395.4002 -25609.7885 194400.5888
R5 - R1 == 0 124775.5972  14863.5741 234687.6204
R3 - R2 == 0  51890.4333 -31660.7161 135441.5828
R4 - R2 == 0  61897.2585   6570.8402 117223.6768
R5 - R2 == 0 102277.4556  47136.5102 157418.4009
R4 - R3 == 0  10006.8252 -68303.8521  88317.5024
R5 - R3 == 0  50387.0222 -27792.7288 128566.7732
R5 - R4 == 0  40380.1971  -6441.7151  87202.1093
---------
> summary(aov(Monetary ~ Recency_Rank*Sex, data = Dataset))

                  Df    Sum Sq   Mean Sq F value   Pr(>F)    
Recency_Rank       4 9.497e+11 2.374e+11   9.312 2.35e-07 ***
Sex                1 1.098e+10 1.098e+10   0.431    0.512    
Recency_Rank:Sex   4 1.349e+11 3.372e+10   1.323    0.260    
Residuals        790 2.014e+13 2.550e+10                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

> interaction.plot(Dataset$Sex, Dataset$Recency_Rank, Dataset$Monetary, type="b",  pch=c(1, 1))
Rplot01

分散分析で差があることがわかりましたので、下位検定である多重比較を行ったところ、【R5-R1】【R4-R2】は5%で有意な差、【R5-R2】は0.1%で有意な差があることがわかりました。従って、今回の結果を元に、男性のR1は累積の購買金額も低く、最近の購買もないことから、すでに他社にスイッチしているかもしれないため、切り捨てることにする、などの判断ができます

ロジステック回帰分析

では、ロジステック回帰分析を行っていきます。ロジステック回帰分析の手法についての解説は、以下のページを参考にしていいただければ幸いです。http://rtokei.tech/multivariate-analysis/20150816%E7%AC%AC%EF%BC%94%EF%BC%98%E5%9B%9E_%E3%83%AD%E3%82%B8%E3%82%B9%E3%83%86%E3%82%A3%E3%83%83%E3%82%AF%E5%9B%9E%E5%B8%B0%E5%88%86%E6%9E%90/

> Reg <- glm(Coupon ~ Monetary + Frequency + Recency + Sex + Age, family = binomial, data = Dataset)
> summary(Reg)

Call:
glm(formula = Coupon ~ Monetary + Frequency + Recency + Sex + 
    Age, family = binomial, data = Dataset)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.2726  -0.7257  -0.3445   0.7346   2.7197  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)    
(Intercept) -2.159e+00  3.851e-01  -5.607 2.06e-08 ***
Monetary     3.212e-06  6.179e-07   5.199 2.01e-07 ***
Frequency    1.013e-01  1.390e-02   7.289 3.13e-13 ***
Recency     -1.531e-02  3.258e-03  -4.700 2.60e-06 ***
SexMale     -2.127e-01  1.833e-01  -1.161    0.246    
Age          1.288e-03  5.880e-03   0.219    0.827    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1040.78  on 799  degrees of freedom
Residual deviance:  744.04  on 794  degrees of freedom
AIC: 756.04

Number of Fisher Scoring iterations: 5

> exp(coef(Reg))  # Exponentiated coefficients = odds ratios

(Intercept)    Monetary   Frequency     Recency     SexMale         Age 
  0.1154301   1.0000032   1.1065936   0.9848026   0.8084007   1.0012890 

ロジステック回帰分析の結果、Monetary、Frequencyはプラスで有意、Recencyはマイナスで有意、Sex、Ageは有意な影響は確認されないということがわかりました。つまり、メルマガのクーポンに反応する可能性が高いのは、Monetary、Frequencyが高く、Recencyが低い(=最近購買している)ユーザーの方が、クーポンに反応しやすいということがわかりました。

様々な分析事例

以下では、復習のために様々な分散分析の事例を記載します。主効果の検定に関しては、中部大学の小塩先生のページよりデータとコードを引用し、使用しています。

対応のない一元配置分散分析

A <- c(10, 10, 12, 12, 10)
B <- c(12, 10, 15, 15, 10)
C <- c(7, 11, 15, 11, 10)
D <- c(6, 2, 2, 5, 3)
test <- c(A, B, C, D)       # 4群のデータをまとめる
method <- c(rep("method_A", 5),rep("method_B", 5),rep("method_C", 5),rep("method_D", 5))
Dataset <- as.data.frame(cbind(test, method))
Dataset$method <- as.factor(Dataset$method)
Dataset$test <- as.numeric(Dataset$test)
ANOVA <- aov(lm(test ~ method, Dataset))
summary(ANOVA)
pairwise.tests <- glht(ANOVA, linfct = mcp(method = "Tukey"))
print(summary(pairwise.tests)) # pairwise tests
print(confint(pairwise.tests)) # confidence intervals
plot(confint(pairwise.tests))

対応のある一元配置分散分析

test <- c(9, 10, 11, 11, 3, 10, 10, 10, 10, 4, 4, 5, 5, 2, 2)
method <- c(rep("method_A", 5), rep("method_B", 5), rep("method_C", 5))
person <- rep(c("sato", "tanaka", "suzuki", "takahashi", "mori"), 3)
Dataset <- as.data.frame(cbind(test, method, person))
Dataset$method <- as.factor(Dataset$method)
Dataset$person <- as.factor(Dataset$person)
Dataset$test <- as.numeric(as.character(Dataset$test))

summary(aov(test ~ method + person))    
ANOVA <- aov(lm(test ~ method + person))
summary(ANOVA)
par(mfrow = c(1, 2))
plotMeans(Dataset$test, Dataset$method, error.bars = "se")
plotMeans(Dataset$test, Dataset$person, error.bars = "se")  

対応のない二元配置分散分析

test <- c(10, 11, 12, 13, 12, 10, 8, 10, 8, 9, 20, 19, 18, 17, 19, 5, 4, 5, 6, 5, 9, 8, 7, 8, 9, 12, 10, 12, 10, 11)
method <- as.factor(c(rep("method_a", 15), rep("method_b", 15)))
study.time <- factor(rep(c(rep("2h", 5), rep("4h", 5), rep("6h", 5)), 2))
Dataset <- as.data.frame(cbind(test, method, study.time))

summary(aov(test ~ method * study.time))
par(mfrow = c(1, 1))
interaction.plot(method, study.time, test, type="b",  pch=c(1, 1))

【2要因とも対応のある二元配置分散分析】

test <- c(10, 11, 12, 13, 12, 10, 8, 10, 8, 9, 20, 19, 18, 17, 19, 5, 4, 5, 6, 5, 9, 8, 7, 8, 9, 12, 10, 12, 10, 11)
method <- factor(c(rep("method_a", 15), rep("method_b", 15)))
study.time <- factor(rep(c(rep("2h", 5), rep("4h", 5), rep("6h", 5)), 2))
person <- factor(rep(c("sato", "tanaka", "suzuki", "takahashi", "mori"), 6))        # 評定車の情報
summary(aov(test ~ method*study.time + Error(person + person:method + person:study.time + person:method:study.time)))   # 個人差によるデータの分析

1要因のみ対応のある二元配置分散分析

test <- c(10, 11, 12, 13, 12, 10, 8, 10, 8, 9, 20, 19, 18, 17, 19, 5, 4, 5, 6, 5, 9, 8, 7, 8, 9, 12, 10, 12, 10, 11)
method <- factor(c(rep("method_a", 15), rep("method_b", 15)))
study.time <- factor(rep(c(rep("2h", 5), rep("4h", 5), rep("6h", 5)), 2))
a1 <- rep(c("a1","a2","a3","a4","a5"),3)
a2 <- rep(c("b1","b2","b3","b4","b5"),3)
person <- factor(c(a1, a2))
summary(aov(test ~ method*study.time + Error(person:method + person:method:study.time)))

主効果の検定

data.ex=read.csv("data5_1.csv",header=T)
aov.ex=aov(depression ~ failure*perfection, data.ex)
summary(aov.ex)

perfectionの水準別にfailureの主効果検定。
p1 <- data.ex[data.ex$perfection=="p1",]
summary(aov(p1$depression ~ p1$failure))
高群と中群と低群とでは差がない

p2 <- data.ex[data.ex$perfection=="p2",]
summary(aov(p2$depression ~ p2$failure))
pairwise.t.test(p2$depression, p2$failure, p.adj = "bonf")
perfection高群では、failureの低群、中群よりもdepressionが高くなる

failure の水準別にperfectionの主効果検定。
f1 <- data.ex[data.ex$failure=="f1",]
t.test((f1$depression ~ f1$perfection), var.equal=T)
高群と低群とでは差はない

f2 <- data.ex[data.ex$failure=="f2",] 
t.test((f2$depression ~ f2$perfection), var.equal=T)
高群と低群とでは差がある

f3 <- data.ex[data.ex$failure=="f3",]
t.test((f3$depression ~ f3$perfection), var.equal=T)
高群と低群とでは差がある