動画タグネットワーク分析を用いた ニコニコ動画における萌芽文化発見の試み ~”ゆっくり関連タグ”を例として~
•Download as PPTX, PDF•
2 likes•3,415 views
ニコニコ動画では、各動画ごとに"タグ"と呼ばれる視聴者及び投稿者が付けることのできる"動画の何かしらを表現する一言"を付け加えることができます。 このスライドでは、タグの共起関係から構築出来るタグネットワークを用いて"ゆっくり文化"の発展と現状を俯瞰するとともに、先行研究を用いて"今後文化として定着し得るタグ"を見つけることを試行しました。
![ ネットワーク形式へ_2
この状態から次の関数(https://gist.github.com/peccu/4328957
)で隣接行列形式に変換します
adjacency <- function(n){
## 出力行列の初期化
mydata <- diag(0,length(colnames(n)))
## 行，列に名前を付ける
colnames(mydata) <- colnames(n)
rownames(mydata) <- colnames(n)
## rは列番号
for(r in 1:length(colnames(n))){
## r行目に，縦方向に合計したものを代入
mydata[r,] <- colSums(
## r列目が1になっている行を対象にして
n[n[,r] == 1,]
)
}
mydata
}
関数使わせていただきました
ありがとうございました](https://image.slidesharecdn.com/niconicotagnetwork-151025075447-lva1-app6892/85/-18-320.jpg)
![ トレーニングセット(学習・テスト)の作成_2
ランキング総合ポイントで上位100、下位100くらいになるように
データを選別して半々に分けます
# 予め作成したノードリストを読み込む
set<-read.csv(“taggraph_nodes.csv”,fileEncoding = “CP932”)
#再生数などの情報は既にポイントで反映していると考え削除しておく。計算結果を最終
的にsetに貼って出力しGephiでまた使う
set1<-set[,c(-2,-3,-10,-17,-18,-19)]
plus<-subset(set1,set1$Points>2.5*mean(set1$Points))
minus<-subset(set1,set1$Points<0.05*mean(set1$Points))
plus$culture<-as.factor(1)
minus$culture<-as.factor(0)
# チューニング用とテスト用に分ける
plus1<-plus[c(1:47),]
plus2<-plus[c(48:93),]
minus1<-minus[c(1:46),]
minus2<-minus[c(47:93),]
learning<-data.frame(rbind(plus1,minus1))
test<-data.frame(rbind(plus2,minus2))
実際には100じゃなくて
93ですが](https://image.slidesharecdn.com/niconicotagnetwork-151025075447-lva1-app6892/85/-24-320.jpg)
![ トレーニングセット(学習・テスト)の作成_3
データ型をそれぞれ適したものにしつつ整形していきます
Apply型関数で一気にやるべきですほんとは
HubとAuthorityは値が同じだったのでAuthorityのみ残します
# 日付型は使えないのでnumericに。あと、Hubは削除。
set1$ave_starttime<-as.numeric(set1$ave_starttime)
set1$Authority<-as.numeric(set1$Authority)
learning1<-learning[,c(-1,-5,-16)]
learning1$ave_starttime<-as.numeric(learning1$ave_starttime)
learning1$Authority<-as.numeric(learning1$Authority)
test1<-test[,c(-1,-5,-16)]
test1$ave_starttime<-as.numeric(test1$ave_starttime)
test1$Authority<-as.numeric(test1$Authority)](https://image.slidesharecdn.com/niconicotagnetwork-151025075447-lva1-app6892/85/-25-320.jpg)
![ 分類器のチューニング_3
#二回目のチューニング。色が濃いところにグリッドサーチを絞る
gamma <- 10^(-1)
cost <- 10^(1)
gammaRange <- 10^seq(log10(gamma)-
1,log10(gamma)+1,length=11)[2:10]
costRange <- 10^seq(log10(cost)-
1 ,log10(cost)+1 ,length=11)[2:10]
t <- tune.svm(Species ~ ., data = iris, gamma=gammaRange,
cost=costRange,
tunecontrol = tune.control(sampling="cross",
cross=8))
cat("gamma =", t$best.parameters$gamma, "; cost =",
t$best.parameters$cost, ";n")
cat("accuracy:", 100 - t$best.performance * 100, "%nn")
plot(t, transform.x=log10, transform.y=log10)](https://image.slidesharecdn.com/niconicotagnetwork-151025075447-lva1-app6892/85/-29-320.jpg)
![ 分類器のチューニング_5
何はともあれ高い値を出しているので、こいつでいくことに
テストデータで精度を確認する
精度は低いが…今回は結局このまま突っ走りました
gamma <- t$best.parameters$gamma
cost <- t$best.parameters$cost
model <- svm(culture ~ ., data = learning1, gamma=gamma,
cost=cost,probability = TRUE)
#テストデータで精度を確認する
pred <- predict(model, test1)
table(pred, test1[,14])
pred 1 0
## 1 34 12
## 0 13 33
うわっ…
私の学習器の精度低すぎ(約72%)…？
低いです](https://image.slidesharecdn.com/niconicotagnetwork-151025075447-lva1-app6892/85/-31-320.jpg)
![ (参考)ランダムフォレストで算出した
各変数の重要度_1
ランダムフォレストで計算できる特徴量の重要度(ジニ係数減少量)
を求めてみます
# 蛇足だとは思いますが一応チューニング
tuneRF(learning1[,-14],learning1[,14],doBest=T)
決定木の分割する木の数を
最適化しています](https://image.slidesharecdn.com/niconicotagnetwork-151025075447-lva1-app6892/85/-33-320.jpg)
動画タグネットワーク分析を用いた ニコニコ動画における萌芽文化発見の試み ~”ゆっくり関連タグ”を例として~
- 5. 仮説 これまでの文化が廃れつつあるならば、それに対して反発するので はなく今ある“ニコニコ的な文化”に注目することも大事なのでは 今回、“ニコニコ的な文化”として注目するのは“ゆっくり” 東方キャラクターはニコニコ動画との付き合いが長い 投稿者の匿名性を保ちながらも、動画に分かりやすいモチー フを与える重要な役割を果たしている “ゆっくり”文化を動画タグネットワークで俯瞰・分析するとともに、 今はまだ文化として定着していないが、ネットワーク構造的に定着 してもおかしくない文化を動画タグで見つけることを試みる
- 8. 先行研究の紹介_2 つまるところこんな感じだと思われる 著者 A 著者 B 著者 C 著者 D 著者 G 著者 F 著者 H 著者 E 著者 I 1. 次数の大きいノードが影響力の高 い研究者であると考えそれらを正例、 次数の小さいノードを負例として考 える 2. 機械学習で分類器を作成 3. 今はまだ共著者数が多くないが、 ネットワークの構造指標的に次数が 多くなるだろうと予測されるノード (研究者)を抽出する 正例 負例 新たに見つけた ノード あくまでも イメージ図です
- 14. データを集めてくる ニコニコ動画スナップショット検索APIで、”ゆっくり”を含むタグ を持つ動画を取得します(http://github/dichika/niconico で公開 されているラッパーを使用しました。) 選んだタグは動画数が1000以上あるもの APIの関係上、取得できるサイズは100が限界でした。全部で28個 のタグで検索し、2800個の動画情報を取得し、一つのデータへ require(niconico) require(igraph) # ゆっくりに関連したタグで検索をかける s1<-getSearch(query = "ゆっくり実況プレイ", size = 100, type = "tag") s2<-getSearch(query = “ゆっくり実況”, size = 100, type = “tag”) 〜中略〜 s27<-getSearch(query = "ホラーゆっくり実況", size = 100, type = "tag") s28<-getSearch(query = "ゆっくり生活", size = 100, type = "tag")
- 18. ネットワーク形式へ_2 この状態から次の関数(https://gist.github.com/peccu/4328957 )で隣接行列形式に変換します adjacency <- function(n){ ## 出力行列の初期化 mydata <- diag(0,length(colnames(n))) ## 行，列に名前を付ける colnames(mydata) <- colnames(n) rownames(mydata) <- colnames(n) ## rは列番号 for(r in 1:length(colnames(n))){ ## r行目に，縦方向に合計したものを代入 mydata[r,] <- colSums( ## r列目が1になっている行を対象にして n[n[,r] == 1,] ) } mydata } 関数使わせていただきました ありがとうございました
- 19. ネットワーク形式へ_3 先ほどの関数を用いて変換し、igraphの書き出し機能でGephiで読 み込めるフォーマット”gml”にします わざわざGephiで計算させるのは、ネットワークオブジェクトは Gephiで扱う癖が抜けないため もっとRと仲良くならねばなりません seed<-read.csv("seed.csv",fileEncoding="cp932") adj<-adjacency(seed) g <- graph.adjacency(adj,weighted=TRUE) write.graph(g,"taggraph.gml","gml") 多分igraphで 全部計算できましたね
- 23. トレーニングセット(学習・テスト)の作成_1 モデルを学習させるデータとその精度をテストするデータに分けな いといけない 本当はチューニング用のデータもあるべきですが、Rでモデルを 作った後別データでチューニングする方法を知らないのです (http://techlife.cookpad.com/entry/2015/09/30/170015) 今回トレーニングセットを選ぶのに用いた指標:ランキング総合ポ イント ランキング総合ポイント=(総合ポイント＝再生数+(コメント数 ×補正値)+マイリスト数×15) 補正値=(再生数+マイリスト数)/(再生数+コメント数+マイリス ト数) 広告ポインヨは今回無視しています
- 24. トレーニングセット(学習・テスト)の作成_2 ランキング総合ポイントで上位100、下位100くらいになるように データを選別して半々に分けます # 予め作成したノードリストを読み込む set<-read.csv(“taggraph_nodes.csv”,fileEncoding = “CP932”) #再生数などの情報は既にポイントで反映していると考え削除しておく。計算結果を最終 的にsetに貼って出力しGephiでまた使う set1<-set[,c(-2,-3,-10,-17,-18,-19)] plus<-subset(set1,set1$Points>2.5*mean(set1$Points)) minus<-subset(set1,set1$Points<0.05*mean(set1$Points)) plus$culture<-as.factor(1) minus$culture<-as.factor(0) # チューニング用とテスト用に分ける plus1<-plus[c(1:47),] plus2<-plus[c(48:93),] minus1<-minus[c(1:46),] minus2<-minus[c(47:93),] learning<-data.frame(rbind(plus1,minus1)) test<-data.frame(rbind(plus2,minus2)) 実際には100じゃなくて 93ですが
- 26. 分類器の作成 # SVMによる学習とチューニングを行います presvm<-svm(culture~.,learning1,cross=8) summary(presvm) Parameters: ## SVM-Type: C-classification ## SVM-Kernel: radial ## cost: 1 ## gamma: 0.07692308 ## Number of Support Vectors: 52 ## ( 26 26 ) ## Number of Classes: 2 ## Levels: ## 1 0 ## 8-fold cross-validation on training data: ## Total Accuracy: 84.04255 ## Single Accuracies: ## 81.81818 83.33333 100 83.33333 63.63636 91.66667 91.66667 75
- 27. 分類器のチューニング_1 # ここからはチューニング。一回目。 gammaRange = 10^(-5:5) costRange = 10^(-2:2) t <- tune.svm(culture ~ ., data = learning1, gamma=gammaRange, cost=costRange, tunecontrol = tune.control(sampling="cross", cross=8)) cat(“- best parameters:n”) cat("gamma =", t$best.parameters$gamma, "; cost =", t$best.parameters$cost, ";n") cat("accuracy:", 100 - t$best.performance * 100, "%nn") plot(t, transform.x=log10, transform.y=log10)
- 29. 分類器のチューニング_3 #二回目のチューニング。色が濃いところにグリッドサーチを絞る gamma <- 10^(-1) cost <- 10^(1) gammaRange <- 10^seq(log10(gamma)- 1,log10(gamma)+1,length=11)[2:10] costRange <- 10^seq(log10(cost)- 1 ,log10(cost)+1 ,length=11)[2:10] t <- tune.svm(Species ~ ., data = iris, gamma=gammaRange, cost=costRange, tunecontrol = tune.control(sampling="cross", cross=8)) cat("gamma =", t$best.parameters$gamma, "; cost =", t$best.parameters$cost, ";n") cat("accuracy:", 100 - t$best.performance * 100, "%nn") plot(t, transform.x=log10, transform.y=log10)
- 30. 分類器のチューニング_4 ベストパラメータは cost= 6.309573,gamma= 0.03981072で 正解率が97.36842 %でした →過学習気味？
- 31. 分類器のチューニング_5 何はともあれ高い値を出しているので、こいつでいくことに テストデータで精度を確認する 精度は低いが…今回は結局このまま突っ走りました gamma <- t$best.parameters$gamma cost <- t$best.parameters$cost model <- svm(culture ~ ., data = learning1, gamma=gamma, cost=cost,probability = TRUE) #テストデータで精度を確認する pred <- predict(model, test1) table(pred, test1[,14]) pred 1 0 ## 1 34 12 ## 0 13 33 うわっ… 私の学習器の精度低すぎ(約72%)…？ 低いです
- 34. (参考)ランダムフォレストで算出した 各変数の重要度_2 mtry=6が最適らしいので # mtry=6が最適な模様 importance<-randomForest(culture~.,learning1,mtry=6,importance = TRUE) knitr::kable(importance(importance)) ggplot2で横棒グラフにしてみました
- 63. “文化”として定着しつつある “ゆっくり”関連タグとは_3 全体のネットワークにおいて高いものから表にしてみた ここはほぼ ゲーム実況か 東方 コミュニティ name ave_view ave_comment ave_mylistave_length modify_prob ability まんじゅうこわい 24930.5 511.5 433.5 1504.0 99.691% ACE2 34896.0 1517.5 81.5 1658.0 99.529% ウルヲイ 52591.5 4787.5 154.5 1327.5 99.524% 綺麗な我様 11705.0 497.0 56.0 1632.0 99.493% 紡がれ続けた物語の終わ り 11705.0 497.0 56.0 1632.0 99.493% タイトルに偽り無し 11705.0 497.0 56.0 1632.0 99.493% 物語は紡ぎ紡がれていく 11705.0 497.0 56.0 1632.0 99.493% 聞くだけ動画 23658.5 422.5 431.0 1054.0 99.197% 壷算 13365.0 231.0 55.0 1212.0 99.161% へうげもの 13365.0 231.0 55.0 1212.0 99.161% 化け物つかい 15909.0 409.0 60.0 2112.0 99.125% ハロワ 15909.0 409.0 60.0 2112.0 99.125% 変態包囲網 51482.0 2326.0 123.0 1429.0 99.026% ツーリング 51482.0 2326.0 123.0 1429.0 99.026%
- 64. “文化”として定着しつつある “ゆっくり”関連タグとは_4 「まんじゅうこわい」が一番高い確率を叩き出す 解せぬ name ave_view ave_comment ave_mylistave_length modify_prob ability まんじゅうこわい 24930.5 511.5 433.5 1504.0 99.691% ACE2 34896.0 1517.5 81.5 1658.0 99.529% ウルヲイ 52591.5 4787.5 154.5 1327.5 99.524% 綺麗な我様 11705.0 497.0 56.0 1632.0 99.493% 紡がれ続けた物語の終わ り 11705.0 497.0 56.0 1632.0 99.493% タイトルに偽り無し 11705.0 497.0 56.0 1632.0 99.493% 物語は紡ぎ紡がれていく 11705.0 497.0 56.0 1632.0 99.493% 聞くだけ動画 23658.5 422.5 431.0 1054.0 99.197% 壷算 13365.0 231.0 55.0 1212.0 99.161% へうげもの 13365.0 231.0 55.0 1212.0 99.161% 化け物つかい 15909.0 409.0 60.0 2112.0 99.125% ハロワ 15909.0 409.0 60.0 2112.0 99.125% 変態包囲網 51482.0 2326.0 123.0 1429.0 99.026% ツーリング 51482.0 2326.0 123.0 1429.0 99.026%
- 66. “文化”として定着しつつある “ゆっくり”関連タグとは_6 「”ゆっくり,科学系解説”コミュニティ」で確率が高いタグ 解説系では 定番の反応 ですね name ave_view ave_com ment ave_mylist ave_length modify_prob ability 動画には本文を書けば どうか 4662 170 26 578 93.746% ひらがなでしゃべらせ て 4662 170 26 578 93.746% 分からんということが 分かった. 40737.5 898.7 151.8 720.5 93.602% FMEAutomator 13267 417 420 372 92.169% ニコ生 13267 417 420 372 92.169% FME 13267 417 420 372 92.169% ニコ生講座 13267 417 420 372 92.169% ヤンデレ 58156.8 4258.8 173.4 820.2 91.928% AxisPowersヘタリア 6369.5 191 29.5 463 91.315% がんばりましょう 6369.5 191 29.5 463 91.315%