Lec11: (Fall 2023)

Lecture11: 類似度計算, 階層的クラスター分析

分析テキスト

• AJ1: Al Jazeera, Dog meat
• AJ2: Al Jazeera, G7
• AJ3: Al Jazeera, JAL collision
• BBC1: BBC, Dog meat
• BBC2: BBC, G7
• BBC2: BBC, JAL collision
• JT1: Japan Times, Dog meat
• JT2: Japan Times, G7
• JT3: Japan Times, JAL collision

Term-Document Matrixの作成

指定ディレクトリのファイル一覧を取得(相対パス)

dirName <-"news_articles"
(files<- list.files(dirName))

[1] "AJ1.txt"  "AJ2.txt"  "AJ3.txt"  "BBC1.txt" "BBC2.txt"
[6] "BBC3.txt" "JT1.txt"  "JT2.txt"  "JT3.txt" 

filesDir <- unlist(lapply(dirName, paste, files, sep = "/"))
filesDir[1]

[1] "news_articles/AJ1.txt"

要素結合用関数の作成

join_Lines <- function(fnaame) {
  txt <- readLines(fnaame)
  txt <- tolower(txt)
  txt<- txt[txt != ""]
  paste(txt, collapse = " ")
}

複数テキストファイルへの一括処理

library(magrittr)
lapply(filesDir, join_Lines) %>% unlist -> news_txtset

cleanNLPライブラリの読み込み & 言語モデルの設定

library(cleanNLP)
cnlp_init_udpipe()#言語モデルの設定（デフォルト値=英語）

形態素解析: cnlp_annotate関数

res <- cnlp_annotate(input = news_txtset)
res <- res$token[!res$token$upos %in% c("PUNCT","SYM","NUM"),]#句読点,記号,数字を除外

View

View(res)

文書行列(Term-Document Matrix)

docMtx <- as.data.frame.matrix(table(res$lemma, res$doc_id))
#docMtx <- as.data.frame.matrix(table(res$token, res$doc_id))
files %>% strsplit(".txt") %>% unlist -> colnames(docMtx)#列名の変更

docMtxのサイズ確認

dim(docMtx)

[1] 1209    9

View

View(docMtx)

部分表示

head(docMtx)

相対頻度行列

• sweep関数の利用

colSums(docMtx)#Tokens

 AJ1  AJ2  AJ3 BBC1 BBC2 BBC3  JT1  JT2  JT3 
 428  389  697  658  405  561  464  621  381 

#docMtx/colSums(docMtx)#It doesn't work well
relative_docMtx<-sweep(docMtx, MARGIN = 2, colSums(docMtx), FUN = "/")

文書頻度(Dcument Frequency:DF)による条件抽出

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

-escalate     -hama      -one        's       ’re         & 
        1         1         1         9         1         1 

文書頻度(Dcument Frequency:DF)による条件抽出

DF値が5-8の行を抽出した例

docMtx_c5 <- relative_docMtx[(DF>4 & DF<9), ] #5-8DF

docMtx_c5のサイズ確認

dim(docMtx_c5)

[1] 51  9

View

View(docMtx_c5)

類似度計算

相関係数

ピアソン積率相関係数

\[Corr(x,y)= \frac{\sum (x_{i}-\overline{x}) (y_{i}-\overline{y})}{\sqrt{\sum (x_{i}-\overline{x})^2\sum (y_{i}-\overline{y})^2}} \]

相関係数行列（テキスト間）

res <-cor(docMtx_c5)
round(res,2)

      AJ1   AJ2  AJ3  BBC1 BBC2 BBC3   JT1   JT2   JT3
AJ1  1.00  0.24 0.22  0.46 0.48 0.12  0.55  0.20  0.05
AJ2  0.24  1.00 0.25  0.38 0.55 0.51  0.19  0.51 -0.03
AJ3  0.22  0.25 1.00  0.30 0.44 0.31  0.11  0.37  0.06
BBC1 0.46  0.38 0.30  1.00 0.45 0.31  0.55  0.10 -0.16
BBC2 0.48  0.55 0.44  0.45 1.00 0.30  0.27  0.52  0.08
BBC3 0.12  0.51 0.31  0.31 0.30 1.00  0.16  0.15  0.00
JT1  0.55  0.19 0.11  0.55 0.27 0.16  1.00 -0.01  0.08
JT2  0.20  0.51 0.37  0.10 0.52 0.15 -0.01  1.00  0.34
JT3  0.05 -0.03 0.06 -0.16 0.08 0.00  0.08  0.34  1.00

相関係数行列（単語間）

res_term <-cor(t(docMtx_c5))

View

View(res_term)

変数間の相関行列

転置（transpose）: t関数

testMtx <- matrix(1:6, nrow=3)
testMtx

     [,1] [,2]
[1,]    1    4
[2,]    2    5
[3,]    3    6

# transpose
t(testMtx)

     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    4    5    6

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

install.packages("proxy", dependencies = TRUE)

proxyパッケージの読み込み

library(proxy)

simil関数による相関係数行列（テキスト間）

行と列を転置（transpose）する

corr <- simil(t(docMtx_c5))
round(corr, 2)

       AJ1   AJ2   AJ3  BBC1  BBC2  BBC3   JT1   JT2
AJ2   0.24                                          
AJ3   0.22  0.25                                    
BBC1  0.46  0.38  0.30                              
BBC2  0.48  0.55  0.44  0.45                        
BBC3  0.12  0.51  0.31  0.31  0.30                  
JT1   0.55  0.19  0.11  0.55  0.27  0.16            
JT2   0.20  0.51  0.37  0.10  0.52  0.15 -0.01      
JT3   0.05 -0.03  0.06 -0.16  0.08  0.00  0.08  0.34

テキスト間のコサイン類似度

\[Cos(x,y)= \frac{\sum x_{i} y_{i}}{\sqrt{\sum x_{i}^2\sum y_{i}^2}} \]

res.cos <-simil(t(docMtx_c5), method="cosine")

結果の形式：Distant Object出力

round(res.cos,2)

      AJ1  AJ2  AJ3 BBC1 BBC2 BBC3  JT1  JT2
AJ2  0.53                                   
AJ3  0.53 0.55                              
BBC1 0.68 0.62 0.59                         
BBC2 0.70 0.73 0.68 0.68                    
BBC3 0.47 0.70 0.59 0.59 0.59               
JT1  0.76 0.57 0.56 0.76 0.65 0.57          
JT2  0.53 0.71 0.64 0.48 0.73 0.50 0.51     
JT3  0.40 0.35 0.42 0.28 0.44 0.37 0.50 0.59

結果の形式：Matrix出力

res2.cos<-simil(t(docMtx_c5), method="cosine", diag=T)
res2.cos<-as.matrix(res2.cos)
res2.cos[is.na(res2.cos)] <- 1
round(res2.cos,2)

      AJ1  AJ2  AJ3 BBC1 BBC2 BBC3  JT1  JT2  JT3
AJ1  1.00 0.53 0.53 0.68 0.70 0.47 0.76 0.53 0.40
AJ2  0.53 1.00 0.55 0.62 0.73 0.70 0.57 0.71 0.35
AJ3  0.53 0.55 1.00 0.59 0.68 0.59 0.56 0.64 0.42
BBC1 0.68 0.62 0.59 1.00 0.68 0.59 0.76 0.48 0.28
BBC2 0.70 0.73 0.68 0.68 1.00 0.59 0.65 0.73 0.44
BBC3 0.47 0.70 0.59 0.59 0.59 1.00 0.57 0.50 0.37
JT1  0.76 0.57 0.56 0.76 0.65 0.57 1.00 0.51 0.50
JT2  0.53 0.71 0.64 0.48 0.73 0.50 0.51 1.00 0.59
JT3  0.40 0.35 0.42 0.28 0.44 0.37 0.50 0.59 1.00

階層的クラスター分析

• 参考サイト1: 階層的クラスター分析
• 参考サイト2: 距離行列

文書間の距離を測る（euclidean距離）

dist.euclidean <- dist(t(docMtx_c5))
dist.euclidean <- as.matrix(dist.euclidean)
round(dist.euclidean,3)

       AJ1   AJ2   AJ3  BBC1  BBC2  BBC3   JT1   JT2   JT3
AJ1  0.000 0.029 0.030 0.028 0.024 0.032 0.020 0.031 0.030
AJ2  0.029 0.000 0.029 0.030 0.023 0.024 0.026 0.025 0.031
AJ3  0.030 0.029 0.000 0.031 0.025 0.028 0.027 0.028 0.030
BBC1 0.028 0.030 0.031 0.000 0.028 0.031 0.024 0.036 0.038
BBC2 0.024 0.023 0.025 0.028 0.000 0.028 0.025 0.024 0.030
BBC3 0.032 0.024 0.028 0.031 0.028 0.000 0.027 0.032 0.032
JT1  0.020 0.026 0.027 0.024 0.025 0.027 0.000 0.030 0.025
JT2  0.031 0.025 0.028 0.036 0.024 0.032 0.030 0.000 0.027
JT3  0.030 0.031 0.030 0.038 0.030 0.032 0.025 0.027 0.000

階層的クラスター分析: euclidean距離 & ward法

hc <- hclust(dist(t(docMtx_c5)), method = "ward.D2")
plot(hc)

#rect.hclust(hc, k=3, border="red")

階層的クラスター分析: canberra距離 & ward法

hc <- hclust(dist(t(docMtx_c5), method = "canberra"), method = "ward.D2")
plot(hc)

#rect.hclust(hc, k=3, border="red")

単語間の階層的クラスター分析: euclidean距離 & ward法

hc <- hclust(dist(docMtx_c5), method = "ward.D2")
plot(hc)

#rect.hclust(hc, k=3, border="red")

単語間の階層的クラスター分析: canberra距離 & ward法

hc <- hclust(dist(docMtx_c5, method = "canberra"), method = "ward.D2")
plot(hc)

#rect.hclust(hc, k=3, border="red")

課題2（締め切り2024年1月25日）

“app_asgnmt2”を編集して、Task1,2に取り組んでください。

Task1: hclustとrect.hclustの表示したTabを追加しなさい。

Task2: 次の２つの変数をスライダー(sliderInput)でインタラクティブに変更できるように拡張しなさい。
(1) Document Frequencyの最低値
(2) rect.hclust関数の引数kの値
スライダーの値の範囲: min=2, max =7, value=4, step=1

補足: htmltoolsアップデート対応

> runApp('app_assignmt')
Error: package or namespace load failed for ‘DT’ in loadNamespace(i, c(lib.loc, .libPaths()), versionCheck = vI[[i]]):
 namespace ‘htmltools’ 0.5.6 is already loaded, but >= 0.5.7 is required
In addition: Warning message:
In unloadNamespace(package) :
  namespace ‘htmltools’ is imported by ‘rmarkdown’, ‘shiny’ so cannot be unloaded

install.packages("htmltools")