週間少年ジャンプの掲載順位データを作る(Rで)

はじめに

ジャンプの掲載順位データを可視化するという素敵な記事がありました。

ジャンプの掲載順位データという大変素敵なHPから、pythonのbeautifulsoupでスクレイプしてデータを可視化する、といった内容でした。

同じことを、Rでやってみます。

作成されたデータはGistにあります。

データの取得

スクレイプはrvestで、文字列処理はstringiでゴリゴリやりましょう。

まずはパッケージの準備。

library(dplyr)
library(stringi)
library(rvest)
library(data.table)

## 結果を入れるデータテーブル
jump_data = data.table(NULL)

## データがあるのは、1999年から2015年まででした。
for(year in 1999:2015) {
  ## リンクがまとまっているページのurl
  link_page =
    paste("http://hamada.tsukaeru.info/jump/", year, "/jump", year, ".html", sep="")
  link_page_html = html(link_page)
  
  ## アドレスを整形
  page_htmls = 
    link_page_html %>% 
    html_nodes(xpath="/html/body/ul/li/a") %>%
    html_attr("href") %>%
    stri_replace_all_regex("^./", paste("http://hamada.tsukaeru.info/jump/", year, "/", sep=""))
  
  ## ページの取得を行う
  for (page_html in page_htmls){
    ## 取得するページ
    print(page_html)
    jump_html = html(page_html) 
    
    ## 順位表を取得
    jump_table = 
      jump_html %>% 
      html_node(xpath="/html/body/table") %>% 
      html_table
    
    ## 年、号を取得
    jump_title_year_num = 
      jump_html %>% 
      html_node(xpath="/html/body/h2[1]")%>%
      html_text() %>% 
      stri_extract_all_regex(pattern = "\\d+") %>%
      unlist
    
    ## データの整形
    ## 掲載場所が書いてある列を知るために、表のサイズを取得
    jump_table_colnum = dim(jump_table)[2]
    jump_name_place = 
      jump_table %>%
      select(3, jump_table_colnum-1)
    ## 列名を英語で
    jump_name_place %>% setnames(c("name", "place"))
    ## 年、号、作品名、掲載順位というデータテーブルにします。
    jump_name_place_data = 
      jump_name_place %>%
      mutate(year = jump_title_year_num[1], 
             volume  = jump_title_year_num[2]) %>%
      select(year, volume, name, place)
    ## 結合
    jump_data = rbind(jump_data, jump_name_place_data)
    ## 今の年、号
    print(jump_title_year_num)
  }
}
## write.csv(jump_data, "jump_data.csv")

最後にちょっとだけゴミ掃除と調整。

ジャンプには合併号があるので、注意が必要です。

年間の通し番号を、新しく作っておきます。号数の歯抜けがなくすためです。

## 出来たデータ使います 
jump_data = fread("jump_data.csv")
jump_data = 
  jump_data %>% 
  mutate(year = as.integer(year), volume = as.integer(volume)) %>%
  filter(!stri_detect_regex(name, pattern ="新連載作品")) 

## 合併号のところで、volumeが歯抜けになっていますので、
## volumeを、年ごとの通し番号にします。
jump_volume_data = 
  jump_data %>% 
  select(year, volume) %>%
  distinct(year, volume) %>% 
  group_by(year, add=FALSE) %>% 
  arrange(volume) %>% 
  mutate(volume_modified = row_number(.)) %>%
  ungroup()

## volumeを修正したものを反映させます
jump_data_modified = 
  jump_data %>%   merge(jump_volume_data, by = c("year", "volume")) %>% 
  select(year, volume_modified, name, place)

## 保存しておきます
jump_data_modified %>%
  write.csv("jump_data_modified.csv", 
            quote=FALSE, row.names=FALSE)

これで準備が整いました。

内容を確認してみます.

食戟のソーマの掲載順位を見てみます.

## 食戟のソーマの掲載順位推移
jump_data_modified %>%
  filter(name == "食戟のソーマ")

## Source: local data table [115 x 4]
## 
##    year volume_modified         name place
## 1  2012              48 食戟のソーマ     1
## 2  2013               1 食戟のソーマ    13
## 3  2013               2 食戟のソーマ    12
## 4  2013               3 食戟のソーマ     8
## 5  2013               4 食戟のソーマ    13
## 6  2013               5 食戟のソーマ    14
## 7  2013               6 食戟のソーマ     6
## 8  2013               7 食戟のソーマ     4
## 9  2013               8 食戟のソーマ     9
## 10 2013               9 食戟のソーマ    11
## ..  ...             ...          ...   ...

最初の方は調子が悪かったみたいですね.

掲載順位の可視化

掲載順位の可視化をやってみます.

食戟のソーマの、掲載順位の推移を見てみましょう。

library(ggplot2)
jump_data_modified %>% 
  filter(name == "食戟のソーマ") %>% 
  as.data.frame() %>%
  mutate(num = row_number()) %>%
  ggplot() +  
  geom_line(aes(x=num, y = as.integer(place))) + 
  scale_y_reverse() + 
  theme_bw(base_family = "HiraKakuProN-W3") + 
  ggtitle("食戟のソーマ 掲載順位の推移") + 
  ylab("掲載順位") + xlab("話数")

ちゃんとできているみたいですね。

順位が落ちた回

急に順位が落ち込んだ箇所が気になります.

第何回で順位が落ちているか、調べてみましょう。

jump_data_modified %>% 
  filter(name == "食戟のソーマ") %>% 
  as.data.frame() %>%
  mutate(num = row_number()) %>%
  mutate(place = as.integer(place)) %>% 
  arrange(desc(place)) %>% 
  head(10)

##    year volume_modified         name place num
## 1  2013               5 食戟のソーマ    14   6
## 2  2013               1 食戟のソーマ    13   2
## 3  2013               4 食戟のソーマ    13   5
## 4  2013               2 食戟のソーマ    12   3
## 5  2013              43 食戟のソーマ    12  44
## 6  2014              16 食戟のソーマ    12  65
## 7  2015               5 食戟のソーマ    12 102
## 8  2013               9 食戟のソーマ    11  10
## 9  2013              11 食戟のソーマ    11  12
## 10 2013              13 食戟のソーマ    11  14

最近だと、第102回で順位が落ちています。

手元の単行本で確認してみると、101回は秋の選抜決勝、創真が「ぬかさんまの炊き込みご飯」をサーブする回でした。

どうせ最後に汁をぶっかけるんだろ早くしろよ、って感じでしたね。

HUNTERxHUNTERの掲載順位

最後に、最近の100号分のジャンプで、HUNTERxHUNTERの掲載順位の推移を見てみましょう.

jump_data_modified %>% 
  filter(name == "HUNTER×HUNTER") %>% 
  mutate(place_mod = as.integer(place)) %>% 
  tail(100) %>% 
  mutate(num = row_number()) %>% 
  as.data.frame() %>%
  ggplot() +  
  geom_line(aes(x=num, y = as.integer(place_mod))) + 
  scale_y_reverse() + 
  theme_bw(base_family = "HiraKakuProN-W3") + 
  xlab("最近100号のジャンプ") + 
  ylab("掲載順位") + 
ggtitle("HUNTERxHUNTERの掲載順位") + 
ylim(1,20) + 
scale_y_reverse() 

仕事しろ

まとめ

ジャンプの掲載順位データを整形してみました。

生存時間解析とかやってみたいですね。

以上です。

この投稿はGithub Qiitaから投稿されました。