About

【R】テキストマイニングを利用して、東京ちんこ倶楽部と暇な女子大生を分析する

Rでツイッターのビッグデータを分析する




Rでツイッターのビッグデータを利用し、テキストマイニングしてみました。とはいっても、本当に基礎の基礎で、あるユーザーのツイートを3000個ほど取得し、どのような言葉をよく使っているかを調べるという企画です。


最終的な目標としては


・好きなアカウントの独特な話口を分析し
・そのアカウントっぽい言葉を特定すること


となります。

今回選ぶアカウントは、①東京ちんこ倶楽部さんと②暇な女子大生



さて、今回僕が選んだアカウントは、僕が個人的に好きなアカウントです。
まず、①東京ちんこ倶楽部さんです。日本のブラック企業皮肉力が高いアカウントで、2年ほど前からファンです。




ちなみにnavarがたっているので見るとこんな感じ。



さて、次は②暇な女子大生です。
下のツイートのように、


・高学歴の大学生、社会人を相手に
・Tinderという出会い系サイトを利用し
・喰いまくって性生活を暴露する


というアカウントです。



処理の流れ


処理の流れとしては、


1. Twitter APIに登録
2. Twitterのアクセストークンなどを取得
3. TwitteRをインストール
4. MeCab(日本語の形態素分析ツール)のインストール
5. ツイートの取得
6. Wordcloudで出力


という感じです。それでは早速。
まず初めに、https://apps.twitter.com/からTwitter ID、アクセストークンを取得します。なお事前に電話番号を取得しないとアプリを作成できないので登録しておくこと。
そして上記サイトから、以下4点を確認し、メモっておいてください。


1. consumerKey
2. consumerSecret
3. accsssToken
4. accessSecret

RでTwitter APIを利用


次にTwitterでログインするためのパッケージをインストールします。


install.packages("twitteR")
library(twitteR)
install.packages("ROuth")
library(ROAuth)


そして各種キーをセットし認証します。


consumerKey <- "Consumer Key (API Key)を入力"
consumerSecret <- "Consumer Secret (API Secret)を入力"
accessToken <- "Access Tokenを入力"
accessSecret <- "Access Token Secretを入力"
setup_twitter_oauth(consumerKey, consumerSecret, accessToken, accessSecret)


これでログインできます。さて、早速東京ちんこ倶楽部氏のツイートを取得します。


TwitteRの利用



#過去2000件のツイートを分析
tweets <- userTimeline("tokyoxxxclub", n = 2000)


#データフレームに変換し、テキスト部分だけを指定しツイートを取得

tweets <- twListToDF(tweets) #これでデータフレームにできます
tweets <- tweets$text #テキストデータだけ取得します

#テキスト変換

write.table(tweets,"tweets.txt") #一時的にテキストデータに保存します

RMeCab, dplyr, wordcloud, RColorBrewer, tm をまとめてインストール


install.packages("RMeCab", repos = "http://rmecab.jp/R")
library(RMeCab)

install.packages("dplyr")
library(dplyr)

install.packages("workcloud")
library(wordcloud)

install.packages("RColorBrewer")
library( RColorBrewer )

install.packages("tm", dependencies=TRUE)
library(tm)

日本語テキストの解析用に、パッケージ「RMeCab」を呼び出し、名刺、形容詞、動詞のみ抽出


tweetsFrq <- RMeCabFreq("tweets.txt")
tweetsFrq2 <- tweetsFrq %>% filter(Freq>10&Freq<400, Info1 %in% c("名詞"), Info2 != "数")

#URLや@などを削除

tweetsFrq2  <- gsub("^RT\\s@[0-9a-zA-Z\\._]*:\\s+","",tweetsFrq2 )
tweetsFrq2   <- gsub("https?://t.co/[0-9a-zA-Z\\._]*","",tweetsFrq2 )

wordcloud上に表示


wordcloud(tweetsFrq$Term,tweetsFrq$Freq,random.order=FALSE,
  color=rainbow(5),random.color=FALSE,scale=c(3,1),min.freq=10)



さて、ここまでの流れで、東京ちんこ倶楽部氏のツイートで頻繁につぶやかれている言葉を確認できました。





といった感じに、単語を見ると「そういえばこのアカウントこの言葉めっちゃつぶやいているなぁ」なんて言葉が出てきます。


同じ処理で暇な女子大生を分析してみたところ.....


といった言葉が出現しました。おおよそアカウントに関係する言葉が出てきたと思われます。


東京ちんこ倶楽部語、暇な女子大生語で話したい人は、下の画像をみて勉強してみてください。(1枚目が東京ちんこ倶楽部、2枚目が暇な女子大生。ちんぽの利用度が非常に多いことがわかります。)







参考


Twitter Data Analysis with R - RDataMining.com: R and Data Mining http://www.rdatamining.com/docs/twitter-analysis-with-r

Rでワードクラウドを作成してみる - Qiita
http://qiita.com/SoNa/items/dfd435c4ebee29e100f7

RでTwitterのデータを分析するための準備(2015年6月現在のやり方) - StatsBeginner: 初学者の統計学習ノート
http://www.statsbeginner.net/entry/2015/06/20/094620

TwitterのデータをRであれこれ
https://www.slideshare.net/abicky/twitterr

テキストマイニングはじめました〜その11〜 - Rを通じて統計学を学ぶ備忘録ブログ http://sugisugirrr.hatenablog.com/entry/2016/06/26/%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E3%83%9E%E3%82%A4%E3%83%8B%E3%83%B3%E3%82%B0%E3%80%9C%E3%81%9D%E3%81%AE%EF%BC%91%EF%BC%91%E3%80%9C


スポンサーリンク

K-meansでクラスタ分析をRでやってみる 【データサイエンス養成読本】

2017-08-21

今日はK-meansまでRでやってみる。
データサイエンティスト養成読本の続きからですね。




K-means (P40~)


そもそもK-meansとは何かよくわからなかったので、しらべてみた。

・非階層型クラスタリングのアルゴリズム
・最適化問題を解くアルゴリズム

らしい。



さっそくコードを書いてみると。とりあえずk-meansでクラスタに分けて、プロットするまでやってみる。


#k-means
data <- state.x77 #州データを代入
pca <- prcomp(data[,1:6], scale = T)
nrow(data) #列の数を算出
head(data) #うえから6つのデータを取得
km <- kmeans(scale(data[,1:6]),3) #3つにクラスタがわかれることを想定
#主成分分析の結果にクラスターの情報を付与する
df <- data.frame(pca$x)
df$name <- rownames(df)
df$cluster <- as.factor(km$cluster)
#描画
ggplot(df, aes(x=PC1,y=PC2,label=name,col=cluster)) + geom_text() + theme_bw(16)
そうすると結果がこんな感じになる。


さて、これを今度はレーダーチャートに変換する。


#レーダーチャート
install.packages("fmsb")
library(fmsb)
df <- as.data.frame(scale(km$centers))
dfmax <- apply(df,2,max) + 1
dfmin <- apply(df,2,min) - 1
df <- rbind(dfmax,dfmin,df)
#レーダーチャートを描画
radarchart(df,seg=5,plty=1,pcol=rainbow(3))
legend("topright",legend=1:3,col=rainbow(3),lty=1)
結果的にはこんな感じになる。








スポンサーリンク

主成分分析までをRで書いてみる(データサイエンス養成読本)

2017/08/20
今日もちびちびデータサイエンティスト養成読本を進めながらRを学習しました。




基本的には写経ですが、気になったところも少し深堀して調べてみました。

データフレームの基本操作 P30~


#csvが存在するディレクトリを選択
setwd("C:/Users/Dai/Desktop")


#csvデータの読み込み
body.data <- read.table("body_sample.csv", header = T)
head(body.data)


#データフレームの基本操作

body.data[, 2] #列番号を指定して取得
body.data[, c[1,3]] #複数の列番号を指定して取得
body.data[, "weight"] #列名で取得
body.data$weight #列名で取得
body.data[, c("height","weight")]

body.data[body.data$gender == "F"] #条件にあった行だけ取り出す
body.data[order(body.data$height)] #身長順にソート
body.data[order(body.data$height, decreasing = T )] #身長順にソート

#要約統計量

summary(body.data)

#標準偏差と不偏分散

sd(body.data$height)
val(body.data$weight)

ggplot2のインストールで詰まる


ggplotをインストールする際に、いろいろエラーが発生してしまいました。そこまでの軌跡はこちらにまとめておきました。

セキュリティの問題だったので、カスペルスキーをいったん解除したら治りましたとさ。


ヒストグラムを書いてみよう



#ヒストグラムの描画

ggplot(data, aes(x=height)) + geom_histogram() + theme_bw(16) + ylab("count")
ggplot(data, aes(x=height, fill = gender)) + geom_histogram() + theme_bw(16) + ylab("count")

#身長データの箱ひげ図

ggplot(data, aes(x = gender, y=height, fill = gender)) + geom_boxplot() + theme_bw(16)



#(番外編) 散布図を作成する
ggplot(data, aes(x = height, y=height, fill = gender)) + geom_point() + theme_bw(16)

#(番外編) 散布図を作成し、genderごとに色を分ける
ggplot(data, aes(x = height, y = weight, fill = gender)) + geom_point(aes(colour=gender)) #+ theme_bw(16)

#(番外編)X軸とY軸に名前をつけ、さらにタイトルにまで名前を付ける

ggplot(data, aes(x = height, y = weight, fill = gender)) + geom_point(aes(colour=gender)) + ggtitle("Weight and Height in Sex Difference") + xlab("Height") + ylab("Height")




#回帰直線を追加

ggplot(data, aes(x = height, y = weight, fill = gender)) + geom_point(aes(colour=gender)) + ggtitle("Weight and Height in Sex Difference") + xlab("Height") + ylab("Height") + geom_smooth(method = "lm")

#相関係数を算出(全体)

cor(data$height,data$weight)

#相関係数を算出(男性)
m <- data[data$gender == "M",]
cor(m$height, m$weight)

#相関係数を算出(女性)
f <- data[data$gender == "F",]
cor(m$height, m$weight)

多変量解析をやってみよう(P34~)



#仮想データの読み込み

amount <- read.csv("amount1.csv")

#上位6県を表示

head(amount)

#数値要約

summary(amount)

#散布図の描画

ggplot(amount, aes(x = invest, y = amount)) + geom_point() + theme_bw(16)+ggtitle("多変量解析")

#線形回帰分析(liner models)

data <- amount
lm <- lm(amount^invest, data=data)
summary(lm)

#逓減型回帰モデル

ggplot(amount, aes(x = invest, y = amount)) + geom_point() + theme_bw(16)+ggtitle("多変量解析") + geom_smooth(method = "lm", formula = y ~ log(x))


このへんよく理解できなかったなぁ。

P36

#ロジスティック回帰モデル

z <- data.frame(Titanic)
head(z)



#データの整形

data <- data.frame(
     Class = rep(z$Class, z$Freq),
     Sex = rep(z$Sex, z$Freq),
     Age = rep(z$Age, z$Freq),
     Survived = rep(z$Survived, z$Freq))

nrow(data) #データの個数を調べる

#モデルの構築

logit <- glm(Survived~., data = data, family = binomial)
summary(logit)

#epicalcパッケージの読み込みとオッズ比の計算

install.packages("devtools")
library(devtools)
install_github("cran/epicalc")
library(epicalc)

#オッズ比の算出
logistic.display(logit,simplified  =T)

#決定木モデルの構築

install.packages("partykit")
library(rpart)
library(partykit)

#決定木モデルの構築

rp <- rpart(Survived~., data=data )

#決定木の描画

plot(as.party(rp), tp_args=T)





library(rpart.plot)
prp(rp, type=2, extra=101, nn=TRUE, fallen.leaves=TRUE, faclen=0, varlen=0, shadow.col="grey", branch.lty=2, cex = 0.9, split.cex=1.3, under.cex = 1.0)

#主成分分析 Population Income Illiteracy Life Exp Murder HS Grad Frost   Area

data <- state.x77
nrow(data)
pca <- prcomp(data[,1:6], scale = T)
biplot(pca)




今日はここまででした!



スポンサーリンク

> Error in loadNamespace(j <- i[[1L]], c(lib.loc, .libPaths()), versionCheck = vI[[j]]) there is no package called ‘Rcpp’

やりたいこと


・R Studioにggplot2をインストールし、呼び出す
・library(ggplot2)を実行する

現状


・gglot2をインストールし、library(ggplot2)を実行すると、以下のエラーが起こる

> library(ggplot2)
Error in loadNamespace(j <- i[[1L]], c(lib.loc, .libPaths()), versionCheck = vI[[j]])
there is no package called ‘Rcpp’


打開策


ネットでいろいろ調べてみたら、どうやらセキュリティソフトが邪魔してうまくいかなかったみたい。そこでカスペルスキーの保護をいったん削除して実行してみる。



結果成功した。




スポンサーリンク

教養とは、「知識量」x「転移力」である

ふと教養について考えてみた。



教養とは、「知識の量」ではない


教養を知識の量だと思っている人がいるが、個人的にはそれは必要条件ではあるが、十分条件ではないと思っている。


そしてそれは、旧来の知識偏重主義の日本教育がもたらした、学習観に基づいていると思う。こういう人たちは、


・大学の授業に出る義務があって、義務であるから勉強するような人。「大学の授業に出なければいけない!サボるなんてありえない!」という人

・会社からキャリアパスを与えられ、そのキャリアパスを達成するためにTOEICの点数が必要で、「昇進のために必要だ!」という人。

・世の中で流行っている本を探して、「やばい流行だから読まなきゃ!」と言って読んでいる人

である。つまり、課された知識をできるだけ吸収することが、教養だと思っている。


教養とは、「知識量」 x「転移力」だと思う


しかし僕は教養とは「知識量」x「転移力」だと思っている。


転移能力とは、「異なる複数の学習領域を、シナプスのようにつなぎ合わせる能力」である。そして、さまざまな知識を頭の中にいれ(知識量)、それを結び付けて新しい視点を手に入れられる力こそが教養である。世の中のクリエイティブな偉人(スティーブジョブズ)は、無関係と思われるさまざまな知識を転移することで、大きな発明を残してきた。


転移力には、大きな問題意識と、客観性が必要である


その転移力を磨くために必要であるのは、問題意識と、客観性だ。


つまり、ある一つの問題意識、もしくは関心をもとに、さまざまな知識を整理する。そして、その軸をもとに様々な知識をつなぎ合わせるのだ。


その際、自分の問題意識が強すぎて、主観的になりすぎると、「この問題はこうに違いない!」と視野を狭めてしまう。そうではなくて、ある問題に対してできるだけ客観的な視点で、さまざまな要因を鳥瞰する誠実さも大事になる。


教養とは、知識を受動的に蓄える作業ではなく、蓄えた知識をもとに何かを生み出す積極的な姿勢によって、表現できるものなのではないだろうか。

スポンサーリンク

Read more↓

書評














教育











キャリア

プログラミング・ライフハック

About me


・ 最近The Academic Timesというアカデミック専用メディアを立ち上げました。