初めまして、Datum StudioのLeon（リオン）と申します。
本記事では模擬案件を通じて、分析手法の説明を行います。
依頼内容は、3つの航空会社にがランダムで1000名顧客を対象にアンケート調査したデータを利用して、自社のどこが他の2社より優れているのか、もしくは劣っているのか？また、顧客の体験も一緒に知りたいとのです。
今回使用する手法は主成分分析（PCA）と探索的因子分析（EFA）です。
（具体的な紹介はWikipediaのページをご覧ください：主成分分析、探索的因子分析(英語)）
早速ですが、始めましょう。
0. 模擬案件の背景
今回の顧客はA航空会社です。彼達がランダムで1000人利用者に3つ航空会社に対する満足度のアンケートを取りました。
※ 生データはここでダウンロードできます。（Data download）
データ中の変数（値の範囲は 1 ~ 9で、1 は最低値、9 は最高値）：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
# Easy_Revervation : 座席の購入やすさ # Preferred_Seats : 座席の選択 # Flight_Options : 航空便の選択 # Ticket_Prices : チケットの価格 # Seat_Comfort : 座席の座り心地の良さ # Seat_Roominess : 席の大きさ # Overhead_Storage : 収納棚の大きさ # Clean_Aircraft : 機内の清潔さ # Courtesy : 礼儀 # Friendliness : 親切さ # Helpfulness : 有用さ # Service : 機内サービスの良さ # Satisfaction : 満足度 # Fly_Again : 再度利用する # Recommend : 友人に推薦する # ID : 回答者番号 # Airline : AirlineCo.1 ~ AirlineCo.3 計 3 社 |
1. パッケージの読込
|
1 2 3 4 5 6 7 |
# library library(readr) library(dplyr) library(corrplot) library(gplots) library(RColorBrewer) library(GPArotation) |
2. データインプット
|
1 2 3 4 5 |
# Input data airline<-read.csv("https://raw.githubusercontent.com/happyrabbit/DataScientistR/master/Data/AirlineRating.csv") # Check data glimpse(airline) |
データを一回確認します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
# Observations: 3,000 # Variables: 17 # $ Easy_Reservation # $ Preferred_Seats # $ Flight_Options # $ Ticket_Prices # $ Seat_Comfort # $ Seat_Roominess # $ Overhead_Storage # $ Clean_Aircraft # $ Courtesy # $ Friendliness # $ Helpfulness # $ Service # $ Satisfaction # $ Fly_Again # $ Recommend # $ ID # $ Airline |
変数間の相関度を確認します。
|
1 2 3 4 5 6 |
# Correlation select(airline, Easy_Reservation:Recommend) %>% # Get Correlation Matrix cor() %>% # Plot correlation map corrplot(, order="hclust") |
※ ブルーになるほど相関度が「1」に近い、レッドになるほど相関度が「0」に近いです。
上記の図から、変数間の相関度が「1に近い」か、「ほぼ0」か、「-1に近い」かがわかります。
3. 主成分分析
|
1 2 3 4 |
# PCA analysis airline.pc <- select(airline, Easy_Reservation : Recommend) %>% prcomp() summary(airline.pc) |
各航空会社の平均点を取ります。
|
1 2 3 4 5 |
# Get mean scores of variables for each airline airline.mean <- select(airline,-ID) %>% group_by(Airline) %>% summarise_each(funs(mean)) %>% glimpse() |
結果
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
# Observations: 3 # Variables: 16 # $ Airline # $ Easy_Reservation # $ Preferred_Seats # $ Flight_Options # $ Ticket_Prices # $ Seat_Comfort # $ Seat_Roominess # $ Overhead_Storage # $ Clean_Aircraft # $ Courtesy # $ Friendliness # $ Helpfulness # $ Service # $ Satisfaction # $ Fly_Again # $ Recommend |
図を描くため、行の名前を「1、2、3」から「AirlineCo.1、AirlineCo.2、AirlineCo.3」に変更します。
|
1 2 3 |
# Change rownames of airline.mean row.names(airline.mean) <- airline.mean$Airline airline.mean <- select(airline.mean,-Airline) |
ヒートマップを描きます。
|
1 2 3 |
# Plot heatmap heatmap.2(as.matrix(airline.mean), col=brewer.pal(5,"YlGn"), trace="none", key=FALSE, dend="none", cexCol=0.6, cexRow =1) title(main = "Mean values for different airlines") |
※ 色が濃いほど点数が高い。
この図から、AirlineCo.3(航空会社3)が2/3以上の項目が他の2社より優れていることがわかります。また、AirlineCo.2(航空会社2)が点数が一番低い項目が3社の中で最も多いことがわかります。
4. 探索的因子分析(EFA)
|
1 2 3 4 5 |
# Factor analysis airline.fa <- airline %>% subset(select = Easy_Reservation : Recommend) %>% factanal(factors=3, rotation="oblimin") title(main = "Factor load of airline satisfactory") |
各因子の重要度を算出します。
|
1 2 3 4 5 6 7 |
# Calculate the factor score airline.fa <- airline %>% subset(select = Easy_Reservation : Recommend) %>% factanal(factors = 3, rotation = "oblimin", scores = "Bartlett") fa.score<-airline.fa$scores %>% data.frame() |
結果：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
# Factor1 Factor2 Factor3 # Easy_Reservation 0.941 # Preferred_Seats 0.880 # Flight_Options 0.167 0.803 # Ticket_Prices 0.887 # Seat_Comfort 0.865 # Seat_Roominess 0.844 -0.242 # Overhead_Storage 0.833 0.137 -0.142 # Clean_Aircraft 0.708 # Courtesy 0.818 # Friendliness 0.868 # Helpfulness 0.953 # Service 0.922 # Satisfaction 0.921 # Fly_Again 0.943 # Recommend 0.942 |
上記の結果からもうすでに15個変数を影響している潜在変数の意味をほぼ推定できます。
|
1 2 3 |
# Factor 1 : 全体的な体験 # Factor 2 : 機内サービス体験 # Factor 3 : チケット購入体験 |
各航空会社の因子の平均点を算出します。
|
1 2 3 4 5 6 7 |
fa.score$Airline <- airline$Airline fa.score.mean <- fa.score %>% group_by(Airline) %>% summarise(Factor1 = mean(Factor1), Factor2 = mean(Factor2), Factor3 = mean(Factor3)) |
図を描くため、行の名前を「1、2、3」から「AirlineCo.1、AirlineCo.2、AirlineCo.3」に変更します。
|
1 2 |
row.names(fa.score.mean) <- as.character(fa.score.mean$Airline) fa.score.mean <- select(fa.score.mean,-Airline) |
ヒートマップで因子を図表化します。
|
1 2 |
heatmap.2(as.matrix(fa.score.mean), col = brewer.pal(5,"YlGn"), trace = "none", key = FALSE, dend = "none", cexCol = 0.6, cexRow = 1) title(main="Average factor load satisfaction for each airline") |
※ 色が濃いほど点数が高い。
上記の図の解釈の例：AirlineCo.1(航空会社1)は「Factor 3 : チケット購入体験」では他社より優れていますが、「Factor 2 : 機内サービス体験」ではもっと工夫する必要があります。
5. まとめ
今回はデータの前処理が要らず、単純に分析するだけの仕事で、結構時間の節約ができました。通常の生データ前処理は総案件の半分以上、偶に70%以上の時間をかかるケースもあります。
PCAとEFAの使い方は少しでもお役に立ちましたでしょうか？今後面白そうな模擬案件がありましたら、また紹介いたします。
Bye~
