SNA_ind - Hamaoka@fbc.keio.ac.jp's home page

個人レベルでの分析

いつものように行列データを読み込む

library(sna)
load(file="0Mat.rda") 
dim(Mat)
#[1] 1067 1067　と出力されたはず　1067人×1067人の行列
m<- Mat[1:50,1:50] #一部のみとりだす
m
gplot(m,label=rownames(m))  #一部のみを社会ネットワークとして描画

入次数､出次数

#次数を計算  自分でrowSumsしなくてもsnaパッケージには定義されている
in.d<-degree(m,cmode="indegree") #入次数　その人が受けたコメントの数
out.d<-degree(m,cmode="outdegree") #出次数　その人が発したコメントの数
in.out.d<-degree(m,cmode="freeman") #入出次数　その人が受けたコメントの数
data.frame(rownames(m),in.d,out.d,in.out.d)

練習　　この値が大きい人はネットワークのどこにいるかを確認

媒介中心性　その人を介して何組のペアがつながっているか?

btw<-betweenness(m) 
btw<-data.frame(rownames(m),btw)#名前ラベルをつける
btw[order(btw$btw),]  #小さい順に並び替える

練習　　この値が大きい人はネットワークのどこにいるかを確認

情報中心性

inf<-infocent(m)
inf<-data.frame(rownames(m),inf)#名前ラベルをつける
inf[order(inf$inf),]  #小さい順に並び替える

練習　　この値が大きい人はネットワークのどこにいるかを確認

制約　constraints 構造空隙にどれくらい直面しているか?
これを計算するためのルーチン　この部分をコピー､Rにペースト

sthole2<-function(A,valued=F){
	A0<-A	#isoloateは除いたりするのでオリジナルを保存しておく
	diag(A)<-0			#対角項は意味無し
		if(valued){
			x<-max(A,na.rm=T)
				A<-A/x
				print("valued graph was normarlized")
					}
	#isolateは除く
	isolates.A<-isolates(A)

if(length(isolates.A)==dim(A)[1]) {		#すべてisolateのとき
	print("***********isolate のみ***********")
	cisolates<-as.data.frame(rownames(A0))	#それらについては名前のみ入れて各	種のものはNAにする
	cisolates$Constraint<-NA
	names(cisolates)[1]<- "memnam" 
	Index.indv<-cisolates

}else{
	if(length(isolates.A)>0){
		A<-A[-c(isolates.A),-c(isolates.A)]	#それを除いた行列
	print(paste("もとの行列の大きさ",dim(A0),"isolate",length(isolates.A),"isolateを除いた行列の大き さ",dim(A)))	

	print(isolates.A)#isolateされている者の番号

	cisolates<-as.data.frame(rownames(A0)[isolates.A])	#それらについては名前のみ入れて各	種のものは NAにする
	cisolates$Constraint<-NA
	names(cisolates)[1]<- "memnam" 
	}
#-----isolates以外について
	AtA<-A+t(A)
	dA<-AtA
	dA[AtA>0]<-1	#dychotomize	直接の結びつきがあるもののみ計算
	N.primary<-rowSums(dA)
	Saijaji<-rowSums(AtA,na.rm = T)	#Σj(aij+aji)
	mxaijaji<-apply(AtA,1,max)		#max(aij+aji)
	M<-AtA/mxaijaji
	P<-AtA/Saijaji

#結んでいる相手のみ　加算する
#Borgattiの修正式　　http://www.analytictech.com/connections/v20(1)/holes.htm
	PP<-P%*%P
	diag(PP)<-0		#としないとNAになる
#結んでいる相手のみ　加算する
	PP2<-P+PP*dA
	#dyadic constraints
	Dyadconstraint<-PP2*PP2
		diag(Dyadconstraint)<-0
	Constraint<-rowSums(Dyadconstraint,na.rm = T)
		Constraint0<-sum(Constraint)/dim(A)[1]

#各データをデータフレームに
	if(length(colnames(A))>0)  	memnam<-colnames(A) else memnam<-seq(1:dim(A)[1])
	Index.indv<-data.frame(memnam,Constraint)
	if(length(isolates.A)>0){
		Index.indv<-rbind(Index.indv,cisolates)	#isolatesについてはすべて0に
		}
}
row.names(Index.indv)<-Index.indv$memnam
#だれともつながっていないisolate　はConstraintが　NAなので　フラグをたてて､constraint2では1に
Index.indv$fg.isolete<-0
 Index.indv$fg.isolete[is.na(Index.indv$Constraint)]<-1 
Index.indv$Constraint2<-Index.indv$Constraint
Index.indv$Constraint2[is.na(Index.indv$Constraint)]<-1
return(Index.indv)
}

これを読んで計算させる

sth<-sthole2(m)
sth
#この値が小さいほど構造的空隙(ネットワークの狭間)に存在している｡だれともつながっていないisolateの場合には　欠損　NAになっている｡

練習　　この値が小さい人はネットワークのどこにいるかを確認

これらをデータフレームにまとめる

ind.dat<-data.frame(rownames(m),in.d,out.d,in.out.d,btw$btw,inf$inf,sth$Constraint,sth$Constraint2,sth$fg.isolete)
 ind.dat

#一列目の変数=idを除いてプロット
plot(  ind.dat[,-1])

#相関係数
cor(  ind.dat[,-1]) 
                       in.d       out.d    in.out.d    btw.btw     inf.inf sth.Constraint sth.Constraint2 sth.fg.isolete
in.d             1.00000000  0.97312571  0.99237569  0.6750603 0.549127231             NA     -0.04749009   -0.026908345
out.d            0.97312571  1.00000000  0.99408757  0.7837395 0.539003459             NA     -0.07977041   -0.036875830
in.out.d         0.99237569  0.99408757  1.00000000  0.7377918 0.547420571             NA     -0.06508848   -0.032425127
btw.btw          0.67506028  0.78373953  0.73779176  1.0000000 0.565035003             NA     -0.13019546   -0.172274228
inf.inf          0.54912723  0.53900346  0.54742057  0.5650350 1.000000000             NA      0.02397828    0.000601271
sth.Constraint           NA          NA          NA         NA          NA              1              NA             NA
sth.Constraint2 -0.04749009 -0.07977041 -0.06508848 -0.1301955 0.023978279             NA      1.00000000    0.296038760
sth.fg.isolete  -0.02690834 -0.03687583 -0.03242513 -0.1722742 0.000601271             NA      0.29603876    1.000000000

cor(  ind.dat[,-1],use="pair")  #欠損があるので　それについては使えるものは使って算出

                       in.d       out.d    in.out.d     btw.btw     inf.inf sth.Constraint sth.Constraint2 sth.fg.isolete
in.d             1.00000000  0.97312571  0.99237569  0.67506028 0.549127231    -0.05235129     -0.04749009   -0.026908345
out.d            0.97312571  1.00000000  0.99408757  0.78373953 0.539003459    -0.09012907     -0.07977041   -0.036875830
in.out.d         0.99237569  0.99408757  1.00000000  0.73779176 0.547420571    -0.07327064     -0.06508848   -0.032425127
btw.btw          0.67506028  0.78373953  0.73779176  1.00000000 0.565035003    -0.08548695     -0.13019546   -0.172274228
inf.inf          0.54912723  0.53900346  0.54742057  0.56503500 1.000000000     0.02927009      0.02397828    0.000601271
sth.Constraint  -0.05235129 -0.09012907 -0.07327064 -0.08548695 0.029270085     1.00000000      1.00000000             NA
sth.Constraint2 -0.04749009 -0.07977041 -0.06508848 -0.13019546 0.023978279     1.00000000      1.00000000    0.296038760
sth.fg.isolete  -0.02690834 -0.03687583 -0.03242513 -0.17227423 0.000601271             NA      0.29603876    1.000000000

#個人のダウンロード数など
load(file="0MGPdat.rda") 
names(MGPdat)
#ここでのmに含まれている人のみ
names(ind.dat)

MGPdat2<-merge( MGPdat,ind.dat,by.x="id2",by.y="rownames.m.")
MGPdat2

これに限定して回帰分析

summary(res<-lm(log(1+n_down)~btw.btw +inf.inf+sth.Constraint2+sth.fg.isolete,  MGPdat2))

練習　この結果をどう解釈するか？

#参考）ステップワイズ回帰　　説明力のあるものを順に投入していく
res.s<- step(res)
summary(res.s)

練習　上の回帰分析の結果と何が違うか？

（以下余裕があれば）練習　ここでは　mをはじめの50人に指定したが､適宜　Matから必要な部分(もしくは全体)を取り出して､同様の分析を行ってみる｡