掲示板のレスの感情分析(Google AnalyzeSentiment)を利用した風俗嬢ランキング作成

以前、単純に掲示板のレスに発生頻度からランキングを作りました。
掲示板をスクレイピングして風俗嬢のランキングを作る - saikeisai's diary
また、Googleの感情分析をRから利用しました。
Google Cloud Natural Language APIの日本語の感情分析(analyzeSentiment)をRから使ってみる - saikeisai's diary

今回は、Googleの感情分析を利用して風俗嬢のランキングを作成します。
まず、今回の対象店舗は川崎の「RUSH」です。
また、今回2つのスレッドを用います。（並行してあったので）
【川崎・堀之内】RUSH・エデン川崎 99【京都G】 [無断転載禁止]©bbspink.com
【川崎・堀之内】RUSH★【京都G】 [無断転載禁止]©bbspink.com

かんたんにプログラムの流れを説明します。
まず、女の娘の名前のリストはcityheavenのページから取得します。
次にスレッドからレスを取得して形態素解析して名詞だけ抽出します。
その後に名前のリストと名詞を比較して発生頻度を出します。
最後に、女の娘の名前が含まれているレスに対して感情分析にかけて結果(scoreとmagnitude)を足し合わせます。
以上です。

scoreは単純にネガポジ-1～1ですが、magnitudeは私は情報の多さのようなものかなと判断しました。
あまりこの2つの値をどう取扱うか文献も見当たらなかったので今回は足しました。（どこかでかけあわせたやつもありました）

これが、出現頻度です。

これが、嬢の名前が含まれるレスの感情値をすべて足し合わせたランキングです。

まあ足し合わせただけなんで当たり前かもしれませんが、出現頻度のランキングと同じになってしまいました。
exp(score)とかやってもいいんですが、あまり理由（根拠）もないので微妙ですね。

以前の投稿であげたコードから少し更新しているので以下コード
main

rm(list = ls())
library(RMeCab)
source("C:\\Users\\*****\\Dropbox\\getRes.R")
source("C:\\Users\\****\\Dropbox\\getGirl.R")
source("C:\\Users\\****\\Dropbox\\sentimentAnalysisGoogle.R")
girl_url <-
  "https://www.cityheaven.net/kanagawa/A1403/A140301/rush/girllist/"
bbs_url <-
  c(
    "http://phoebe.bbspink.com/test/read.cgi/soap/1488780698",
    "http://phoebe.bbspink.com/test/read.cgi/soap/1482504574"
  )

girl_list <- getGirlname(girl_url)
res_list <- getResList(bbs_url)

res_list$text_conv <-
  iconv(x = res_list$text, to = "Shift_JIS", from = "UTF-8")
res_list$text_conv <- na.omit(res_list$text_conv)
# 最終的な単語リストを保存するオブジェクトの確保
wordlist <- ""
#テキストが回答ごとに別の要素になっているのでfor文を利用する
for (i in 1:length(res_list$text_conv)) {
  currentlist <- unlist(RMeCabC(res_list$text_conv[i]))
  wordlist <- append(wordlist, currentlist)
}
noun_res <- wordlist[names(wordlist) == "名詞"]

num_girls <- length(girl_list$girl)
girls_count <- numeric(num_girls)
for (i in 1:num_girls) {
  girls_count[i] <-
    length(grep(pattern = girl_list$girl[i], x = noun_res))
}
girl_frame <- data.frame(girl = girl_list$girl, count = girls_count)
ranking_to <- as.integer(num_girls / 6)
ranking_count <-
  girl_frame[head(order(girl_frame[, 2], decreasing = TRUE), n = ranking_to),]$count
ranking_girl <-
  girl_frame[head(order(girl_frame[, 2], decreasing = TRUE), n = ranking_to),]$girl

base_filename = paste0(girl_list$shopname, "_" , format(Sys.time(), "%Y-%m-%d"))
png(
  filename = paste0(base_filename, "_count", ".png"),
  width = 600,
  height = 450
)
plot(
  1:ranking_to,
  ranking_count,
  main = girl_list$shopname,
  xlab = "rank",
  ylab = "count",
  ylim = c(0, max(ranking_count) + 20)
)
text(x = 1:ranking_to,
     y = ranking_count + 10,
     labels = ranking_girl)
dev.off()

girls_sumSentiment <- numeric(num_girls)
for (i in 1:num_girls) {
  res_index <-
    grep(pattern = girl_list$girl[i], x = res_list$text_conv)
  for (j in res_index) {
    sentiment <- getSentimentScore(res_list$text_conv[j])
    if (is.null(content(sentiment)$error)) {
      girls_sumSentiment[i] <-
        girls_sumSentiment[i] + content(sentiment)$documentSentiment$magnitude
      + content(sentiment)$documentSentiment$score
    }
  }
}
girl_frame$sumSentiment <- girls_sumSentiment

ranking_sentiment2 <-
  girl_frame[head(order(girl_frame[, 3], decreasing = TRUE), n = ranking_to),]$sumSentiment
ranking_girl2 <-
  girl_frame[head(order(girl_frame[, 3], decreasing = TRUE), n = ranking_to),]$girl

png(
  filename = paste0(base_filename, "_sumSentiment", ".png"),
  width = 600,
  height = 450
)
plot(
  1:ranking_to,
  ranking_sentiment2,
  main = girl_list$shopname,
  xlab = "rank",
  ylab = "sumSentiment",
  ylim = c(0, max(ranking_sentiment2) * 1.5)
)
text(x = 1:ranking_to,
     y = ranking_sentiment2 + 2,
     labels = ranking_girl)
dev.off()
<||

getGirl.R
>||
getGirlname<-function(url){
  library("rvest")
  if (length(grep(pattern = "cityheaven", url)) > 0) {
    return(getCityheavenGirlname(url))
  }
  #ピンサロ用
  if (length(grep(pattern = "girls.php", url)) > 0) {
    return(getPinksalonGirlname(url))
  }
  else {
    print("url must include bakusai,2ch.net,bbspink,shitaraba")
  }
}
getHeavenGirlName<-function(html){
  girl_nodes<-html_nodes(html,xpath='//*[@class="girllisttext"]') %>% html_text()
  if(length(girl_nodes)==0){
    girl_nodes<-html_nodes(html,xpath='//*[@class="girl_name"]') %>% html_text()
  }
  girl<-gsub("\\\r|\\\n|\\\t","",girl_nodes)
  girl<-gsub("[更新].+","",girl)
  girl<-gsub("[歳].+","",girl)
  girl<-gsub("[[:digit:]]","",girl)
  girl<-gsub("  ","",girl)
  girl<-gsub("\\?","",girl)
  girl<-gsub(" ","",girl)
  girl<-gsub("〔","",girl)
  girl<-girl[girl!=""]
  
  return(girl)
}

getCityheavenGirlname<-function(original_url){
  html<-read_html(x=original_url)
  num_page_nodes<-html_nodes(html,xpath='//*[@id="contensbox"]/div/div/ul[2]/center/a')
  num_page<-length(num_page_nodes)
  if(num_page ==0){
    num_page_nodes<-html_nodes(html,xpath='//*[@id="shopgirls"]/ul[1]/center/a')
    num_page <- length(num_page_nodes)
  }
  #上に次のページのリンクがない場合
  if(num_page==0){
    num_page<-1
  }
  shop_name <- html_nodes(html,xpath='//*[@id="location-breadcrumbs-wrap"]/li[6]/a/span') %>% html_text
  
  girl<-c()
  for(i in 1:num_page){
    url<-paste0(original_url,i,"/")
    girls_html<-read_html(x=url)
    girl<-c(girl,getHeavenGirlName(girls_html))
  }
  return(list(girl=girl,shopname=shop_name))
}
getPinksalonGirlname<-function(url){
  html<-read_html(url)
  girl_name_nodes<-html_nodes(html,xpath='//*[@class="name"]')
  girl_name<-html_text(girl_name_nodes)
  girl_name<-gsub(".+[[:digit:]]","",girl_name)
  girl_name<-gsub(" ","",girl_name)
  return(girl_name)
}

getRes.R

getResList <- function(url){
  if(length(url) > 0){
    temp <- getSingleThreadResList((url[1]))
    if(length(url) > 1){
      for(i in 2:length(url)){
        temp <- mapply(c, temp, getSingleThreadResList(url[i]))
      }
    }
    return(temp)
  }
  else{
    print("input url")
  }
}

#argument : url must include {bakusai,2ch,pink.2ch,shitaraba}.
#return   : list(text=res_text,date=res_date,title=thread-title)
getSingleThreadResList <- function(url) {
  library("rvest")
  if (length(grep(pattern = "shitaraba", url)) > 0) {
    return(getShitarabaResList(url))
  }
  if (length(grep(pattern = "bbspink", url)) > 0) {
    return(getBbspinkResList(url))
  }
  if (length(grep(pattern = "bakusai", url)) > 0) {
    return(getBakusaiResList(url))
  }
  if (length(grep(pattern = "2ch.net", url)) > 0) {
    return(get2chNetResList(url))
  }
  else {
    print("url must include bakusai,2ch.net,bbspink,shitaraba")
  }
}

getShitarabaResList<-function(url){
  html<-read_html(x=url,encoding = "CP932")
  
  #スレタイ
  title_nodes<-html_nodes(html,"h1.thread-title")
  thread_title<-html_text(title_nodes)
  
  res_nodes<-html_nodes(html,"dd")
  res<-html_text(res_nodes)
  res<-gsub("\\n","",x=res)
  res<-gsub(" ","",x=res)
  
  res_date<-html_nodes(x = html,xpath='//*[@id="thread-body"]/dt')
  res_date<-html_nodes(res_date,xpath='text()[3]')
  res_date<-gsub("\\n","",x=res_date)
  res_date<-gsub(" ","",x=res_date)
  res_date<-gsub("：","",x=res_date)
  res_date<-gsub("\\((月|火|水|木|金|土|日)\\)"," ",res_date)
  res_POSIX<-as.POSIXlt(res_date)
  
  return(text=res,date=res_POSIX,title=thread_title)
}
getBbspinkResList<-function(url){
  html<-read_html(x=url,encoding = "CP932")
  
  #スレタイ
  title_nodes<-html_nodes(html,"h1.title")
  thread_title<-html_text(title_nodes)
  thread_title<-gsub("\\n","",x=thread_title)
  
  res_nodes<-html_nodes(html,"dd")
  res<-html_text(res_nodes)
  res<-gsub("\\n","",x=res)
  res<-gsub(" ","",x=res)
  
  date_nodes<-html_nodes(html, xpath='//*[@class="date"]')
  date<-html_text(date_nodes)
  #\32 > dt > span.date
  date<-gsub("\\((月|火|水|木|金|土|日)\\)"," ",date)
  date<-gsub("  "," ",date)
  date<-gsub(" [ID].+","",x=date)
  date_POSIX<-as.POSIXlt(date,format = "%Y/%m/%d %H:%M:%S.%OS")
  return(list(text=res,date=date_POSIX,title=thread_title))
}
getBakusaiResList<-function(original_url){
  html<-read_html(x=original_url,encoding="CP932")
  
  #スレタイ
  title_nodes<-html_nodes(html,xpath='//*[@id="breadcrumbs"]/span[4]/span')
  thread_title<-html_text(title_nodes)
  
  #一度に全レスを取得することができないのでページ数を取得して各ページで取得する
  num_page_nodes<-html_nodes(html,xpath='//*[@class="paging_numberlink"]')
  num_page<-length(num_page_nodes)+1
  
  getRes <- function(html){
    res_nodes<-html_nodes(html,xpath='//*[@class="resbody"]')
    res<-html_text(res_nodes)
    res<-gsub("\\n","",x=res)
    res<-gsub(" ","",x=res)
    return(res)
  }
  
  getDate <- function(html){
    date_nodes<-html_nodes(html,xpath='//*[@itemprop="commentTime"]')
    date<-html_text(date_nodes)
    return(date)
  }
  
  res<-c();date<-c();
  for(i in 1:num_page){
    url<-paste0(original_url,"p=",i,"/tp=1/rw=1/")
    url_html<-read_html(x=url,encoding="CP932")
    res<-c(res,getRes(html=url_html))
    date<-c(date,getDate(html=url_html))
  }
  
  date<-as.POSIXlt(date,format = "%Y/%m/%d %H:%M")
  return(list(text=res,date=date,title=thread_title))
}
get2chNetResList<-function(url){
  html<-read_html(x=url)
  
  #スレタイ
  title_nodes<-html_nodes(html,"h1.title")
  thread_title<-html_text(title_nodes)
  thread_title<-gsub("\\n","",x=thread_title)
  res_nodes<-html_nodes(html,xpath='//*[@class="escaped"]')
  res<-html_text(res_nodes)
  date_nodes<-html_nodes(html,xpath='//*[@class="date"]')
  date<-html_text(date_nodes)
  date<-gsub("\\((月|火|水|木|金|土|日)\\)"," ",date)
  date<-gsub("  "," ",date)
  date_POSIX<-as.POSIXlt(date,format = "%Y/%m/%d %H:%M:%S.%OS")
  return(list(text=res,date=date_POSIX,title=thread_title))
}

実はgoogleのAnalyzeSentimentに渡したらなぜかエラーが帰ってきたのがあったのでそれをとりあえず除去しています。
おそらく文字コードが原因だと思います。
今回のコードはあんまり検証してないのですぐに例外やエラーが出ると思います。（