Lec11: (Fall 2024)

Lecture11: ネットワーク描画

実習内容

Lecture09で作成したTF-IDF重みづけ単語文書行列を利用して、記事ID-単語ペア情報の作成し、その結果をネットワーク（グラフ図）として描画する

参考資料

• igraph package
• networkD3 package
• networkD3@github

パッケージのインストール

install.packages("igraph", dependencies = TRUE)
install.packages("networkD3", dependencies = TRUE)

パッケージの読み込み

library(igraph)
library(networkD3)

オンライン記事のTerm-Document Matrixの作成（cf. Lecture09）

自作関数ファイルの読み込み

source("func4lec09.R")

分析テキストURL

article_urls <- c()
article_urls <- readLines("Lec09_ArticleURL_info")

Term-Document Matrixの作成

contents <- lapply(article_urls, getArticleContent)
tmMtx <- getDocumentTermMTX(contents, term="lemma")

Processed document 10 of 12

相対頻度行列 (frequency per thousand)

relative_tmMtx <- sweep(tmMtx, MARGIN = 2, colSums(tmMtx), FUN = "/")*1000

文書単語行列(相対頻度 & TF-IDF)

文書頻度(Dcument Frequency:DF)

DF<-apply(tmMtx, 1, function(x) length(x[x>0]))

文書数

(N<-ncol(tmMtx))

[1] 12

TF-IDF

\[w=tf*log(\frac{N}{df}) \]

relative_tfidf <- relative_tmMtx*(log(N/DF))

全テキストの上位15最頻単語の抽出

記事ID: 3

id = 3
min.freq = 0
top_Num = 15
(top_rowSum <-sort(rowSums(relative_tfidf),decreasing=TRUE)[1:top_Num])

       he   Okayama Leicester    Ishiba    cancer intestine     Miura       yen     party 
 97.96557  73.90057  64.71111  58.23182  57.12429  57.12429  54.41401  53.00304  51.86325 
    Osaka      item      they      gene  building    League 
 51.53079  50.16594  49.31568  47.60358  44.65349  42.73060 

記事ID-単語ペア情報の作成

記事ID: 3

tfidfMtx.topNum<-relative_tfidf[rownames(relative_tfidf) %in% names(top_rowSum),]
tfidfMtx.topNum

tmp_freq <- tfidfMtx.topNum[tfidfMtx.topNum[id]>min.freq,][,id]
tmp_wordLst <- rownames(tfidfMtx.topNum[tfidfMtx.topNum[id]>min.freq,])
article_id<-rep(colnames(tfidfMtx.topNum)[id],length(tmp_wordLst))
cbind(article_id, tmp_wordLst, tmp_freq)

     article_id tmp_wordLst tmp_freq          
[1,] "3"        "he"        "46.691665992208" 
[2,] "3"        "Ishiba"    "46.2098120373297"
[3,] "3"        "party"     "18.4839248149319"

記事ID-単語ペア情報の作成

12記事

pairs <- c()
for(i in 1:12){
  Freq <- tfidfMtx.topNum[tfidfMtx.topNum[i]>min.freq,][,i]
  Term <- rownames(tfidfMtx.topNum[tfidfMtx.topNum[i]>min.freq,])
  ArticleId<-rep(colnames(tfidfMtx.topNum)[i],length(Term))
  pairs <- rbind(pairs,cbind(ArticleId, Term, Freq))
}
length(pairs)

[1] 108

Viewで確認

View(pairs)

ネットワーク描画

igraphで描画

wng<-as.undirected(graph.data.frame(pairs))
plot(wng)

ノード(node)の大きさを調整

• ノードの大きさ: degree(次数）

wng<-as.undirected(graph.data.frame(pairs))
deg<-degree(wng)
plot(wng, vertex.size=20*(deg/max(deg)))

エッジ幅（重みづけ値）とノードの大きさを調整

wng<-as.undirected(graph.data.frame(pairs))
deg<-degree(wng)
E(wng)$weight<-as.numeric(as.numeric(pairs[,3]))
plot(wng, vertex.size=20*(deg/max(deg)), edge.width=10*E(wng)$weight/max(E(wng)$weight))

ノードの形状と色を変更

#Set default shape & color
V(wng)$shape <- "circle"
V(wng)$color <- "orange"

#Set default shape & color for the first 12 nodes, or article IDs
V(wng)$shape[1:12] <- "square" 
V(wng)$color[1:12] <- "lightblue"

plot(wng)

networkD3形式に変換

network_d3_format <- igraph_to_networkD3(wng)
network_d3_format$nodes$group <- 1

ネットワーク描画

forceNetwork(Links = network_d3_format$links, Nodes = network_d3_format$nodes, 
             Source = 'source', Target = 'target', 
             NodeID = 'name', Group = 'group', fontSize = 14)