環境　
Windows
R 3.2.5
Microsoft R Open 3.2.5

これからやること

前回( https://qiita.com/gaborotta/items/328d01355cd3e12bd070 )収集した、2019年2月から過去1年間でニコニコ動画ゲームカテゴリのランキングTOP100に入った動画・投稿者の情報を統計的に分析する。

前回収集したデータは以下。
まずはそれぞれの属性について、ヒストグラムを描いて分布を見ることとする。
※IDや名前は着目しても意味ないので放置。

動画情報
- ID
- 投稿日時（DATE）
- 動画再生時間（LENGTH）
- 過去最高ランク（MAX_RANK）
投稿者情報
- ID
- 名前（NAME）　
- フォロワー数（FOLLOWER_NUM）　
- 投稿動画数（VIDEO_NUM）　
- ユーザー登録時のニコニコVer（NICO_VER）　
タグ情報
- 動画ID (VIDEO_ID)
- タグ名　(TAG_NAME)

使うパッケージの読み込み

高速な表データの処理が出来るdata.table
SQL風に表データの加工が出来るdplyr,tidyr
素敵なグラフを作れるggplot2,gridExtra

library(data.table)
library(dplyr)
library(ggplot2)
library(tidyr)
library(gridExtra)

まずはともあれヒストグラム

とりあえず各属性のヒストグラムを描いて分布を見てみる。これ大事。
何か偏りが見つかるかもしれないし、何も見つからないかもしれない。
当たり前の事を証明するだけになるかもしれない。

1.投稿年月に着目

方法

元データの日付データが yyyy-mm-ddT HH:MM:SS形式の値型なので、文字列に変換後にtidyrのseparate関数で年月日、時間に分割
グラフの横軸はyyyy-mm形式で扱いたいので、pasteで結合。
文字列だとggplotのgeom_histogramは使えないので、group_byとsummariseで集計して棒グラフで表示。
表示範囲が広すぎてよく分からない図になってしまうので、データ範囲を分割してgridExtraでグラフを複数表示。

グラフは横軸は投稿年月、縦軸が動画数。
ゲームカテランキング100位以内に入った動画ということを忘れずに。

### MONTH###
video_date<-mutate(videoData,DATE=as.character(DATE))
video_date<-separate(video_date,DATE,into = c("day", "time"),sep = "T",extra = "drop")
video_date<-separate(video_date,day,into = c("year", "month","day"),sep = "-",extra = "drop")
video_date<-group_by(video_date,year,month)
video_date<-summarise(video_date,count=n())
video_date<-mutate(video_date,date=paste(year,month,sep = "-"))

video_date2<-filter(video_date,year>2016)
video_date3<-filter(video_date,year<=2016)

# グラフ作成
g1 <- ggplot(video_date, aes(x = date, y = count, fill = date))
g1 <- g1 + geom_bar(stat = "identity")+theme(legend.position = 'none')+theme(axis.text.x = element_text(angle = 90, hjust = 1))

g2 <- ggplot(video_date2, aes(x = date, y = count, fill = date))
g2 <- g2 + geom_bar(stat = "identity")+theme(legend.position = 'none',axis.text.x = element_text(angle = 90, hjust = 1))

g3 <- ggplot(video_date3, aes(x = date, y = count, fill = date))
g3 <- g3 + geom_bar(stat = "identity")+theme(legend.position = 'none',axis.text.x = element_text(angle = 90, hjust = 1))

# 出力
layout1 <- rbind(c(1,1,1),c(2,2,2),c(3,3,3))
grid.arrange(g1, g2,g3,layout_matrix = layout1)

結果

一番上はグラフの全体図
真ん中は2017年～に範囲指定したグラフ
一番下は～2017年のグラフ

考察

元データは2017年12月半ば～2019年2月頭までのランキングに入った動画なので、その期間の動画数が圧倒的に多い分布になっている。
しかし、それ以前の動画も何度かランクインしているのが分かる。新しい動画ばかり見られてるわけではないということ。
特に2009年5月～2009年8月に投稿された動画が多く再ランクインしているのが特徴的。ドラクエ8の動画が多かったよ。なんでだろ。

データ収集期間中の動画数は約1500本、30日間あるとすると、1日約50本が新規ランクイン。毎日100位まであることを考えると、意外と少ない気もする。約半分。
人気動画は何回も見られているというのが分かる結果でした。

2.投稿時間に着目

方法

さっきの続きで、時間をさらに時分秒に分割。
あとは同じく集計して棒グラフで表示。
グラフは横軸が投稿時間帯、縦軸が動画数。

### HOUR###
video_hour<-mutate(videoData,DATE=as.character(DATE))
video_hour<-separate(video_hour,DATE,into = c("day", "time"),sep = "T",extra = "drop")
video_hour<-separate(video_hour,time,into = c("hour", "minute","second"),sep = ":",extra = "drop")
video_hour<-group_by(video_hour,hour)
video_hour<-summarise(video_hour,count=n())
g <- ggplot(video_hour, aes(x = hour, y = count, fill = hour))
g <- g + geom_bar(stat = "identity")+theme(legend.position = 'none')
plot(g)

結果

考察

17時～0時が多い。
特に18時、19時が多く、視聴者が多く見そうな時間を狙っているような気もする。投稿時間の指定もできるので。
狙っていなくとも、仕事・学校終わりの時間に投稿しているのかもしれない。
ここにランクイン動画の影響があるのかは不明。投稿動画全体に言えることかもしれないので、ここではそこまで結論付けれない。

3.動画再生時間に着目

方法

元データがHH時間MM分SS秒表記で、数値が無いときはそれぞれ省略表記される形式なので、うまく時分秒に分割する。
最後の”時間”で分割するときにfill="left"を指定しているのが重要。存在しないときはNAを左の列（hour）に入れる。
あとは再生時間を全て秒に変換（時間3600+分60+秒）。これで比較が簡単に。
そしてそれをgeom_histogramでヒストグラム描画。横軸が再生時間、縦軸が動画数。

### LENGTH###
video_length<-videoData
video_length<-video_length %>% separate(LENGTH,into = c("minute"),sep = c("秒"),extra = "drop")
video_length<-video_length %>% separate(minute,into = c("minute", "second"),sep = c("分"),extra = "drop")
video_length<-video_length %>% separate(minute,into = c("hour", "minute"),sep = c("時間"),extra = "drop",fill="left") 
video_length<-video_length %>% mutate(hour=as.numeric(hour),minute=as.numeric(minute),second=as.numeric(second))
video_length[is.na(video_length)]<-0
video_length<-video_length %>% mutate(time=hour*3600+minute*60+second)

# グラフ作成
g1 <- ggplot(video_length, aes(x = time))+geom_histogram(binwidth = 60)
g1<-g1+theme(axis.text.x = element_text(angle = 90, hjust = 1))+scale_x_continuous(breaks=seq(0,25000,300))
plot(g1)

g2 <- ggplot(video_length, aes(x = time))+geom_histogram(binwidth = 60)
g2<-g2+scale_x_continuous(breaks=seq(0,2700,60),limits = c(0,2700))+theme(axis.text.x = element_text(angle = 90, hjust = 1))
plot(g2)

# 出力
layout1 <- rbind(c(1),c(1),c(1),c(2),c(2))
grid.arrange(g1, g2,layout_matrix = layout1)

結果

上が全体グラフ表示
下が2700秒（45分）までの範囲で表示。

考察

正規分布なグラフに。素敵。
一番多いのが600秒（10分）～720秒（12分）の動画。確かに多い気もする。
900秒（15分）超えたあたりから減少傾向。
480秒（6分）より短い動画も少ない傾向。
やはり10分前後の動画が見やすいし、作りやすいのかもしれない。自分もそのぐらいが好きです。

ちなみに最長の動画は5時間でした。長い。

4.最高ランクに着目

方法

これは簡単。そのままヒストグラム関数に突っ込むだけ。
横軸が過去最高ランク、縦軸が動画数

### MAX_RANK###
video_rank<-videoData
g <- ggplot(video_rank, aes(x = MAX_RANK))+geom_histogram(binwidth = 1)
g<-g+theme(axis.text.x = element_text(angle = 90, hjust = 1))+scale_x_continuous(breaks=seq(0,100,5),limits = c(0, 100))
plot(g)

結果

考察

10位上にランクインした動画数が多いという結果に。

ここで注意しなければいけないのが、過去最高ランクということ。
初日に1位になって、次の日に10位に落ちても、最高ランクは1位の動画としてカウント。
同じ動画が重複して動画数にカウントされない。

仮に毎日TOP100の動画が全て入れ替わるのであれば、一様分布（ランクごとの動画数は一定）になるはず。
しかし、実際には上位ランクの動画が1日でランク外に落ちることは少ないため、上位ランクの動画がランキングに居座ることになる。
そうするとその分、他の動画がランキングに入る余地が少なくなるため、下位ランクの動画数が少なくなる。
これにより、上のようなグラフが出来上がるのだと考えられる。

つまり、一度10位以上になった動画は後日もランキングに残りやすいということが分かるグラフ。

5.投稿者のフォロワー数に着目

方法

これもデータ加工は必要なし。
そのままヒストグラムの関数に入れる。横軸はフォロワー数、縦軸は投稿者数

### FOLLOWER_NUM###
user_follow<-userData

# グラフ作成
g1 <- ggplot(user_follow, aes(x = FOLLOWER_NUM))+geom_histogram(binwidth = 50)
g1<-g1+theme(axis.text.x = element_text(angle = 90, hjust = 1))#+scale_x_continuous(breaks=seq(0,1000,10),limits = c(0, 1000))
plot(g1)

g2 <- ggplot(user_follow, aes(x = FOLLOWER_NUM))+geom_histogram(binwidth = 50)
g2<-g2+theme(axis.text.x = element_text(angle = 90, hjust = 1))+scale_x_continuous(breaks=seq(0,5000,100),limits = c(0, 5000))
plot(g2)

# 出力
layout1 <- rbind(c(1),c(1),c(2),c(2),c(2))
g<-grid.arrange(g1, g2,layout_matrix = layout1)

結果

上段がグラフ全体図
下段がフォロワー5000人以下の範囲で表示したグラフ

考察

0人が多くなっているが、これは非公開設定によるもの。
フォロワー数が多くなるほど投稿者数が減少している。
ランクイン動画を投稿していても1000人以上のフォロワーがいる投稿者は意外と少ない。

とくにこの図からではランクインとの関係は不明かと。
ランクインしていない動画の投稿者情報と比べれば何らかの差が出るかもしれないが、データが無いので今は放置。

6.投稿者の投稿動画数に着目

方法

これもそのままヒストグラムに突っ込むだけ。
横軸が動画数、縦軸が投稿者数

### VIDEO_NUM###
user_video<-userData

# グラフ作成
g1 <- ggplot(user_video, aes(x = VIDEO_NUM))+geom_histogram(binwidth = 5)
g1<-g1+theme(axis.text.x = element_text(angle = 90, hjust = 1))# +scale_x_continuous(breaks=seq(0,1000,10),limits = c(0, 1000))

g2 <- ggplot(user_video, aes(x = VIDEO_NUM))+geom_histogram(binwidth = 5)
g2<-g2+theme(axis.text.x = element_text(angle = 90, hjust = 1))+scale_x_continuous(breaks=seq(0,300,5),limits = c(NA, 300))

# 出力
layout1 <- rbind(c(1),c(1),c(2),c(2),c(2))
g<-grid.arrange(g1, g2,layout_matrix = layout1)

結果

上段が全体表示
下段が動画数300以下の範囲で表示。

考察

0が多いのは非公開設定のため。過去の投稿動画は黒歴史もあるからね、仕方ないね。
5本以下の投稿者が多いことから、才能を感じずにはいられません。
ランクイン動画の投稿者であれば動画投稿数がそれなりに多いと思ったのですが、それが読み取れる分布にはなりませんでした。

ちなみに一番多い人は2300本くらい投稿していました。凄すぎる...。

7.投稿者のユーザー登録時のニコニコVerに着目

方法

こちらは文字列なので集計してから棒グラフで表示。
横軸がニコニコVer、縦軸が投稿者数

### NICO_VER###
user_nico<-userData
user_nico<-user_nico %>% group_by(NICO_VER) %>% summarise(count_num=n())

# グラフ作成
g <- ggplot(user_nico, aes(x = NICO_VER, y = count_num, fill = NICO_VER))
g <- g + geom_bar(stat = "identity")+theme(legend.position = 'none')
plot(g)

結果

考察

それぞれのニコニコVerが続いた期間を考慮できていないのでこれでは何とも。
単純にγ、原宿、GINZAが多いという結果に。GINZAは期間自体長かったしね。ユーザー数自体が多いかと。
しかし最新verの「く」でランクインしている人もいて、長く続けてればいいという訳でもなさそうなことが分かります。
各verの期間もしくはユーザー数で割ると何か面白い傾向が出るかもしれない。

8.動画タグに着目

方法

そして最後、タグ名。
どのタグが付けられている動画が多いかを見ることができる。はず。
タグはあまりにも種類が多いので、今回は100本以上の動画に付けられているタグにのみ着目

### タグ名###
# データ加工
tag_name<-group_by(videoTagData,TAG_NAME)
tag_name<-summarise(tag_name,count=n())
tag_name<-setorder(tag_name,count)
tag_name1<-filter(tag_name,count>=100,count<200)
tag_name2<-filter(tag_name,count>=200,count<1000)
tag_name3<-filter(tag_name,count>=1000)

# グラフ作成
g0 <- ggplot(tag_name, aes(x = count))+geom_histogram(binwidth = 1)+scale_x_log10(breaks=10^(-1:6)) + scale_y_log10(breaks=10^(0:10))
g0<-g0+theme(axis.text.x = element_text(angle = 90, hjust = 1))#+scale_x_continuous(breaks=seq(0,1000,10),limits = c(0, 1000))
plot(g0)

g1 <- ggplot(tag_name1,aes(x=reorder(x = TAG_NAME, X = count, FUN = mean),y=count,fill=TAG_NAME))
g1 <- g1 + geom_bar(stat = "identity")+theme(legend.position = 'none')+theme(axis.text.x = element_text(angle = 90, hjust = 1))
plot(g1)

g2 <- ggplot(tag_name2,aes(x=reorder(x = TAG_NAME, X = count, FUN = mean),y=count,fill=TAG_NAME))
g2 <- g2 + geom_bar(stat = "identity")+theme(legend.position = 'none')+theme(axis.text.x = element_text(angle = 90, hjust = 1))
plot(g2)

g3 <- ggplot(tag_name3,aes(x=reorder(x = TAG_NAME, X = count, FUN = mean),y=count,fill=TAG_NAME))
g3 <- g3 + geom_bar(stat = "identity")+theme(legend.position = 'none')+theme(axis.text.x = element_text(angle = 90, hjust = 1))
plot(g3)

# 出力
layout1 <- rbind(c(1,1,1),c(1,1,1),c(2,2,3),c(2,2,3),c(2,2,3))
g<-grid.arrange(g1, g2,g3,layout_matrix = layout1)

結果

上段が動画数100本以上200本未満
下段左が200本以上1000本未満
下段右が1000本以上

考察

ゲームタグが最も多いのは、ゲームカテゴリに入った動画を集計しているから。
次いで多いのがVOICEROID実況、ゆっくり実況、ボイロの各キャラ実況といった実況方法によるタグ
ゲームジャンルとしては、DbD、FGO、マイクラの順でランクイン動画数が多い。
やはり流行りのゲームや過去から人気のゲームの動画数が多い傾向に。

動画数としてみているが、シリーズ動画が重複してカウントされているため、投稿者数で見るとまた違った分布になるかもしれない。

まとめ

前回収集したデータの属性をとりあえずヒストグラム描いてみてみました。
それぞれ更なる分析の可能性がありそうなものから、なさそうなものまで色々。

次は複数の属性を組み合わせた分布を見ていきます。

ここまでやってふと思ったけれど、これランクインしていない動画の情報も集めた方がいいんじゃ...。
ランクインする動画の条件みたいなのを出せる気がする...。
とは言っても、うまく出ないのがデータ分析の辛いところ。
ランクインしてない動画もしてる動画も似たような傾向だったりね。よくある話。