論文タイトルのテキスト解析 (RMeCab)

library(tidyverse) # ggplotとかdplyrとか
library(rvest) # webスクレイピング用
library(XML) # rvestで必要なので
library(magrittr)
library(stringr) # 文字列操作用
library(data.table)
library(RMeCab)
library(wordcloud2)
library(knitr)
library(broom)
library(foreach)
library(pforeach)

# 雑誌リスト
NP <- "1469-8137" #New Phytologist
PCE <- "1365-3040"  # Plant, Cell & Environment
PJ <- "1365-313X" # The Plant Journal
PP <- "1399-3054" # Physiologia Plantarum
PB <- "1438-8677" # Plant Biology

# 作業用フォルダを作って移動
setwd("/Users/keach/Dropbox/KeachMurakami.github.io/_source/")
dir.create("2016-12-26")
setwd("2016-12-26")

# 並列計算で5誌の100号をスクレイプ
title_list <-
  pforeach(i = c(NP, PCE, PJ, PP, PB), .combine = bind_rows)({
    extract_ISSN(ISSN = NP, number_parse = 100)
  })

title_df <-
  title_list %>%
  tidyr::extract(col = title, into = c("title", "start", "end"), regex = "(.+)\\(pages(.+[0-9]+)–([0-9]+)") %>% # remove pages
  tidyr::extract(col = issue_volume, into = c("vol", "issue"), regex = "([0-9]+).+([0-9]+)") %>% # separate volume and issue
  tidyr::extract(col = date, into = c("month", "year"), regex = "([a-zA-Z]+).([0-9]+)") # separate month and year

# csvで保存
title_df %>%
  write_csv(path = "./titles_scrape.csv")  
}

# 非並列計算
system.time(
  lapply(
    c(NP, PCE, PJ, PP, PB), function(i){
      extract_ISSN(ISSN = i, number_parse = 5)
      })
  )

 #   user  system elapsed 
 # 10.365  38.943  53.938 


# 4コア並列計算
system.time(
  pforeach::pforeach(i = c(NP, PCE, PJ, PP, PB), .combine = bind_rows)({
    extract_ISSN(ISSN = i, number_parse = 5)
    })
  )

  #  user  system elapsed 
  # 5.508  15.315  24.520 

titles <-
  fread("./titles_scrape.csv") %>%
  as_data_frame %>%
  filter(!(journal %in% c("Acta Botanica Neerlandica", "Botanica Acta"))) %>% # 雑誌名の変更前のものを除く
  mutate(title = tolower(title)) # 全て小文字に

# 品詞で解析したかったけど...
RemoveList <-
  c("of", "in", "on", "to", "for", "by", "with", "from",
    "at", "among", "but", "or", "into", "under", "via", "during",
    "and", "is", "are", "as", "between", "that", "its", "their", 
    "the", "a", "an")

titles_grouped <-
  titles %>%
  group_by(journal, year) %>%
  do(
    .$title %>%
    paste(collapse = " ") %>%
    data_frame(title = .)
  )

titles_freqs <-
  foreach(i = 1:dim(titles_grouped)[1], .combine = bind_rows) %do%
  {
    df_slice <-
      titles_grouped[i, ]

    # MeCabがファイルからしか解析できないので、一時ファイルを吐く
    df_slice %$%
      title %>%
      write.table(file = "temp.txt", row.names = F, col.names = F)
    
    # MeCabる
    journal <- df_slice$journal
    year <- df_slice$year
    
    # 整える
    result_mecab <-
      "temp.txt" %>%
      RMeCabFreq %>%
      filter(Info1 != "記号", Info2 == "一般", !(Term %in% RemoveList)) %>%
      mutate(journal = journal, year = year) %>%
      select(term = Term, freq = Freq, journal, year) %>%
      return
  }

# 解析結果をcsvで保存
titles_freqs %>%
  write_csv(path = "titles_analyzed.csv")

freqs_all <-
  titles_freqs %>%
  group_by(term) %>%
  summarise(freq = sum(freq))

# 出現総数TOP30
freqs_all %>%
  arrange(desc(freq)) %>%
  head(30) %>%
  ggplot(aes(x = reorder(term, freq), y = freq)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  labs(x = "word")

# ワードクラウド
freqs_all %>%
  arrange(desc(freq)) %>%
  wordcloud2(size = .3, color = "lightgreen")

major_terms <-
  freqs_all %>%
  arrange(desc(freq)) %>%
  head(30) %$%
  term

# 年ごとの出現word総数
terms_per_year <-
  titles_freqs %>%
  filter(term %in% major_terms) %>%
  group_by(year) %>%
  summarise(total = sum(freq))

time_dat <-
  titles_freqs %>%
  filter(term %in% major_terms) %>%
  group_by(year, term) %>%
  summarise(freq = sum(freq)) %>%
  left_join(., terms_per_year, by = "year") %>%
  filter(year != "2017") %>%  # 2017年はデータがまだ少ないので除外
  mutate(freq_percent = freq / total) %>%
  gather(category, freq, -year, -term) %>%
  filter(category != "total")

# 経年推移
time_dat %>%
  ggplot(aes(x = year, y = freq, col = term)) +
  geom_line() +
  geom_point() +
  facet_grid(category ~ ., scale = "free")

# 線形回帰でごり押し
time_dat %>%
  filter(year > 2010, category == "freq_percent") %>%
  rename(Term = term) %>%
  group_by(Term) %>%
  do(lm(data = ., formula = freq ~ year) %>% tidy) %>%
  filter(term == "year") %>%
  select(term = Term, increase = estimate, p = p.value) %>%
  mutate(signif = if_else(p < 0.05, "*", "")) %>%
  arrange(desc(increase)) %>%
  kable

# いくつの単語の最近のトレンドに注目
time_dat %>%
  filter(term %in% c("genes", "expression", "tolerance", "water", "stress", "light", "temperature"),
         year > 2010) %>%
  ggplot(aes(x = year, y = freq, col = term)) +
  geom_line() +
  geom_point() +
  facet_grid(category ~ ., scale = "free")

titles_freqs %>%
  group_by(journal, term) %>%
  summarise(freq = sum(freq)) %>%
  do(arrange(., desc(freq)) %>%
       head(30) %>%
       mutate(rank = 1:30)) %>%
  ungroup %>%
  transmute(journal, term = paste0(term, " (", freq, ")"), rank) %>%
  spread(journal, term) %>%
  kable