婚約指輪についてdiamondsデータで学びを深める

ブライダルリング専門ブランド「アイプリモ調べ」によれば，2018年の時点で， 婚約指輪をあげた（もらった）者の割合は60.8%， 指輪を選んだ方法は，パートナーとお店に行ってが46.8%

www.iprimo.jp

ということから，やはりまだ婚約指輪は一般的みたいなので，知識をつけて おく必要はありそう。

ダイヤモンドの4C（Cut, Color, Clarity, Carat）の説明 zexy.net

diamondsデータについて

library(tidyverse)

# 因子型変数の確認
levels(diamonds$cut)
levels(diamonds$color)
levels(diamonds$clarity)

[1] "Fair" "Good" "Very Good" "Premium" "Ideal"
[1] "D" "E" "F" "G" "H" "I" "J"
[1] "I1" "SI2" "SI1" "VS2" "VS1" "VVS2" "VVS1" "IF"

• cutとclarityは悪い方から順に並んでいる
• color だけ良い方から順に並んでいる

colorの水準を逆転

dat <- 
  diamonds %>% 
  mutate(color = fct_rev(color))

diamondsデータで4Cと値段の関係をプロットする

まずは全体のデータで横軸にカラット，縦軸に値段の散布図を作成

ggplot(data = dat) + 
  geom_point(aes(carat, price)) 

1ctを超えると急激に値段が上昇している。

下記リンク先の説明によれば，
大きい方がいい？婚約指輪のダイヤモンド｜結婚指輪・婚約指輪｜ゼクシィ

婚約指輪のカラット数は0.3〜0.5ctが一般的

であるため，横軸の表示を0.3〜0.5ctに制限

ggplot(data = dat) + 
  geom_point(aes(carat, price)) + 
  coord_cartesian(xlim = c(0.3,0.5), ylim = c(0,5000)) # X軸とY軸の範囲指定

重なって分かりにくいので，jitterを追加

ggplot(data = diamonds) + 
  geom_jitter(aes(carat, price), alpha = 0.3) + 
  coord_cartesian(xlim = c(0.3,0.5), ylim = c(0,5000))

カラットと値段の散布図でカットの色別

ggplot(data = dat) + 
  geom_jitter(aes(carat, price, color = cut), alpha = 0.5) + 
  coord_cartesian(xlim = c(0.3,0.5), ylim = c(0,5000)) +
  guides(color = guide_legend(reverse = TRUE)) # legendの順番逆に（良い方が上に来るように）

カラットと値段の散布図でカラーの色別

ggplot(data = dat) + 
  geom_jitter(aes(carat, price, color = color), alpha = 0.5) + 
  coord_cartesian(xlim = c(0.3,0.5), ylim = c(0,5000)) +
  guides(color = guide_legend(reverse = TRUE)) # legendの順番逆に（良い方が上に来るように）

カラットと値段の散布図で透明度の色別

ggplot(data = diamonds) + 
  geom_jitter(aes(carat, price, color = clarity), alpha = 0.5) + 
  coord_cartesian(xlim = c(0.3,0.5), ylim = c(0,5000)) +
  guides(color = guide_legend(reverse = TRUE)) # legendの順番逆に（良い方が上に来るように）

婚約指輪の一般的なカラットの範囲では，透明度がいちばん値段との関係がありそう， という学びが得られた。カットはそれほど値段との関係がはっきりしなそう。

【2019年1月版】「ラブライブ」のweb上における人気度とAqoursのこれから

目次

約1年前に，web上の情報を使って「ラブライブ」の人気度の推移を考察した。

izunyan.hatenablog.com

この1年間でどのような変化があったのか，また最近の状況はどうなっているのか 新しいデータを取得して，再度検討する。

沼津駅北口にあるAqoursのイルミネーション; 2018年12月22日，筆者撮影

Google トレンドでみた「ラブライブ」の過去5年間の人気度推移

2018年12月31日の紅白出場や，2019年1月4日の劇場版公開によって，最近になり人気度が再度上昇したものの，基本的には昨年から引き続き漸減傾向である。

人気度という指標の名前ではあるが，あくまで検索トレンドなので，実際の人気度とイコールではない点に留意が必要である。「ラブライブ」という語が社会に定着し始めていて，あえて検索するまでもない既知の単語となってきたと考えると，普及初期のように検索者も増加し続けるわけではないだろう。

紅白出場は，沼津市の観光サイトでもその応援にかける熱意が伝わってくる。

numazukanko.jp

街をあげて応援ムードが高まっているのが以下のレポートの写真からも伝わってくるだろう。

gs.dengeki.com

Google トレンドでみた「μ's」「Aqours」の過去5年間の人気度

キーワードは両グループとも「女性アイドルグループ」のカテゴリーとした。

2018年1月分析時に見せていたAqoursの上昇傾向は，その後一旦落ちつきを見せたが，2018年6月10日から7月28日にかけて安定して高まっていた時期があった。この時期は，ちょうどAqours 3rd liveツアーの期間と重なる。

ラブライブ！サンシャイン!! Official Web Site | Aqours 3rd LIVE 特設サイト

そして，紅白出場決定および4th liveのあった11月11日から17日の週の上昇がやはりすごい。

mantan-web.jp ラブライブ！サンシャイン!! Official Web Site | Aqours 4th LIVE 特設サイト

そして紅白出場時の週は，Aqoursの過去最高の人気度に到達している。μ'sの紅白出場時と比べると，約4分の3の人気度とはなるが，多くの人にAqoursの存在が届いたであろうことが推測される。μ'sは紅白出場からしばらく人気度の高い状態が続いたが，Aqoursの場合は劇場版も重なっているため，ここがプロモーションのがんばりどころだろう。

ラブライブについてのTwitter公式アカウントのフォロワー数の変化

ラブライブ！シリーズ公式 (@LoveLive_staff) | Twitter

こちらは，単純に昨年の同時期のフォロワー数との比較のみ言及する。 ラブライブ！サンシャイン!!2期第13話放映終了後（2017年12月30日）には約91万のフォロワー数だったのが，本日（2019年1月19日）は952,380名であった。この1年での変化は約4万人増という結果である。今までの増加の伸びに比べたら明らかに傾きが小さくなっているが，それでもフォロー解除者よりは新規フォロー者の数が上回っていると解釈できる。

まとめ

• 2018年末から2019年初頭の紅白＆劇場版効果は見られるが，長期的には「ラブライブ」検索数は漸減傾向
• Aqours人気は順調に伸びてきていて，これからが本番
• ラブライブTwitter公式アカウントフォロワー数はこの1年であまり変化が見られなかった

おまけ

今後の確認用に，Googleトレンドグラフデータを常に更新する版もはっておこう

「ラブライブ」の過去5年間の人気度

「μ's」「Aqours」の過去5年間の人気度

「ラブライブ」のweb上における人気度とAqoursのこれから（2018/01/08現在）

2019/1/5　 Google トレンドでみた「μ's」「Aqours」の過去5年間の人気度のグラフを修正

ラブライブ！サンシャイン!!TVアニメ2期の放映が2017年12月30日に終了して以来，少し寂しさを感じつつも，未来のAqoursがどんな答えを持っているのか，いろいろ想像しながら日々を過ごしている。

沼津駅北口にあるAqoursの巨大タペストリー; 2017年12月23日，筆者撮影

もう何度聴いたか分からない「WATER BLUE NEW WORLD」（TVアニメ2期 第12話 挿入歌）は，ストーリーの佳境を迎えたアニメの記憶と共に切ない感情が聴くたびにこみあげてくるが，その歌詞は新しい世界への希望にあふれていて，これからのAqoursの活躍はどう展開していくのだろう，とわくわくしてくる。 　

この辺りで，とりあえず入手可能なデータをまとめてみて，Aqoursの今後について考えてみたい。

Google トレンドでみた「ラブライブ」の過去5年間の人気度推移

TVアニメ「ラブライブ!」（無印）の1期は，2013年1月から放映されたので，とりあえずGoogleトレンドで2018年1月8日から過去5年分の人気度の動向を表示してみた。

「ラブライブ」全体としては，2013年1月から徐々に人気度を上げ，「ラブライブ!」（無印）2期の放映中（2014年4月-6月）に盛り上がりをみせ，その後いったん落ち着きながらも，劇場版が公開された2015年6月13日に向けまた人気度が向上していき，2015年6月14日-20日の週をピークに段々一定の水準に落ち着いた動向を示すようになっている。

TVアニメ「ラブライブ！サンシャイン!!」1期（2016年7月-9月）の際には，無印2期の時と同程度の人気度を示したが，サンシャイン2期の際は大きな跳ねあがりはみせていない。ただし，最後の方で上がる兆しをみせているので，今後劇場版に向けてどうなっていくかは楽しみである。

ラブライブ！サンシャイン!!TVアニメ2期放映中の「ラブライブ」の人気度

今度は期間をせばめて，サンシャインの2期放映中にどう人気度が推移したかを確認する。

当然だが，各話放映日の土日に人気度が跳ね上がるという推移を示している。この期間中でのピークは2017年10月7日の第1話放映日で，それから少し落ち着くが第11話（12月16日）から第13話にかけて人気度がまた向上していく傾向がみられ，平日の人気度も放映前と比べて全体的に高まっている。

Google トレンドでみた「μ's」「Aqours」の過去5年間の人気度

次に，検索語をグループ名に変えて過去5年間の推移を見てみる。ただし，μ'sを検索キーワードとするとかなり低い結果になってしまったため，トピックとして扱っていることが留意点である。 ※2019/1/5 両方とも「女性アイドルグループ」としてに修正

2019/1/5　過去5年間　→　2013/1/8 - 2018/1/8の期間に修正

赤い線がμ'sで，青い線がAqoursの人気度の推移を示している。当然μ'sの方が初期から人気度を徐々に高めながら推移しており，Aqoursはグループ名が決定した2015年6月より人気度が0以上に動き始めている。

gs.dengeki.com

「ラブライブ」で動向を見たときのピークは，劇場版放映時であったが，μ'sの場合は，2015年末の紅白出場の時にピークが来て，その後，2016年3月末のμ's Final LoveLive!時に再度高まり，徐々に落ち着いた水準に保たれるという動向になっている。

一方，Aqoursは2016年4月より段々人気度を向上させはじめ，サンシャイン1期放映開始の7月3日-9日の週には瞬間的にμ'sを上回り，それ以降ほぼμ'sと同程度の人気度で推移していた。そして，Aqoursのこれまでの所のピークである2017年2月25日・26日のAqours First LoveLive!を期に，μ'sよりも高い水準の人気度を保ち，これまで以上に人気度を高めつつ現在に至っている。この勢いの高まりが，どうなっていくのか大変興味深い状況である。

上記の人気度の反応からは，googleトレンドは特にTV放映，ライブなどのイベントなど，多数のメディアに取り上げられるような時に高まることから，ある程度世間一般の関心を反映させたものと考えることができる。

ラブライブ！サンシャイン!!2期放映期間における，Twitter公式アカウントのフォロワー数の変化

最後に，以下の過去記事でも扱った，Twitterアカウントフォロワー数の推移について，統計解析環境Rでデータを取得し，ggplot2パッケージを用いてグラフを作成した。

RでAnime APIから季節のアニメ情報を読み込んで一覧できるデータフレームにする - いずにゃんの研究日記

けものフレンズのTwitterアカウントフォロワー変動履歴をAnime APIから読み込んでグラフにしてみる - いずにゃんの研究日記

対象Twitterアカウントは以下のものである。

twitter.com

データの出典として，アニメとITの融合「Anitech」を 促進している秋葉原IT戦略研究所さまのAnime APIを活用した。

qiita.com

データは上記の仕組みから各自入手してもらうことにして，ここでは，グラフのRコードとグラフを示す。

library(tidyverse) #ggplot2はこれで読み込める
library(lubridate)

# 放送日情報のデータフレーム作成
onair <-
 tibble(onaird = c("2017-10-07","2017-10-14","2017-10-21","2017-10-28",
                   "2017-11-04","2017-11-11","2017-11-18","2017-11-25",
                   "2017-12-02","2017-12-09","2017-12-16","2017-12-23","2017-12-30"),
        title  = c("第1話", "第2話", "第3話", "第4話", "第5話", "第6話", "第7話", 
                    "第8話", "第9話", "第10話", "第11話", "第12話", "第13話" ))

# ラブライブ！サンシャイン!!2期放映日の日付データに開始時刻を追加
onair <- 
  onair %>% 
  mutate(onaird = str_c(onaird," 22:30:00"),
         onaird = ymd_hms(onaird))

# グラフ描画
ggplot() +
  geom_line(data = dat, aes(x = date2, y = follower)) +
  scale_x_datetime(date_breaks="1 month", date_labels = "%b-%d") +     # X軸のラベルを1カ月区切りにして月-日表記に
  scale_y_continuous(labels = scales::comma) +                         # Y軸をコンマ区切りに
  geom_vline(data = onair, aes(xintercept = onaird), color = "blue") + # 放映日を示す縦線を追記
  geom_text(data = onair, aes(x = onaird, y=820000,label = title),     # 縦線に話数のラベルを付与
            size = 4, angle=90, vjust=-0.4, hjust=0)

できあがったグラフは以下のとおりである。横軸が月日で縦軸がフォロワー数である。青の縦線は，各話放映日の22:30に設定している。

グラフを見ると，累積フォロワー数は一定のペースで増え続けており，2期放映開始前は約83万であったが，第13話放映終了後には約91万に達している。

各話放送日に急激に数が増える傾向は特に観られないが，第9話放映日のみ（ルビィちゃんが活躍するAwaken the powerの回），著しい増加が見られている。

修善寺駅のルビィちゃんパネル，筆者撮影

今回はTVアニメ放映時以外の時期のデータを取得していなかったため，単純な比較はできないが，twitterでラブライブ情報を得ようとする関心を持つ，どちらかというと一般に比べてコアなファンと思われる層はコンスタントに増え続けていると考えられる。

こちらのデータの詳しい解析はまた近いうちにやってみたい。

まとめ

• 「ラブライブ」への世間一般からの関心は最盛期に比べて落ちつきをみせている
• Aqoursへの世間一般からの関心は2期放映中にも高まり続け，今後も上がっていくようにみえる
• 「ラブライブ」の情報をtwitterで得ようとするよりコアなファンはコンスタントに増え続けている

はじめてのggplot2(2):棒グラフを好みの色で描く

ggplot2の基本の構造等は前回の解説を参照。

izunyan.hatenablog.com

まずはいつものデータの読み込み。tidyverseをロードしておけば，ggplot2も読み込まれる。

library(tidyverse)
dat <-
  data_frame(
    name=c("高海千歌","桜内梨子","松浦果南","黒澤ダイヤ","渡辺曜","津島善子","国木田花丸","小原鞠莉","黒澤ルビィ"),
    grade=c(2,2,3,3,2,1,1,3,1), #学年
    height=c(157,160,162,162,157,156,152,163,154), #身長
    B=c(82,80,83,80,82,79,83,87,76), #バスト
    W=c(59,58,58,57,57,58,57,60,56), #ウエスト
    H=c(83,82,84,80,81,80,83,84,79)  #ヒップ
  )

Aqoursのメンバーごとの身長の棒グラフを描く

今回はx軸にメンバーの名前，y軸に身長がくるグラフにするので，geom_col()を使う。

ggplot(data = dat) +
  geom_col(mapping = aes(x = name, y = height))

メンバーの並び順を変える

デフォルトのままだと，並び順に規則性がない感じなので，とりあえず公式webサイトでの紹介順に並び変えたい。並び方を指定するには，

izunyan.hatenablog.com

で紹介した通り，因子型が簡単なので，変数nameを因子型に変換する。ここでは新たな変数namefを作成してみる。

dat$namef <- factor(dat$name)

そして，指定した順に並び変える。

library(forcats)
dat$namef <- fct_relevel(dat$namef, "高海千歌","桜内梨子","松浦果南","黒澤ダイヤ","渡辺曜","津島善子","国木田花丸","小原鞠莉","黒澤ルビィ")
levels(dat$namef)

[1] "高海千歌"   "桜内梨子"   "松浦果南"   "黒澤ダイヤ" "渡辺曜"     "津島善子"   "国木田花丸" "小原鞠莉"   "黒澤ルビィ"

棒グラフを色で塗りつぶす

aes()の中にfill =を加え，x軸に指定した変数名を入れると着色される。後の追加編集のため，ここではpというオブジェクトに格納している。

p <- ggplot(data = dat) +
  geom_col(mapping = aes(x = namef, y = height, fill=namef))
p

ただし，色がデフォルトのものであるため，ここは是非メンバーのイメージカラーで塗りつぶしてみたくなるのが自然な流れであろう。

各メンバーの棒グラフの色をそれぞれ指定する

Aqoursメンバーのイメージカラーについて，公式サイトのメンバー紹介ページ

www.lovelive-anime.jp

から，各シンボルマークで使われている色を使用する。この情報を取得する方法は色々あるが，今回はブラウザFirefox上で，スポイト機能を使って取得してみた。やり方は以下のリンク先を参照した。

daredemopc.blog51.fc2.com

結果，メンバーの紹介順に，左から

imagecol <- c("#FF791B","#FF7777","#00D29E","#F43232","#2AA4DB","#AEAEAE","#CFBA0F","#A530E0","#EE55B7")

という情報であることが分かった。ここでは後で使うため，imagecolというオブジェクトに格納した。

そして，グラフの色を手動で指定するために，scale_fill_manual()を使う。さきほど描いたグラフpに情報を追加するだけである。

p + scale_fill_manual(values = imagecol)

これで直感的にグラフを解釈しやすくなった！

はじめてのlubridate(1)日付データを扱う

追記：30万本目達成のデータ追加（2017/11/03）

日付データは，Rの基本的な関数だと初学者では扱うのがけっこう大変である。それを簡単にしてくれる，まじでラブリーなパッケージがlubridateだ。

単純なデータで練習するために，今や全国で大人気となったのっぽパンの，ラブライブ!サンシャイン!!とのコラボ商品「塩キャラメルのっぽ」味の累計売上本数を日付と共にグラフにし，それぞれどれだけの日数を要したか確認するまでを解説する。

沼津駅の改札を出てすぐの所にある売店でもこの通りの充実ぶり

データの情報源は以下の通り。

静岡のご当地パン「のっぽパン」と「ラブライブ!サンシャイン!!」のコラボが決定！ | 株式会社バンデロール

のっぽ×ラブライブ！サンシャイン!! コラボパンの累計販売数が10万本突破！ | 株式会社バンデロール

TVアニメ「ラブライブ！サンシャイン！！」と、静岡のご当地パン「のっぽパン」がコラボした、「塩キャラメルのっぽ」が、本日４月15日、販売20万本を達成しました！皆様ありがとうございます！！　#のっぽ　#ラブライブ

— 株式会社バンデロール (@banderolejp) 2017年4月15日

twitter.com

【沼津】『ラブライブ！サンシャイン!!』コラボのっぽ”塩キャラメル”の累計販売数が30万本を突破しました！ご愛顧ありがとうございます！明日より発売の"はちみつみかん”のっぽもよろしくお願いします！ #lovelive pic.twitter.com/RnbOoKbUrx

— ラブライブ！公式 (@LoveLive_staff) 2017年10月30日

twitter.com

データを読み込む

library(tidyverse)
library(lubridate)

データの読み込みは，今後の情報追加時の更新作業が分かりやすい配置になるように，tribble()で実施してみる。

dat <- tribble(
  ~date,           ~hon,
  "2016/09/13",        0,
  "2016/11/09",   100000,
  "2017/04/15",   200000,
  "2017/10/30",   300000
)
dat

日付は文字型にしておく必要があるため，" "で囲っている。データフレームを表示すると以下のような感じになる

# A tibble: 4 x 2
        date   hon
       <chr> <dbl>
1 2016/09/13 0e+00
2 2016/11/09 1e+05
3 2017/04/15 2e+05
4 2017/10/30 3e+05

日付変数に変換する

ここでlubridateの出番である。日付の情報が，year-month-dayの順番で並んでいるので，それぞれの頭文字をとった関数ymd()を使うだけでお手軽に変換できる。

dat <- dat %>%
  mutate(date2 = ymd(date)
           )

# A tibble: 4 x 3
        date   hon      date2
       <chr> <dbl>     <date>
1 2016/09/13 0e+00 2016-09-13
2 2016/11/09 1e+05 2016-11-09
3 2017/04/15 2e+05 2017-04-15
4 2017/10/30 3e+05 2017-10-30

このように，変数の型も<date>になった。

なお，ここの作業に関連する関数は他にもydm(),mdy(),myd(),dmy(),dym()があり，年月日がどんな順番でも対応可能なことが分かる。たとえば，

dmy("13/09/2016")

[1] "2016-09-13"

他にも，year-month-day hour-minute-secondに対応した，ymd_hms()などもあるが，今回は扱わない。

年月日の区切りは様々なタイプに対応しており，区切りなしや区切りが空白といった場合でも同様に読み込める。たとえば，

dmy("09 Nov 2016")

[1] "2016-11-09"

詳しくは，ymd()などのhelpのexample参照。

横軸が日付で縦軸が売上本数の線グラフを描いて，それぞれの達成日を点で示す

p <- dat %>% 
  ggplot(aes(x = date2, y = hon)) +
  geom_line()+
  geom_point()
p

横軸の日付表示がざっくりすぎるのと，時点数の表示が少ないので，横軸を1カ月ごとの表示にしてみる

p + scale_x_date(date_breaks="1 month")

日付の文字が長く重なってしまうので，角度を45度にしてみる

p +
  scale_x_date(date_breaks="1 month") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

縦軸の本数の表示が分かりにくいので，コンマをつけてすべて表示させる

p +
  scale_x_date(date_breaks="1 month") +
  scale_y_continuous(labels = scales::comma) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

さて，グラフを見ると最初の10万本達成までの伸びが急激で，その後20万本までは少し緩やかになり，30万本目までもほぼ同じ勢いで伸びている。次は，時点間の日数が何日だったかについて確認してみる

時点間の日数を計算して変数にする

これは，date2の値について，前の行の値との差を計算すればよい。dplyrのlag()関数が便利である。引数のdefault = date2[1]というのは，前の行がない1行目の結果をどうするかの指定で，デフォルトではNAを返すが，ここでは同じ1行目を指定しているので，0が返ってくる。

dat <- dat %>%
  mutate(date_dif = date2 - lag(date2, default = date2[1]))
dat

# A tibble: 4 x 4
        date   hon      date2 date.dif
       <chr> <dbl>     <date>   <time>
1 2016/09/13 0e+00 2016-09-13   0 days
2 2016/11/09 1e+05 2016-11-09  57 days
3 2017/04/15 2e+05 2017-04-15 157 days
4 2017/10/30 3e+05 2017-10-30 198 days

最初の2か月だけでみると

> 100000/57
[1] 1754.386

なので，1日あたり1754本売れていたことになる。

はじめてのtidyr（2）：2つの変数の値を1つの変数にまとめる。または逆に分割する

以下のように，名字と名前が別々の変数となっている場合に， フルネームにして1つの変数としてまとめたいという時に役に立つ方法を 解説する。まずはデータの読み込み。

library(tidyverse)
dat <-
  data_frame(
    family=c("高海","桜内","松浦","黒澤","渡辺","津島","国木田","小原","黒澤"),
    first=c("千歌","梨子","果南","ダイヤ","曜","善子","花丸","鞠莉","ルビィ")
    )
dat

# A tibble: 9 × 2
  family  first
   <chr>  <chr>
1   高海   千歌
2   桜内   梨子
3   松浦   果南
4   黒澤 ダイヤ
5   渡辺     曜
6   津島   善子
7 国木田   花丸
8   小原   鞠莉
9   黒澤 ルビィ

unite()関数で2つの変数の値を1つの変数にまとめる

早速，familyとfirstをまとめてname変数を作成する。使うのはtidyrパッケージの unite()関数。なのでヘルプをみたい場合はそちらを参照。

dat %>% unite(name,family,first, sep="")

# A tibble: 9 × 1
        name
*      <chr>
1   高海千歌
2   桜内梨子
3   松浦果南
4 黒澤ダイヤ
5     渡辺曜
6   津島善子
7 国木田花丸
8   小原鞠莉
9 黒澤ルビィ

sep=""で，接続の部分に何も指定してないので，区切りなしのフルネーム となった。接続に使う記号は色々指定できる。sep=自体入れない場合は以下のように _でつながれる。こちらは後で使うので，dat2に格納しておく。

dat2 <- dat %>% unite(name,family,first)
dat2

# A tibble: 9 × 1
         name
*       <chr>
1   高海_千歌
2   桜内_梨子
3   松浦_果南
4 黒澤_ダイヤ
5     渡辺_曜
6   津島_善子
7 国木田_花丸
8   小原_鞠莉
9 黒澤_ルビィ

元の変数を残したい時は，引数にremove=FALSEを入れる。

dat %>% unite(name,family,first, remove=FALSE) 

         name family  first
*       <chr>  <chr>  <chr>
1   高海_千歌   高海   千歌
2   桜内_梨子   桜内   梨子
3   松浦_果南   松浦   果南
4 黒澤_ダイヤ   黒澤 ダイヤ
5     渡辺_曜   渡辺     曜
6   津島_善子   津島   善子
7 国木田_花丸 国木田   花丸
8   小原_鞠莉   小原   鞠莉
9 黒澤_ルビィ   黒澤 ルビィ

separate()関数で区切りが明記されている1つの変数の値を2つの変数に分割する

こちらはseparate()関数を使う。先ほど作ったdat2データに適用してみる。

dat2 %>% separate(name, c("family","first"))

# A tibble: 9 × 2
  family  first
*  <chr>  <chr>
1   高海   千歌
2   桜内   梨子
3   松浦   果南
4   黒澤 ダイヤ
5   渡辺     曜
6   津島   善子
7 国木田   花丸
8   小原   鞠莉
9   黒澤 ルビィ

けものフレンズのTwitterアカウントフォロワー変動履歴をAnime APIから読み込んでグラフにしてみる

2月6日頃から，ネット上で「けものフレンズ」への関心が急激に高まっていたようである。下図はGoogleトレンドのグラフであるが，2月9日を100とした場合に，2月5日に9だった指標が，6日に35，2月8日に90，といった具合に変化していた。

公式Twitterアカウントのフォロワー数もこれに連動していると考えられる。本記事では，Rでデータを取得し，ggplot2パッケージを使って「けものフレンズ」Twitterアカウントフォロワー数の推移をグラフに表してみたいと思う。

すごーい！

以前の記事

izunyan.hatenablog.com

で紹介したAnime APIでは，アニメ作品のTwitterアカウントのフォロワー数の履歴といった貴重なデータを取得することができる。すごーい！

qiita.com

わーい！

まずは使用するパッケージを読み込む

library(tidyverse)　#あとで使うdplyrもggplot2もこれをロードしておけばOK
library(RCurl)
library(rjson)

Anime APIからデータを読み込む

これは次のコードだけである。

kemono <- getURL('http://api.moemoe.tokyo/anime/v1/twitter/follower/history?account=kemo_anime') #&end_date=1486740607

URLの?account=以下のkemo_animeがけものフレンズのtwtterアカウントである。ここを他作品のものに変えれば，その作品のデータが取得できる。デフォルトだと，現在時刻から前の100件のデータが読み込まれる。コメントアウトされている#&end_date=というのは，後で解説する。

リスト形式に変換する

読みこまれたデータはjson形式であるため，Rで表示しやすくするために，リスト形式にする

kemono.list<-fromJSON(kemono)

データフレーム形式に変換する

なじみあるデータ構造にするために，情報を抜き出してまとめる

Date <- as.character(lapply(kemono.list, '[[','updated_at'))
Follower <- as.character(lapply(kemono.list, '[[','follower'))
dat_kemono <- data_frame(date=Date,follower=Follower)
dat_kemono

作成されたdat_kemonoは以下のような内容になる。

# A tibble: 100 × 2
         date follower
        <chr>    <chr>
1  1486740606    18411
2  1486738806    18370
3  1486737005    18313
4  1486735205    18250
5  1486733405    18202
6  1486731605    18142
7  1486729805    18077
8  1486728006    18019
9  1486726206    17953
10 1486724406    17911
# ... with 90 more rows

dateの列は，日付のUNIXタイムスタンプ（1970年1月1日午前0時0分0秒からの経過秒数）で，followerの列がフォロワー数を表している。

過去100件より前の履歴を取得する

kemono2 <- getURL('http://api.moemoe.tokyo/anime/v1/twitter/follower/history?account=kemo_anime&end_date=1486560610')
kemono.list2 <- fromJSON(kemono2)

履歴を取得するには，どの時点より前なのかの情報を&end_date=の部分に加える必要がある。履歴の更新は大体30分間隔で行われているようなので，60秒*30分*100行で，大体180,000の数字の違いを指定してやればよい 今回は，1行目のデータが1486740606だったので，これから180000を引いて，数秒増やした数字1486560610を指定した。

1486740606-180000
[1] 1486560606

後は，同様にデータフレーム形式にする。リスト形式でまとめた方が手順が少なくて済みそうだが，自分がまだ慣れてないのでこのやり方を紹介する。もしかしたら無駄が多い作業になっているかもしれない。

Date <- as.character(lapply(kemono.list2, '[[','updated_at'))
Follower <- as.character(lapply(kemono.list2, '[[','follower'))
dat_kemono2 <- data_frame(date=Date,follower=Follower)
dat_kemono2

後は同様の作業を繰り返して，集めたい期間の情報を取得してくるだけである。今回は， あと3回繰り返してdat_kemono5まで取得してみた。

データフレームを1つにつなげる

取得したデータはそれぞれ違う時間帯で，縦に長く連結するだけなので，dplyrパッケージのbind_rows()関数を使う。

dat_kemono_all <- bind_rows(dat_kemono, dat_kemono2, dat_kemono3, dat_kemono4, dat_kemono5)

これでデータセットが完成した。わーい！

たーのしーい！

さあ，いよいよグラフを描いていく。が，まずは準備。

date変数がUNIXタイムスタンプのままなので日付形式に変換しておく

これには大変便利なanytimeパッケージを使う。date変数が文字型なので，as.numeric()で数値にしてanytime()関数の中に放り込む。あとはタイムゾーンtz=を東京に指定する。

library(anytime)
dat_kemono_all$date2 <- anytime(as.numeric(dat_kemono_all$date), tz = "Asia/Tokyo")

# A tibble: 500 × 3
         date follower               date2
        <chr>    <dbl>              <dttm>
1  1486740606    18411 2017-02-11 00:30:06
2  1486738806    18370 2017-02-11 00:00:06
3  1486737005    18313 2017-02-10 23:30:05
4  1486735205    18250 2017-02-10 23:00:05
5  1486733405    18202 2017-02-10 22:30:05
6  1486731605    18142 2017-02-10 22:00:05
7  1486729805    18077 2017-02-10 21:30:05
8  1486728006    18019 2017-02-10 21:00:06
9  1486726206    17953 2017-02-10 20:30:06
10 1486724406    17911 2017-02-10 20:00:06
# ... with 490 more rows

このように，新しい変数date2を作成し，日付と時刻が示されるようになった。

折れ線グラフを描く

ついに今回やりたかった所にたどりついた。みゃみゃみゃみゃみゃみゃみゃみゃー

ggplot(data = dat_kemono_all) +
  geom_line(mapping = aes(x = date2, y = follower))

こんな風に簡単に図が作成できた。これをみると，2月6日前でも徐々にフォロワー数が増加していたのだが，7日にかけて傾きが急に大きくなった様子が読み取れる。ちゃんと下地は形成されつつあったのだろう。この後の勢いが大きく，3日間でフォロワー数が倍増し，その後も増え続けている。たーのしーい！