getTweet4

RでTwitterからデータをとってくる｡それを使って社会ネットワーク

• ここまでの総集編
• まずインストール 　　　一度すればok

install.packages('XML')

• 処理方法

#まず必要なサブルーチンを定義
library(XML)
##検索語と　取得ページ数を指定　多分最大15ページ(ページあたり100)必要な情報を抽出してデータフレームに(windowsでは今のところ日本語検索がうまくいかない)　[[ Twitterからのデータ取得v2|getTweet2]]のもの
 searchTweet2<-function(sword, npages){
(a<-Sys.info())
(fg.win<-length(grep("WIND.*",a,ignore.case =T))!=0)   #WinならばTRUEになる
#サーチ語の文字コード変換
 #sword<-"孫正義";npages<-page<-1
 if(fg.win)  (sword<-iconv(sword,from="WINDOWS-932",to="UTF-8"))
 #if(fg.win)  (sword<-iconv(sword,from="UTF-8",to="WINDOWS-932"))
 #if(fg.win)  (sword<-iconv(sword,to="UTF-8"))
    twitter_q <- URLencode(sword)      # search parameter
  mydata.xmls <- character(0)

 for (page in c(1:npages))
{ 
    # URL作成
    (twitter_url = paste('http://search.twitter.com/search.atom?q=',twitter_q,'&locale=ja&lang=ja&rpp=100&page=', page,  sep=''))
   ( mydata.xml <- xmlParseDoc(twitter_url, asText=F,encoding = "UTF-8"))


if(length(mydata.xml )==0){
   print(list(sword,"ヒットしませんでした"))
   pdate<-user_name<-user_rname<-user_url<-messages<-NULL
}
else{ 
pdate <- xpathSApply(mydata.xml, '//s:entry/s:published', xmlValue, namespaces =c('s'='http://www.w3.org/2005/Atom'))
authors <- xpathSApply(mydata.xml, '//s:entry/s:author', xmlValue, namespaces =c('s'='http://www.w3.org/2005/Atom'))
authors <- xpathSApply(mydata.xml, '//s:entry/s:author', xmlValue, namespaces =c('s'='http://www.w3.org/2005/Atom'))
authors2<-lapply(authors,function(x) gsub("^\n","",x) )
authors2<-lapply(authors,function(x) gsub("\n)",")",x) )  #ユーザー名の中に\nが使われている
authors2<-lapply(authors2,function(x) gsub(" ","",x) )
authors3<-lapply(authors2,function(x) unlist(strsplit(x,"\n")))
authors4<-as.data.frame(authors3)

usernam<-t(authors4[2,]);rownames(usernam)<-NULL
#explorer_taku(TAKU)   基本はこのようになっているが
#"nya_harinezumi(にゃ〜(よばりん)@美菜子病)　　　のようにrユーザー名にも(があるのもいる

user_name<-unlist(lapply(usernam,function(x) gsub('\\(.*\\)$',"",as.character(x))))  #ユーザー名
user_rname<-substr(usernam,nchar(user_name)+2,nchar(usernam)-1)
(user_url<-t(authors4[3,]));rownames(user_url)<-NULL   #URL

 messages <- xpathSApply(mydata.xml, '//s:entry/s:title', xmlValue, namespaces =c('s'='http://www.w3.org/2005/Atom'))
messages<-sapply(messages,as.character)  

 #windows  932コードの場合､それに変換
 if(fg.win){
  (messages<-sapply(messages,function(x)  iconv(x,from="UTF-8",to="WINDOWS-932") ))
  (user_rname<-sapply(user_rname,function(x)  iconv(x,from="UTF-8",to="WINDOWS-932") ))
  }
 }
dat<-data.frame(pdate, user_name, user_rname, user_url, messages)
names(dat)<-c("pdate", "user_name", "user_rname", "user_url", "messages")
if(page==1){dat0<-dat}
   else{
   dat0 <- rbind(dat0, dat)
  }
mydata.xmls <- list(mydata.xmls, mydata.xml)
}
 print(dim(dat0))
 print(names(dat0))
return(list(dat0, mydata.xmls))
}

#人名を切り出すルーチン　　[[ Twitterからのデータで社会ネットワーク|getTweet3]]から
get_from_to<-function(sText){
I_Jdat<-NULL
sText$from<-sText$id<-sText$id2<-""   #これに取り出された人名を入れる  from->id ->id2
sText$fg.RT<-sText$fg.reply<-0

for(ii in seq(1,dim(sText)[1])){
 (txt<-sText$messages[ii])
 fg.RT<-0  #RTフラグ
 fg.reply<-0 
 d<-from<-id<-id2<-NA
 mfrom<-mto<-retweeter<-character(0)

 if(is.na(txt)){#メッセージがNAの場合
print(list("message is NA in #",ii,sText[ii,]))
	type<-"message is NA"
 id2<-id<-sText$user_name
	 d<-data.frame(ii,fg.RT,fg.reply,from,id,type)
}
else{
(rt<-unlist(gregexpr("^RT @",txt)))#はじめの@を検出
if(rt==1) {#@from→@id→@idのフォロアー
(b<-unlist(gregexpr(":",txt)))#@の後の:　を検出
if(min(b)<20){
fg.RT<-1
id<-substr(txt,5,min(b)-1)	#RTした人
   txt2<-substr(txt,b+1,150)	#
(a<-unlist(gregexpr("@",txt2)))#@を検出
(s<-unlist(gregexpr("[ 　]",txt2)))#@の後の 全角､半角スペース　を検出
	s<-s[s>min(a)]
 from<-substr(txt2,min(a)+1,min(s)-1)
type<-"RT-in"
 d1<-data.frame(ii,fg.RT,fg.reply,from,id,type)
type<-"RT-out"
	id2<-id
 d2<-data.frame(ii,fg.RT,fg.reply,id,id2,type);names(d2)<-names(d1)
 #followerにRTしたのだが､そのリストがないので自分にだけ返したことに　　あとでRT-outについてはidのフォロアーを検索して代入することを想定
		d<-rbind(d1,d2)
 }
}

#2)投稿者@id が@form に返信した場合  #@from→@id→@from
(rp<-unlist(gregexpr("^@",txt)))#はじめの@を検出
if(rp==1) {
(b<-unlist(gregexpr("[ 　]",txt)))#@の後の: 　を検出
if(min(b)<30){
fg.reply<-1
from<-substr(txt,2,min(b)-1)	#RTした人
   txt2<-substr(txt,b+1,150)	#
(a<-unlist(gregexpr("@",txt2)))#@を検出
(s<-unlist(gregexpr("[ 　]",txt2)))#@の後の 全角､半角スペース 　を検出
	s<-s[s>min(a)]
 id<-substr(txt2,min(a)+1,min(s)-1)
type<-"Reply-in"
 d1<-data.frame(ii,fg.RT,fg.reply,from,id,type)
type<-"Reply-out"
	id2<-from
 d2<-data.frame(ii,fg.RT,fg.reply,id,id2,type);names(d2)<-names(d1)
	d<-rbind(d1,d2)
 }
}
  
#3)投稿者が単にッイーと
#3-1 メッセージにだれかのメッセージを含んでいる場合=数桁目以降に@ _がある｡
 if(rt==-1 & rp==-1){
   (sp<-unlist(gregexpr("@",txt)))#はじめの@を検出
 if(sp>1) {
(b<-unlist(gregexpr("[ 　:]",txt)))#@の後の: 　を検出
if(max(b)==Inf) b<-nchar(text)
      b<-b[b>sp]
	if(min(b)-sp<20){ 
 from<-substr(txt,sp+1,min(b)-1)	
 id<- sText$user_name[ii]
 id2<- sText$user_name[ii]

type<-"Tweet-in"
 d1<-data.frame(ii,fg.RT,fg.reply,from,id,type)
type<-"Tweet-out"
 d2<-data.frame(ii,fg.RT,fg.reply,id,id2,type);names(d2)<-names(d1)
	d<-rbind(d1,d2)
 }
else{
from<-""
id2<-id<- sText$user_name[ii]
type<-"JustTweet"
 d<-data.frame(ii,fg.RT,fg.reply,from,id,type)
}
  }
 }
}
 sText$fg.RT[ii]<-fg.RT
 sText$fg.reply[ii]<-fg.reply
    sText$from[ii]<-from
    sText$id[ii]<-id
    sText$id2[ii]<-id2
 if( ii==1)  {I_Jdat<-d}
	else{I_Jdat<-rbind(I_Jdat,d)
	}
}
return(list(sText,I_Jdat))
}
 #
##-------------------------iがjにコメントしたという非対称行列を、i*i行列に変換
#　$mat	　　　i*i行列　　iがjにn回コメントした
#　$mat2	　　　i*i行列　　iがjにn回コメントした  上から名前が""を除いたもの　””がない場合はmatと同じ
#　$namlab 	名前リスト
#	$nperson	名前の数　　""も含む
#	$fgnamlab　名前リストの何番目に""（だれにも当てていないメッセージ）があるか。T or F
prepmat<-function(pbyp){
#名前ラベル作成。名前の重複をチェック。アルファベット順に並べ替えたものが名前一覧（どちらかに含まれる人）
 #	pbyp<-mat
n1<-dimnames(pbyp)[[1]]
n2<-dimnames(pbyp)[[2]]
#これで変数名memnamにメンバー一覧が入った列ベクトルができる。
namlab<-merge(n1,n2,by.x=1,by.y=1,all=T)
namlab<-as.character(namlab[order(namlab),])
namlab<-as.data.frame(namlab)
names(namlab)<-"memnam"
print(dim(namlab))
#""が入っている場合は、ソートすると１番目に来ている。
fgnamlab<-namlab$memnam[1]==""
fgnamlab
nperson<-dim(namlab)[1]
nperson
#正方行列に整形する
mat<-matrix(0,nrow=nperson,ncol=nperson)
i2<-match(dimnames(pbyp)[[1]],t(namlab))
j2<-match(dimnames(pbyp)[[2]],t(namlab))
	for (i in seq(1:dim(pbyp)[[1]])) {
	for (j in seq(1:dim(pbyp)[[2]])) {
		mat[i2[i],j2[j]]<-pbyp[i,j]
	}
}
mat<-as.data.frame(mat)
row.names(mat)<-t(namlab)
names(mat)<-t(namlab)
mat<-as.matrix(I(mat))
mat2<-mat  	#""を除いた行列
	if (fgnamlab==T) mat2<-mat[2:nperson,2:nperson]
	return(list(namlab,fgnamlab,mat,mat2))
}
#ここまでをコピー

• 使い方 1 検索語の指定と検索実行
  • http://twitter.com/ からあらかじめ検索して､ヒットすることを確認しておくとよい｡
  • 検索語を"　　　"の中に"この例では　masason と　RT、　　取得ページ数　指定　多分最大15ページ(ページあたり100)
  • Windowsの場合､日本語キーワードだとエラーになるようなので､ユーザー名など半角英数字で指定｡
    • ユーザー名の切り出しがうまくいかずエラーになることもあるので､別の人などでトライしてみて下さい｡
    • sdat<-searchTweet2("孫正義 RT",2)
    • sdat<-searchTweet2("ファミリーマート",2)
    • sdat<-searchTweet2("family_mart RT",2)

sdat<-searchTweet2("masason RT",2)

sText<-sdat[[1]]  #これがデータ
sText[1:5,]   #1-5番目までをみてみる
dim(sText)#いくつメッセージをとってこれたか
names(sText)#含まれる変数名を表示
#"pdate"      "user_name"  "user_rname" "user_url"   "messages"   日付､ユーザー名1　ユーザー名2　URL　メッセージ
table(substr(sText$pdate,1,10))#日付毎に集計
table(sText$user_rname)#user_rname毎に集計

#保存
save(sText,file="0sText.rda")

#上のデータから人名部分を取り出して行列を構成　　未完成だがとりあえず公開
dat<-get_from_to(sText)
sText2<-dat[[1]]  #もとのsTextに必要な情報を付加
IJdat<-dat[[2]]  #i,がjにコメントしたという形式のデータ
names(IJdat) 
#[1] "ii"       "fg.RT"    "fg.reply" "from"     "id"       "type"    
#順に　メッセージ番号　RTダミー　replyダミー､ fromからのメッセージをidが読んだ  (fromがidにメッセージを送った)
dim(IJdat)
IJdat   #まだうまく切り出せていないが､とりあえずこれで処理してみる｡
#fromがidにメッセージを送ったという形式にする
tab<-table(IJdat$from,IJdat$id)    #　iがjに送信したというやりとり行列(非対称)
dim(tab)
#これを正方行列に成形
dat<-prepmat(tab)
Mat<-dat[[3]]
  dim(Mat) #人数×人数

library(sna)
gplot(Mat) 
gplot(Mat,label=rownames(Mat)) 
degree(Mat)
gden(Mat)
save(Mat,file="0myMat.rda")#ファイル名を適宜指定して保存

• もしうまくMatができなければ､　ここからサンプル行列化データダウンロード]
• デスクトップにダウンロード｡Rの作業ディレクトリもそこを指定｡

load(file="0myMat.rda")#mac　utf8エンコードなのでWinでは文字化けするかもしれない
summary(Mat)
 dim(Mat)

#このようにMatにデータが入っているので､あとは社会ネットワーク分析ができる(はず)｡

• 下記を参照しながらなにかをしてみる｡　
• 簡単な社会ネットワーク分析　
• 回帰分析　
• 回帰分析2　
• 個人レベルでの分析　
• グループ/ブロックに分ける　
• 社会ネットワークの集計レベルでの分析