Follow @data_no_memo

伊達のメモ

個人的なメモです。他者にわかりやすく書くよりも未来の自分にわかりやすく書いています。なお、記事内容の正確さは保証できません。勉強中の身ですので、間違い等ご指摘頂けたら幸いです。

Rで鬼仏表を例にwebスクレイピングしてみた

はじめに

  前々からwebスクレイピングをやりたいなと思っていたが、なかなか手を出せずにいた。が、ついに手を出してみた。rvest()のおかげでとても簡単にできる。

ウェブスクレイピング(英: Web scraping)とは、ウェブサイトから情報を抽出するコンピュータソフトウェア技術のこと。ウェブ・クローラー[1]あるいはウェブ・スパイダー[2]とも呼ばれる。 通常このようなソフトウェアプログラムは低レベルのHTTPを実装することで、もしくはウェブブラウザを埋め込むことによって、WWWのコンテンツを取得する。(wikiより)

  ようするに、webページから自動的に何らかの情報を抽出しましょうというもの。有益なデータはwebのあちこちにあるが、逐一webページの○○を自分でエクセルなどに打ち込むのは面倒すぎる。数10個のデータ量ならばそれで良いが、数100個、数1,00個…となると大変すぎる。なので、コンピューターにやらせましょうというものだと思われる。
 今回は鬼仏表(きぶつひょう)というサイトを例に試してみる。鬼仏表は、大学の授業の単位の取りやすさが表示されているサイトである。誰でもそのサイトにアクセスし、授業の単位の取りやすさについて評価を書き込むことができる。その評価は単位の取りやすさに合わせて「ど鬼」「鬼」「やや鬼」「並」「やや仏」「仏」「ど仏」というランクが用意されている。「ど鬼」と評価づけられた場合が最も単位が取りにくいという意味であり、「ど仏」と評価づけられた場合が最も単位が取りやすいという意味である。大学ごとにページが用意されているのだが、今回は鬼仏表がよく使用されている東北大学のページを例にwebスクレイピングを行なってみる。

www.kibutu.com

 目標は「ど鬼」「鬼」「やや鬼」「並」「やや仏」「仏」「ど仏」の度数分布を出すことである。ページを見ればわかるがその評価数は何千もあるため、手動で数え上げるのは大変。そこで、webスクレイピングをして度数を出す。

webスクレイピング実装

  まずは必要なパッケージの読み込み。

library(tidyverse) 
library(rvest)

 次に当該サイトを読み込む。

data <- read_html("https://www.kibutu.com/kibutu.php?university=tohoku") 

  教員名から評価が書かれたサイトにとぶためのurlを取得する。以下のように書くことで、全ての教員名のurlを獲得することができる。なお得られたリストの1〜14番目は関係のないurlが入っていたため15番目からのリストをゲットする。

tar <- data %>% 
  html_nodes("a") %>% 
  html_attr("href")
tar_url <- tar[15:length(tar)]

 次に、何千個ある教員の名前に貼られたurlから評価が書かれたページに逐一アクセスして評価を取り出す作業を行う。なお、一気に繰り返しで行えば良いのだが時間がかかり過ぎてRがstopしてしまったので4回に分けて繰り返しを行う。
 まず、評価を収納するリストを4つ作成し、繰り返し数をnで定義する。

rec1 <- list()
rec2 <- list()
rec3 <- list()
rec4 <- list()
n <-length(tar_url)/4

  次に、urlの最初の部分は上記の作業で取り出せていなかったのでサイトからコピペして定義しておく。

home_url <- "https://www.kibutu.com/"

 繰り返しのコードは以下の通り。色々試しながらやった。具体的な内容は、次の通りである。まず、tar_urlに収納しておいた評価が掲載されているページのリンクをsub_urlに収納する。次に、完全なurlを作るためにpaste0()home_urlsub_urlをくっつけてsub_dataと定義する。それから、評価が掲載されているページ(sub_dataのリンク先)のtableをゲットする。そこから評価が掲載されているところだけを取り出す。なお、その評価(鬼や仏のこと)は「評価」という文字と「テスト」という文字に挟まれているため、それらを99と定義しておき、99で挟まれている文字(鬼や仏そのものの文字)を取り出す。この作業を繰り返している。

for(i in 1:n){
  sub_url <- tar_url[i]
  sub_data <- read_html(paste0(home_url, sub_url))
  
  sub_table <- sub_data %>% 
    html_nodes("table") %>% 
    html_text()
  
  sub_text <- sub_table[7]
  
  sub_text <- sub("評価", 99, sub_text)
  sub_text <- sub("テスト", 99, sub_text)
  rep <- str_split(sub_text, "99")
  rec1[i] <- rep[[1]][2]
}

for(i in 1:n){
  sub_url <- tar_url[i]
  sub_data <- read_html(paste0(home_url, sub_url))
  
  sub_table <- sub_data %>% 
    html_nodes("table") %>% 
    html_text()
  
  sub_text <- sub_table[7]
  
  sub_text <- sub("評価", 99, sub_text)
  sub_text <- sub("テスト", 99, sub_text)
  rep <- str_split(sub_text, "99")
  rec2[i] <- rep[[1]][2]
}

for(i in 1:n){
  sub_url <- tar_url[i]
  sub_data <- read_html(paste0(home_url, sub_url))
  
  sub_table <- sub_data %>% 
    html_nodes("table") %>% 
    html_text()
  
  sub_text <- sub_table[7]
  
  sub_text <- sub("評価", 99, sub_text)
  sub_text <- sub("テスト", 99, sub_text)
  rep <- str_split(sub_text, "99")
  rec3[i] <- rep[[1]][2]
}

for(i in 1:n){
  sub_url <- tar_url[i]
  sub_data <- read_html(paste0(home_url, sub_url))
  
  sub_table <- sub_data %>% 
    html_nodes("table") %>% 
    html_text()
  
  sub_text <- sub_table[7]
  
  sub_text <- sub("評価", 99, sub_text)
  sub_text <- sub("テスト", 99, sub_text)
  rep <- str_split(sub_text, "99")
  rec4[i] <- rep[[1]][2]
}

rec <- c(rec1, rec2, rec3, rec4)

 ここまできたら、あとは図示するだけ。ただし、たまに変なのがまじっていたりしたので1、工夫しつつ図示化した。そのコードは以下の通り。

oni <- numeric(length(rec))
yaya_oni <- numeric(length(rec))
nami <- numeric(length(rec))
yaya_hotoke <- numeric(length(rec))
hotoke <- numeric(length(rec))
do_hotoke <- numeric(length(rec))

for(i in 1:length(rec)){
  do_oni[i] <- ifelse(str_detect(rec[[i]], pattern = "ど鬼") == TRUE, 1, 0)
  oni[i] <- ifelse(str_detect(rec[[i]], pattern = "鬼") == TRUE, 1, 0)
  yaya_oni[i] <- ifelse(str_detect(rec[[i]], pattern = "やや鬼") == TRUE, 1, 0)
  nami[i] <- ifelse(str_detect(rec[[i]], pattern = "並") == TRUE, 1, 0)
  yaya_hotoke[i] <- ifelse(str_detect(rec[[i]], pattern = "やや仏") == TRUE, 1, 0)
  hotoke[i] <- ifelse(str_detect(rec[[i]], pattern = "仏") == TRUE, 1, 0)
  do_hotoke[i] <- ifelse(str_detect(rec[[i]], pattern = "ど仏") == TRUE, 1, 0)
}

his_data <- data.frame(
  values = c(sum(do_oni), sum(oni), sum(yaya_oni), 
           sum(nami), sum(yaya_hotoke), sum(hotoke),
           sum(do_hotoke)),
  num = c("ど鬼", "鬼", "やや鬼", "並", "やや仏", "仏", "ど仏")
)

values <- c(sum(do_oni), sum(oni), sum(yaya_oni), 
           sum(nami), sum(yaya_hotoke), sum(hotoke),
           sum(do_hotoke))
names(values) <- c("ど鬼", "鬼", "やや鬼", "並", "やや仏", "仏", "ど仏")

par(family="HiraKakuProN-W3") 
barplot(values, xlab = "", ylab = "度数",
        col=c("#FF5500", "#FF6D14", "#FFD26F", "#E0FFEE", "#9FF0FF", "#44A5FF", "#236BFF"),
        ylim = c(0, 3500)) 

結果

 結果は以下のようになった。

f:id:abcxyzonetwothree:20190525223429p:plain

  仏が多い!!解釈は色々あるだろうが、素直に解釈するなら、東北大学さんの教員はもう少し厳しくしても良いのではないだろうか。もちろん、鬼仏表に書き込む奴は仏の授業を受けやすいというセレクションバイアスも考えられるが…

感想

 冒頭にも述べたが、rvest()のおかげでとても簡単にできた。なお、当該サイトのhtmlはgoogle choromeのデベロッパツールで確認できる。ごちゃごちゃしてややこしいが要領さえつかめば難しくない。研究にも応用できたら良い。


  1. たまに評価が書いていたなかったりしていた。