RによるAmazonレビューの収集とテキスト分析

> devtools::session_info()
─ Session info ─────────────────────────────────────────────────────────────────────────────────────────────────
setting  value                       
version  R version 4.0.5 (2021-03-31)
os       Ubuntu 20.04.2 LTS          
system   x86_64, linux-gnu           
ui       RStudio                     
language (EN)                        
collate  ja_JP.UTF-8                 
ctype    ja_JP.UTF-8                 
tz       Etc/UTC                     
date     2021-05-18                  

rm(list=ls())
gc();  gc();

if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, 
              RSelenium, 
              rvest,
              stringi,
              XML,
              openxlsx)

ip = "***.**.***.*"

remDr = remoteDriver(
 remoteServerAddr = ip,  # ipconfigでIPv4アドレスを確認しておく
 port = 4444, 
 browserName = "chrome"
)
remDr$open()

scrape_amazon <- function(ASIN, page_num){
 url <- paste0("https://www.amazon.co.jp/product-reviews/",ASIN,"/?pageNumber=",page_num)
 remDr$navigate(url)
 Sys.sleep(5)
 doc <- remDr$getPageSource() %>%
   unlist() %>%
   read_html()
 
 # Review Title
 # There are two types of titles: with links and without links, so both are combined in the list.
 doc %>% 
   html_nodes("[class='a-size-base a-link-normal review-title a-color-base review-title-content a-text-bold']") %>%
   html_text() %>% 
   stri_replace_all(regex = "\n| +|　+", replacement = " ") %>% 
   stri_replace_all(regex = "^ +", replacement = "") -> review_title1
 doc %>% 
   html_nodes("[class='a-size-base review-title a-color-base review-title-content a-text-bold']") %>%
   html_text() %>% 
   stri_replace_all(regex = "\n| +|　+", replacement = " ") %>% 
   stri_replace_all(regex = "^ +", replacement = "") -> review_title2
 review_title <- append(review_title1, review_title2)
 
 # Review Text
 doc %>% 
   html_nodes("[class='a-size-base review-text review-text-content']") %>%
   html_text() %>% 
   stri_replace_all(regex = "\n| +|　+", replacement = " ") %>% 
   stri_replace_all(regex = "^ +", replacement = "")  -> review_text
 
 # Number of stars in review
 # There are two types of stars, so both are combined in the list.
 doc %>%
   html_nodes("[data-hook='review-star-rating']") %>%
   html_text() %>% 
   stri_replace_all(regex = "\n| +|　+|5つ星のうち", replacement = " ") %>% 
   as.numeric() -> review_star1
 doc %>%
   html_nodes("[data-hook='cmps-review-star-rating']") %>%
   html_text() %>% 
   stri_replace_all(regex = "\n| +|　+|5つ星のうち", replacement = " ") %>% 
   as.numeric -> review_star2
 review_star <- append(review_star1, review_star2)
 
 # product_name
 doc %>% 
   html_node('[class="a-size-large a-text-ellipsis"]') %>%
   html_text() -> product_name
 
 # supplier
 doc %>% 
   html_node('[class="a-size-base a-link-normal"]') %>%
   html_text() -> supplier
 
 # Return a tibble
 tibble(review_title,
        review_text,
        review_star,
        page = page_num,
        page_url = url,
        product_name = product_name,
        supplier = supplier) %>% return()
}

ASIN <- "B00YQTWQB2" # ASIN
page_range <- 1:69 # scrape pages 1 to 69

match_key <- tibble(n = page_range,
                   key = sample(page_range,length(page_range)))

lapply(page_range, function(i){
 j <- match_key[match_key$n==i,]$key
 
 message("Getting page ",i, " of ",length(page_range), "; Actual: page ",j) # Progress bar
 
 Sys.sleep(runif(1, 2.5, 3.5)) # 3-second break
 
 if((i %% 3) == 0){ # After every three scrapes... take another two second break
   message("Taking a break...") # message on your console
   Sys.sleep(runif(1, 2, 3)) # Take an additional 2-3 second break
 }
 scrape_amazon(ASIN = ASIN, page_num = j) # Scrape
}) %>% 
 bind_rows() -> x

 
 # save data
 write.csv(x, paste(Sys.Date(), "amazon", ASIN, "reviewutf.csv", sep="_"), fileEncoding = "utf-8")
 
 # For windows, write.xlsx from the openxlsx package can be used to save the file in a good way without line shift.
 write.xlsx(x, paste(Sys.Date(), "amazon", ASIN, "review.xlsx", sep="_"), asTable = FALSE, overwrite = FALSE)

# ☆5 data
x %>%
   mutate(review_star = as.numeric(review_star)) %>% # 関数でも数値化してますが念のため数値化
   mutate(text = paste(x$review_title, x$review_text)) %>% 
   filter(review_star == 5) %>% 
   write.csv("nivea_5star_amazon.csv", fileEncoding = "SHIFT-JIS")
  
# <☆3 data
x %>%
   mutate(review_star = as.numeric(review_star)) %>%
   mutate(text = paste(x$review_title, x$review_text)) %>% 
   filter(review_star <= 3) %>% 
   write.csv("nivea_under3star_amazon.csv", fileEncoding = "SHIFT-JIS")  
  

library(RMeCab)
# タイトルとテキストを結合
text <- x %>%
    mutate(text = paste(x$review_title, x$review_text))
dat$text <- dat$text %>%
    str_replace_all(pattern = '\\p{ASCII}',replacement = "")
dat_text <- dat$text %>%
    na.omit() %>%
    iconv(from = "UTF-8", to = "CP932") %>%  # windowsのみEncodeの変更が必要です。
    paste(collapse = "")
textfile <- tempfile()
write(dat_text, textfile)
unlink(textfile)
cloud <- cloud %>%
    select(everything(), FREQ = starts_with("file")) %>% # 4列目のfile****....という名前が長いためFREQへ変更
    arrange(desc(FREQ))
# 消したい不要なワードを設定
exclude_word = c("する","なる","やる","ある","いる","①","②","③","-","♪","NA","NANA","NANANA","NANANANA","＃","#")
# 動詞と名詞で良い感じのやつを残す
cloud2 <- cloud %>%
    filter(grepl(pattern = "動詞|名詞", x = POS1) &
    !grepl(pattern = "助動詞|代名詞", x = POS1) &
    !grepl(pattern = "非自立|接尾|数|代名詞", x = POS2)
    ) %>%
    filter(!TERM %in% exclude_word)

# 単語感情極性表の読み込み
sowdic <- read.table("http://www.lr.pi.titech.ac.jp/~takamura/pubs/pn_ja.dic",sep=":",col.names=c("term","kana","pos","value"),colClasses=c("character","character","factor","numeric"),fileEncoding="Shift_JIS")
# 品詞ごとにvalueが異なる場合があるのでくっつけて平均値をとる
sowdic2 <- aggregate(value~term+pos,sowdic,mean)
sowdic2$value <- sowdic2$value + 0.4 # デフォルトだとネガティブ寄りになるのでvalueを色を塗り分けたいところで調整
word <- subset(cloud2,TERM %in% sowdic2$term)
word <- merge(word,sowdic2,by.x=c("TERM","POS1"),by.y=c("term","pos"))
word2 <- word %>%
    mutate(color = if_else(value > -0.1, "skyblue", "salmon"))  # 色を塗り分けたいところでvalueを調整 もっとif_elseを重ねて塗分けてもいいかも
# 描画
word2 %>%
select(TERM, FREQ) %>%
mutate(FREQ = ((FREQ-mean(FREQ))/(sd(FREQ)))+1) %>%  # 文字の大きさのバランスを調整
arrange(desc(FREQ)) %>%
slice(1:150) %>% # 描画する範囲を設定
wordcloud2(color = word2$color, minRotation = 0, maxRotation = 0, size = 1)

# ポジティブな言葉出現頻度（Value > 0.3）
p_word <- word2 %>%
filter(value>0.3) %>%
aggregate(FREQ~TERM+POS1, ., FUN=sum) %>%
arrange(desc(FREQ)) %>%
mutate(TERM = fct_reorder(TERM, -FREQ, .desc=TRUE)) %>%
slice(1:30) %>%
ggplot() +
geom_bar(aes(TERM,FREQ), stat = "identity", fill = "steelblue") +
coord_flip() +
ggplot2::theme_minimal(base_size = 16, base_family = "TPM")+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text.y = element_text(face = c('bold'),
size = 14,
color = "steelblue")) +
labs(title = "明るい語句の出現頻度",
subtitle = "",
caption = "",
y = "出現頻度",
x = "語句")

# ネガティブな言葉出現頻度（Value < 0.1）
n_word <- word2 %>%
filter(value < -0.1) %>%
aggregate(FREQ~TERM+POS1, ., FUN=sum) %>%
arrange(desc(FREQ)) %>%
mutate(TERM = fct_reorder(TERM, -FREQ, .desc=TRUE)) %>%
slice(1:30) %>%
ggplot() +
geom_bar(aes(TERM,FREQ), stat = "identity", fill = "salmon") +
coord_flip() +
ggplot2::theme_minimal(base_size = 16, base_family = "TPM")+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text.y = element_text(face = c('bold'),
size = 14,
color = "salmon")) +
labs(title = "暗い語句の出現頻度",
subtitle = "",
caption = paste("Amazonレビュー：データ取得日", Sys.Date()),
y = "出現頻度",
x = "語句")

install.packages("gridExtra")
gridExtra::grid.arrange(p_word, n_word, nrow = 1)