データ穴リストのブログ

すべては喰いっぱぐれないために

多重コレスポンデンス分析やってみた。

本日二投目。

※本記事は下記のサイトを参考に書いてみただけで、なんらオリジナルな話はありません。 まあそもそもオリジナルなものなんて書いてないか。

sugioka.wiki.fc2.com

別事業部からの依頼で普段はやらないジャンルのゲームについて、 「ユーザの分類をしてみたい」ってな依頼が来たので興味本位でやってみよう、 というのが動機でした。

素材はアンケートデータなんですが、
よくあるこのMCAとかこの辺の手法って、
何でもかんでも分析者のお気持ち次第っていうか、
それにしたってぶっこむ変数によって世界観が360°変わる厄介者な認識です(笑っていいんだよ?)。

で、MCAをするにはみんな大好きSPSSのオプションとかをご購入してもれなくIBMさんに重課金するのか、我らの心の友(勝手に認定)、HADでも可能ですね。

ただし、我らがHADをもってしても、一回一回まわしていくのは面倒。 ということで、そう、Rの出番ですね!

データを適当に区切っておく

上のサイトでもいくつか紹介されていましたが、 FactoMineRというのが手軽そう&便利そうなのでそちらでやってみました。

まずはどんな変数をぶっこむか、先にリストを作っときます。

install.packages("FactoMineR")
require(FactoMineR)

# data teaの読み込み
data(tea)

# これらの行を選び、newteaに代入

tea_list <- list(c("Tea", "How", "how", "sugar", "where", "always"),
                 c("Tea", "How", "how", "sugar", "where"),
                 c("Tea", "How", "where", "always"),
                 c("where", "always"))

コレポンをぐるぐる、可視化まで。

で、あとはこいつをコレポンしてggplotのグラフオブジェクトを量産すれば…!

って思ったら上手くいかなかったのでとりあえずそちらを↓

for(i in 1:length(tea_list)){
  #描画準備
  newtea <- tea[, tea_list[[i]]]
  cats <- apply(newtea, 2, function(x) nlevels(as.factor(x)))
  mca1 <- MCA(newtea, graph = FALSE)
  mca1_vars_df <- data.frame(mca1$var$coord, Variable = rep(names(cats), cats))
  mca1_obs_df <- data.frame(mca1$ind$coord)
  
  #plot
  assign(paste0("tea_gg", i), ggplot(data = mca1_obs_df, aes(x = Dim.1, y = Dim.2)) +
    geom_hline(yintercept = 0, colour = "gray70") +
    geom_vline(xintercept = 0, colour = "gray70") +
    geom_point(colour = "gray70", alpha = 0.7) +
    stat_density2d(colour = "gray80", aes(fill = ..level.., alpha = 0.5), geom = "polygon") +
    geom_text(data = mca1_vars_df, 
              aes(x = Dim.1, y = Dim.2, 
                  label = rownames(mca1_vars_df), colour = Variable))+
    scale_fill_gradient(low = "grey80", high = "darkblue"))
}

# 見てみると…
tea_gg1 #エラー: Aesthetics must be either length 1 or the same as the data (17): x, y, label, colour
tea_gg2 #エラー: Aesthetics must be either length 1 or the same as the data (15): x, y, label, colour
tea_gg3 #エラー: Aesthetics must be either length 1 or the same as the data (12): x, y, label, colour
tea_gg4 #最後だけ正常出力

で、悩んで悩んでr-wakalangで聞いてみたところ、 教えていただいた解決策がコチラ↓

do_plot <- function(i) {
  #描画準備
  newtea <- tea[, tea_list[[i]]]
  cats <- apply(newtea, 2, function(x) nlevels(as.factor(x)))
  mca1 <- MCA(newtea, graph = FALSE)
  mca1_vars_df <- data.frame(mca1$var$coord, Variable = rep(names(cats), cats))
  mca1_obs_df <- data.frame(mca1$ind$coord)
  
  #plot
  ggplot(data = mca1_obs_df, aes(x = Dim.1, y = Dim.2)) +
    geom_hline(yintercept = 0, colour = "gray70") +
    geom_vline(xintercept = 0, colour = "gray70") +
    geom_point(colour = "gray70", alpha = 0.7) +
    stat_density2d(colour = "gray80", aes(fill = ..level.., alpha = 0.5), geom = "polygon") +
    geom_text(data = mca1_vars_df, 
              aes(x = Dim.1, y = Dim.2, 
                  label = rownames(mca1_vars_df), colour = Variable))+
    scale_fill_gradient(low = "grey80", high = "darkblue")
}

idx <- seq_along(tea_list)
names(idx) <- paste0("tea_gg", idx)

l <- purrr::map(idx, do_plot)
l$tea_gg1 #できたー!

f:id:cun-wang:20180715131647p:plain

どうやらグローバル環境とかそのあたりのお話なようで、 教えていただいた解決策は「処理を関数化する」ということでした。

それにしてもリスト処理、こんなん出来るんだなーと目からウロコでした。。。

ってことに触発された記事を書こうとしたんだけどさっきいったん断念。

ちなみに

どんなジャンルのゲームかっていうと、こういうのです↓

socialappsupport.com

え…アメリカで…?そうなの?ってかヘーシャ入ってn…