1ヶ月あいてしまいました・・・
というのも全く、クラスタリングなどがわからず、結局結果がわからなくなってしまったからです。
要点
集計して要点を出すまでは次のようにすればOK
tweets <- read.csv("ツイート.csv")
# 集計
track_ranking <- tweets %>% group_by(track) %>% tally
# ランキング表示(重複投票削除)
track_uniq <- tweets[!duplicated(tweets[c("user_id", "track")]),]
track_uniq_rank <- track_uniq %>% group_by(track) %>% tally
track_uniq_rank_order <- track_uniq_rank[order(track_uniq_rank$n, decreasing = TRUE),]
head(track_uniq_rank_order)
# プロット(すべて表を描写するために色々しています)
par(family = "HiraKakuProN-W3", ps = 6)
track_plot <- barplot(sort(track_uniq_rank_order$n[1:10]), horiz = TRUE)
text(sort(track_uniq_rank_order$n[1:10]), track_plot - 0.1, sort(track_uniq_rank_order$n[1:10]), pos=2)
text(0, track_plot - 0.1, sort(track_uniq_rank_order$track[1:10]), pos=4)
# クラスタ分析
## クロス分析用の関数spreadを使うためにtidyverseを呼び出す
library("tidyverse")
## デンドグラムを作成
### クロス表を作成
track_cross <- track_uniq %>% group_by(tweet_id, track) %>% tally %>% spread(track, n)
### クロス表にはいくらかNAとなっているもの、重複投票があるのでそれを0にしておく
track_cross[is.na(track_cross)] <- 0
track_cross[track_cross > 1] <- 0
### クロス表から距離を作成し、クラスタ化
track_dist <- dist(track_cross)
track_rc <- hclust(track_dist)
### デンドグラムの表示
plot(track_rc)
## K平均法(クラスタ3個)
k <- 3
track_k <- kmeans(track_cross, k, nstart=100)
### 3つのクラスタについてそれぞれ分解
for ( i in 1:k ) {
# クラスタグループに所属している列を取り出す
track_part <- track_cross[track_k$cluster == i,]
# 一度、データフレームに曲名と票数を格納する
# なお、sapplyにas.vectorをかけているのは、こうしないと、曲名が二重に出てしまうため
track_sum <- data.frame(colnames(track_part)[2:ncol(track_part)], as.vector(sapply(track_part[2:ncol(track_part)], sum)))
colnames(track_sum) <- c('曲名', '票数')
# 各クラスタのトップを表示
print(head(track_sum[order(track_sum['票数'], decreasing = TRUE),]))
}
# アソシエーション分析
library("arules")
library("arulesViz")
## 一度トランザクション型にしないとapriori関数がうけつけてくれない
track.tran <- as(as.matrix(track_cross[2:ncol(track_cross)]), "transactions")
track.ap <-apriori(track.tran,parameter = list(supp =0.01,maxlen=7,confidence=0.01))
## 信頼度でソート
inspect(head(sort(track.ap, by = "confidence"), n=10))
## リフトが5以上のものをピックアップしてプロット
track.gr <- subset(track.ap, subset = (lift >= 5))
plot(track.gr, method="graph")
以下は私の苦闘のメモです。あまり参考にはなりませんので、どうぞ、Rについては別の参考になるページをご覧ください。
イントロ
インストールして放っておいたR Studioを立ち上げてみる。
tweets <- read.csv("ツイート.csv")
ツイート.csvはこんな感じになってます。
tweet_id, date, user_id, track
投票数ランキングを出してみる
まずは、投票数ランキングでしょー。ってことで、やってみるけど、SQLで言う所のGROUP BYがない・・・
え？そういうのはdplyrっていうパッケージ使うの? さりげなく世界の違いを感じたりしました。
で、色々あーでもない、こーでもないとやっていると次の通りに入力すると、うまく動きました
track_ranking <- tweets %>% group_by(track) %>% tally
なんすか・・・tallyって・・・
とりあえず、これで、曲名と投票数(自動的にnという名前の列名がつけられていました)を取り出すことができました。
順に表示するには・・・どうするんだ？
sort関数を見てみるんですが
sort(x, decreasing = FALSE, ...)
## Default S3 method:
sort(x, decreasing = FALSE, na.last = NA, ...)
キーの指定がない・・・?んんん〜！？
ググッてみるとこういう場合はorder関数にキーにしたい配列を指定。返り値のインデックスの配列を取り出して表示するというのが定石らしいです。はい？
> order(track_ranking["n"])
エラー: Can't use matrix or array for column indexing
なんでやねん・・・
調べてみると
Data frames can be indexed in several modes. When [ and [[ are used with a single vector index (x[i] or x[[i]]), they index the data frame as if it were a list. In this usage a drop argument is ignored, with a warning.
The data.frame method for $, treats x as a list, except that (as of R-3.1.0) partial matching of name to the names of x will generate a warning; this may become an error in future versions. The replacement method checks value for the correct number of rows, and replicates it if necessary.
$を使うと戻り値はリストとして扱ってくれると。んんん〜難しい。
order(track_ranking$n)
[1] 1 19 47 1 7 8 13 4 102 11 147 4 2 56 1 90 105 6 1 5 35 17 1
...
おおお、出た出た。これをインデックスに使えばいいのですね。
track_ranking[order(track_ranking$n)]
エラー: Column indexes must be at most 2 if positive
なんでやねん・・・2個引数が必要？全ての列ってどうやって表現するの？
調べてもわからなかったのだけど。どうやら、
track_ranking[order(track_ranking$n),]
と、列に空を指定してやるといいらしい。空はどうやら自身を返す(?)らしい。
> tail(track_ranking[order(track_ranking$n),])
# A tibble: 6 x 2
track n
<fctr> <int>
1 紅の詩 181
2 全力☆ランナー 185
3 まっすぐ 203
4 ハイタテキ! 231
5 誘惑したいや 264
6 ラブリースマイリーベイビー 271
おー出た出た。ん？ラブスマが一位になっている。
と、ここで、1ツイート中に同じ曲を何個も投票している人がいた。
それを排除するには、ユーザIDと曲でユニークにしてやればよくて、どうやら!duplicateなる関数を使えばいいらしい。
試行錯誤の結果、ユニークにしたい行を取り出して、それでTRUE, FALSEのベクトルを出して、それを添字に書けばいいことがわかった(書いててよくわからない)ので、書いてみる。
> track_uniq <- tracks[!duplicated(tracks[c("user_id", "track")]),]
> tail(track_uniq_rank[order(track_uniq_rank$n),])
# A tibble: 6 x 2
track n
<fctr> <int>
1 紅の詩 181
2 全力☆ランナー 185
3 まっすぐ 201
4 ハイタテキ! 223
5 ラブリースマイリーベイビー 235
6 誘惑したいや 255
おー。出た出た。なんか元記事と結果が違っている気がする・・・名寄せとか間違ったかなぁ・・・
しかし、正直なところ、もうこれ以上頑張れる気がしなかったので、これを元にとりあえず、色々Rを試してみることにしました。
まずは棒グラフ
track_rank_order <- track_uniq_rank[order(track_uniq_rank$n, decreasing = TRUE),]
barplot(track_rank_order$n[1:20], names.arg = track_rank_order$track[1:20])
文字化けしとるやんけ・・・parなる関数で修正できるらしい。
それに票数(3行目)、曲名を入れて
par(family = "HiraKakuProN-W3", ps = 6)
track_plot <- barplot(sort(track_rank_order$n[1:10]), horiz = TRUE)
text(sort(track_rank_order$n[1:10]), track_plot - 0.1, sort(track_rank_order$n[1:10]), pos=2)
text(0, track_plot - 0.1, sort(track_rank_order$track[1:10]), pos=4)
おー、出た出た。
クラスタ分析
まずは、階層的クラスタリングなるものをしてみる。
そのためにはクロス表が必要らしい。
library("tidyverse")
track_cross <- track_uniq %>% group_by(tweet_id, track) %>% tally %>% spread(track, n)
track_cross[track_cross > 1] <- 0
そこから距離を作成
track_dist <- dist(track_cross)
track_rc <- hclust(track_dist)
で、プロット
plot(track_rc)
なんだこれ・・・ほぼ勝ち抜きみたい・・・
下から順にグループ分けされていく感じ？
とりあえず、次にK平均法でやってみます。
階層的クラスタリングから9つくらいのグループに分ければよさそうなので、おりゃーとやってみます。
クロス集計表で、NAがないようにしてからK平均法をかけてみます。
(cross_tracks[is.na(cross_tracks)] <- 0)
(track_k <- kmeans(track_cross[2:ncol(track_cross),], 10))
K-means clustering with 10 clusters of sizes 18, 13, 14, 16, 15, 10, 16, 11, 20, 17
Cluster means:
user_id Another Day CHAN-CHARA-CHAN Chuning!! Dear Dear Dear ebiture Fantastic Baby Love
1 5112941 0 0.11111111 0.05555556 0 0.000 0.05555556 0
2 5112941 0 0.00000000 0.15384615 0 0.000 0.00000000 0
3 5112941 0 0.00000000 0.00000000 0 0.000 0.00000000 0
4 5112941 0 0.00000000 0.00000000 0 0.125 0.00000000 0
5 5112941 0 0.00000000 0.06666667 0 0.000 0.00000000 0
6 5112941 0 0.10000000 0.10000000 0 0.000 0.00000000 0
(中略)
Within cluster sum of squares by cluster:
[1] 116.88889 98.76923 84.14286 104.50000 124.13333 75.80000 99.18750 73.09091 130.10000
[10] 113.88235
(between_SS / total_SS = 19.8 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss" "betweenss"
[7] "size" "iter" "ifault"
・・・なんだ・・・これは
とりあえず、between_SS/total_SSでググってみるとK平均法の制度で80%もあれば制度がいいとのこと。全然、ダメですね・・・もっとクラスタリングを増やしてみるのがいいのかな？
しかし、20に増やしたところで、20%を超えることはなく、これはこれで仕方ないのかなぁとか思いました。
とりあえず、3つクラスタを採ってみて、それぞれのクラスタで何が人気なのか出してみましょう。
(track_k <- kmeans(track_cross, 3, nstart=100))
for ( i in 1:3 ) {
track_part <- track_cross[track_k$cluster == i,]
track_sum <- data.frame(colnames(track_part)[2:ncol(track_part)], as.vector(sapply(track_part[2:ncol(track_part)], sum)))
colnames(track_sum) <- c('曲名', '票数')
print(head(track_sum[order(track_sum['票数'], decreasing = TRUE),]))
}
nstartを同じ数値にしないと毎回同じ数値が出ない・・・どうも精度がやはりよくないようです。K-平均法を使うのは間違っているのかもしれません。
曲名 票数
95 ラブリースマイリーベイビー 93
92 まっすぐ 83
127 全力☆ランナー 78
115 紅の詩 73
76 ナチュメロらんでぶー 69
87 ポップコーントーン 64
曲名 票数
146 誘惑したいや 236
87 ポップコーントーン 66
92 まっすぐ 66
64 スターダストライト 65
76 ナチュメロらんでぶー 62
95 ラブリースマイリーベイビー 62
曲名 票数
80 ハイタテキ! 192
95 ラブリースマイリーベイビー 80
115 紅の詩 64
61 サドンデス 63
105 感情電車 55
121 春休みモラトリアム中学生 55
アソシエーション分析もして見る
arulesというライブラリを使うとアソシエーション分析なるものもできるそうです。
track.tran <- as(as.matrix(track_cross[2:ncol(track_cross)]), "transactions")
track.ap <-apriori(track.tran,parameter = list(supp =0.01,maxlen=7,confidence=0.01))
inspect(head(sort(track.ap, by = "confidence"), n=10))
結果
| lhs | rhs | support | confidence | lift | count | |
|---|---|---|---|---|---|---|
| {イッショウトモダチ,なないろ} | => | {まっすぐ} | 0.0111111111111111 | 1 | 3.58208955223881 | 8 |
| {PLAYBACK,ナチュメロらんでぶー,幸せの貼り紙はいつも背中に} | => | {誘惑したいや} | 0.0111111111111111 | 1 | 2.82352941176471 | 8 |
| {なないろ,ハイタテキ!,梅} | => | {サドンデス} | 0.0111111111111111 | 1 | 5.80645161290323 | 8 |
| {なないろ,仮契約のシンデレラ,全力☆ランナー} | => | {まっすぐ} | 0.0111111111111111 | 1 | 3.58208955223881 | 8 |
| {スターダストライト,感情電車,幸せの貼り紙はいつも背中に} | => | {誘惑したいや} | 0.0111111111111111 | 0.888888888888889 | 2.50980392156863 | 8 |
| {サドンデス,スーパーヒーロー,ハイタテキ!,感情電車} | => | {なないろ} | 0.0111111111111111 | 0.888888888888889 | 5.3781512605042 | 8 |
| {スーパーヒーロー,なないろ,仮契約のシンデレラ} | => | {まっすぐ} | 0.0152777777777778 | 0.846153846153846 | 3.03099885189437 | 11 |
| {パクチー,まっすぐ} | => | {誘惑したいや} | 0.0138888888888889 | 0.833333333333333 | 2.35294117647059 | 10 |
| {CHAN-CHARA-CHAN,アンコールの恋} | => | {全力☆ランナー} | 0.0194444444444444 | 0.823529411764706 | 3.20508744038156 | 14 |
| {永遠に中学生,仮契約のシンデレラ} | => | {誘惑したいや} | 0.0125 | 0.818181818181818 | 2.31016042780749 | 9 |
これを描画してみると
track.gr <- subset(track.ap, subset = (lift >= 5))
plot(track.gr, method="graph")
なんか、さっきの結果と違うぞ？
結論
もっと勉強してからやればよかった！！！