風俗の推薦システムを作りたい#1

風俗で女の子を指名するための推薦システムを作りたい。

人によって選ぶ基準が異なると思う。

• ランキング
• 写真
• 口コミ

これらを総合的かつアルゴリズム的に判断するために、

下記のようなアウトプットを目的として調べたメモを残そうと思う。

時間帯・場所を指定してユーザーに合った女の子を推薦するWebサイト

今の構想

考えないといけないと思っているのは下記

1. 推薦のアルゴリズム（Collaborative or Contents-based）
2. データの取得方法（スクレイピング）
3. 推薦システムの実装（Pythonかな？）
4. 推薦システムの基盤構築（AWSがいいかな？）
5. お金の回収方法

暇なときに調べていこうと思う。

【R言語】掲示板を利用して風俗嬢のランキングを作る + knitrを使ってhtml生成もやる

前回までスクレイピングして感情分析とかもやってました。掲示板のレスの感情分析(Google AnalyzeSentiment)を利用した風俗嬢ランキング作成 - saikeisai's diary

ただ、感情分析をやって単純に足すと頻度で得られたランキングと同じになってしまったので今回は感情分析はやりません。（計算時間もかかりますし）
今回はknitrを使ってhtmlを生成します。
今回は川崎の「突撃奥サマ」という店でやりました。 とりあえずhtmlファイルはこんな感じで生成されました。

コードはfuzoku_ver1.zip - Google ドライブからまとめてダウンロードしてください。
.rmdファイルから実行してください。もしかしたらsourceでRのコード読み出しているところをちょっと変える必要があるかもしれません。
※今回のコードもスレッドの文字コードの問題やcityheavenの構造が地域や店舗によって違うことがあるため完全には対応できていません。

htmlファイルのファイル名の指定方法がわかりませんでした。

掲示板のレスの感情分析(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に渡したらなぜかエラーが帰ってきたのがあったのでそれをとりあえず除去しています。
おそらく文字コードが原因だと思います。
今回のコードはあんまり検証してないのですぐに例外やエラーが出ると思います。（

Google Cloud Natural Language APIの日本語の感情分析(analyzeSentiment)をRから使ってみる

最近、Google Cloud Natural Language APIの感情分析が日本語に対応したらしい。
今回はちょっと使ってみたのでそのコードを載せるだけである。
Rでやってみるが、どの言語でもできると思う。
Google Cloud PlatformのAPI_KEYを持ってない人は登録する必要があります。
以下、コードです。

getResult <- function(res){
  API_KEY <- "**********************"
  u <- paste0("https://language.googleapis.com/v1/documents:analyzeSentiment?key=", API_KEY)
  body <-list(document=list(type = "PLAIN_TEXT",
                            content = res,language="ja"))
  
  response <- POST(url = u,
              encode = "json",
              body = body,
              content_type_json())
  return(response)
}
library("httr")
res<-"最悪だ"
res1<-getResult(res)
content(res1)$documentSentiment$score

実行結果は以下のように帰ってきます。

> res1
Response [https://language.googleapis.com/v1/documents:analyzeSentiment?key=***************************]
  Date: 2017-05-19 12:30
  Status: 200
  Content-Type: application/json; charset=UTF-8
  Size: 287 B
{
  "documentSentiment": {
    "magnitude": 0.7,
    "score": -0.7
  },
  "language": "ja",
  "sentences": [
    {
      "text": {
        "content": "最悪だ",
...

content(res1)$documentSentiment$scoreでscoreだけ取れます。
ちなみに、テキストを"最高だ"にするとscore=0.7になりました。はい。

掲示板をスクレイピングして風俗嬢のランキングを作る

概要

最初に概要を述べます。
近年風俗業界もネットでの広告に力を入れている。
代表的なサイトとして、cityheaven, pureloversなどがある。しかし、レビューサイトは一部の地域や業種（fucolle, atarijo, kan-deli.net）ではあるものの、未だ統合的な風俗レビューサイトはない。現在、多くの風俗に関するレビューは2ch, shitaraba, bakusaiに投稿されている。
大目的として女の娘を選ぶ（指名）ことを目的としている。
私はこれまでこれらの掲示板に対してのスクレイピング方法を示してきた。
今回はcityheavenから特定の店舗の女の娘リストを取得して、掲示板（今回はしたらばのみ）においてどの娘が何回レスされているか数える。その際に、例えば「かな」という女の娘の出現頻度を数える際に文章で「○○かな？」などの名詞ではないものと区別するためにMeCabを用いて形態素解析を行う。
結果として無事出現頻度のランキングを図示することができた。
今後の展開としては、
1.レスの日付を用いた評価値の作成
現在に近いレスに高い重みをつけるほうが現実的と考えられるので
2.他の掲示板のレスと合わせて解析する

の２点を考えている。

本題

今回は「池袋人妻城」を対象とする。したらばの該当店のスレを用いる。スレ取得は以前の投稿で使ったコードをそのまま使います。
したらばのスレをRのrvestを用いてスクレイピングする - saikeisai's diary
（ちゃんと関数化するのは今度で）
女の娘のリストはcityheavenのサイトから取得する。
レスのなかでひらがな二文字の名前などは無関係な文章中でも出てくるのでMeCabの形態素解析を用いた。
出現回数のランキングを示す。

公式で出している本指名のランキングは、
である。
ランキング一覧｜池袋風俗デリヘル 池袋人妻城

以下にコードを示す。（変数resは上のリンクのコードを使えばとれます）

library("rvest")
library(RMeCab)
heaven<-"https://www.cityheaven.net/tokyo/A1305/A130505/hitodumajod/girllist/"
html<-read_html(x=heaven)

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<-1
}

getgirl<-function(html){
  girl_nodes<-html_nodes(html,xpath='//*[@class="girllisttext"]') %>% html_text()
  girl<-gsub("\\\r|\\\n|\\\t","",girl_nodes)
  girl<-gsub("[更新].+","",girl)
  girl<-gsub("[歳].+","",girl)
  girl<-gsub("[[:digit:]]","",girl)
  girl<-gsub("  ","",girl)
  return(girl)
}

girl<-c()
for(i in 1:num_page){
  url<-paste0(heaven,i,"/")
  girls_html<-read_html(x=url)
  girl<-c(girl,getgirl(girls_html))
}


res_conv<-iconv(x = res,to="Shift_JIS",from="UTF-8")
res_conv<-na.omit(res_conv)

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

num_girls<-length(girl)
girls_count<-numeric(num_girls)
for(i in 1:num_girls){
  girls_count[i]<-length(grep(pattern = girl[i],x = noun_res))
}
girl_list<-data.frame(girl=girl,count=girls_count)
ranking_to<-as.integer(num_girls/6)
ranking_count<-girl_list[head(order(girl_list[,2],decreasing = TRUE),n = ranking_to),]$count
ranking_girl<-girl_list[head(order(girl_list[,2],decreasing = TRUE),n = ranking_to),]$girl
plot(1:ranking_to,ranking_count,main = thread_title,xlab="rank",ylab="count",ylim=c(0,max(ranking_count)+20))
text(x = 1:ranking_to,y = ranking_count + 10, labels = ranking_girl)

私はMeCabをShift_JISでインストールしたのでiconvで変換しましたが、環境によっては不要かもしれません。
(また、その際に20程度のレスがNAになってしまいました)

名詞だけ取り出すコードは以下を参照しました。
R言語でワードクラウドを作る - jnobuyukiのブログ

爆サイ(bakusai)のスレをRのrvestを用いてスクレイピングする

これまで2chやしたらばをスクレイピングしてきた。
2chのスレをRのrvestを用いてスクレイピングする - saikeisai's diary
pink.2chのスレをRのrvestを用いてスクレイピングする - saikeisai's diary
したらばのスレをRのrvestを用いてスクレイピングする - saikeisai's diary
今回は爆サイをスクレイピングします。
爆サイは2chやしたらばに比べて全レス表示ができないので見づらい。
今回も、スレッドのURLを与えた際にスレッドタイトルとレスの内容とレス日付を求めた。
以下にコードを示す。

library("rvest")
original_url<-"http://bakusai.com/thr_res/acode=3/ctgid=103/bid=412/tid=3855080/" #bakusai
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")

最初にpageの数を取得してpageごとにスクレイピングを行って統合している。
実際にやってみるとまれに文字コードの問題でエラーになって取得できないことがあるようだ。
これは、おそらく
r - ページをスクレイピングしようと文字コードエラーがでます - スタック・オーバーフロー
こういう問題だと思う。解決策はわからない。
ちなみに私はWindows8.1の日本語環境です。

pink.2chのスレをRのrvestを用いてスクレイピングする

前回
2chのスレをRのrvestを用いてスクレイピングする - saikeisai's diary
2chのpinkではstatsがないためそのままだとスクレイピングできないということだった。
今回pink.2chのスクレイピングする。

今回も、スレッドのURLを与えた際にスレッドタイトルとレスの内容とレス日付を求めた。
以下にコードを示す。

library("rvest")
url<-"http://phoebe.bbspink.com/test/read.cgi/soap/1493567426/" #2ch
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,"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")

構成は結構したらばと似てますね。
ようやくxpathがわかってきたような気がします。
次は爆サイ(bakusai)をやってみようかと思います。