- もしうまくとってこれなければ ここからサンプルデータダウンロード]
- デスクトップにダウンロード｡Rの作業ディレクトリもそこを指定｡
#この部分は上記のサンプルファイルを使うときのみ実行
load(file="0sText.rda")#mac utf8エンコードなのでWinでは文字化けするかもしれない｡
#エラーが出る場合､ダウンロードのとき､勝手に拡張子をつけたり､つけているが見えなくしているかもしれない
summary(sText)
dim(sText)
- まずは処理のためのサブルーチンをコピー､ペースとして定義する｡(まだまだ不完全)
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))
}
#ここまでをコピー
dim(sText) #データのレコード数などをみる
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))
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にデータが入っているので､あとは社会ネットワーク分析ができる(はず)｡