Lec10: (Fall 2022)

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

前回の宿題+補足: app_lec09_ans

• DT package
• www subfolder
• ui

# create a sliter with the specified range
    sliderInput(inputId ="rank", 
                label ="X axis Range",
                min = 1, max =100, value=c(1,20), step=1),...

#Cf. app_pch1            
    sliderInput(inputId ="setCex", 
              label ="Marker Size (cex: character expansion)",
              min = 1, max =15, value=2, step=2)

類似度計算

• 準備
• proxyパッケージのインストール
• パッケージの読み込み
• univ頻度表の作成

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

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

proxyパッケージの読み込み

library(proxy)

ディレクトリ” univ”から出現単語行列を作成

getFreqDir関数の読み込み

source("utils3.R")

univディレクトリ内の頻度表の作成

univTable <- getFreqDir("univ")
head(univTable)

相関係数

ピアソン積率相関係数

\[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}} \]

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

tf <- getFreqDir("univ")
res <-cor(tf)
round(res,2)

        kyoto1 kyoto2 osaka1 osaka2 osaka3 osaka4 tokyo1 tokyo2 waseda1 waseda2
kyoto1    1.00   0.85   0.76   0.83   0.87   0.84   0.81   0.82    0.86    0.81
kyoto2    0.85   1.00   0.76   0.83   0.85   0.81   0.83   0.78    0.82    0.75
osaka1    0.76   0.76   1.00   0.84   0.80   0.79   0.71   0.73    0.76    0.68
osaka2    0.83   0.83   0.84   1.00   0.89   0.84   0.80   0.78    0.80    0.72
osaka3    0.87   0.85   0.80   0.89   1.00   0.88   0.84   0.80    0.81    0.75
osaka4    0.84   0.81   0.79   0.84   0.88   1.00   0.81   0.82    0.81    0.76
tokyo1    0.81   0.83   0.71   0.80   0.84   0.81   1.00   0.84    0.77    0.73
tokyo2    0.82   0.78   0.73   0.78   0.80   0.82   0.84   1.00    0.83    0.78
waseda1   0.86   0.82   0.76   0.80   0.81   0.81   0.77   0.83    1.00    0.86
waseda2   0.81   0.75   0.68   0.72   0.75   0.76   0.73   0.78    0.86    1.00

変数間の相関行列

転置（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

行と列を転置（transpose）する

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

        kyoto1 kyoto2 osaka1 osaka2 osaka3 osaka4 tokyo1 tokyo2 waseda1
kyoto2    0.85                                                         
osaka1    0.76   0.76                                                  
osaka2    0.83   0.83   0.84                                           
osaka3    0.87   0.85   0.80   0.89                                    
osaka4    0.84   0.81   0.79   0.84   0.88                             
tokyo1    0.81   0.83   0.71   0.80   0.84   0.81                      
tokyo2    0.82   0.78   0.73   0.78   0.80   0.82   0.84               
waseda1   0.86   0.82   0.76   0.80   0.81   0.81   0.77   0.83        
waseda2   0.81   0.75   0.68   0.72   0.75   0.76   0.73   0.78    0.86

変数間の相関行列（対角行列(diagonal)で結果表示）

res.corr <- simil(t(tf), diag=T)
round(res.corr, 2)

        kyoto1 kyoto2 osaka1 osaka2 osaka3 osaka4 tokyo1 tokyo2 waseda1 waseda2
kyoto1      NA                                                                 
kyoto2    0.85     NA                                                          
osaka1    0.76   0.76     NA                                                   
osaka2    0.83   0.83   0.84     NA                                            
osaka3    0.87   0.85   0.80   0.89     NA                                     
osaka4    0.84   0.81   0.79   0.84   0.88     NA                              
tokyo1    0.81   0.83   0.71   0.80   0.84   0.81     NA                       
tokyo2    0.82   0.78   0.73   0.78   0.80   0.82   0.84     NA                
waseda1   0.86   0.82   0.76   0.80   0.81   0.81   0.77   0.83      NA        
waseda2   0.81   0.75   0.68   0.72   0.75   0.76   0.73   0.78    0.86      NA

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

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

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

結果の形式：Distant Object出力

round(res.cos,2)

        kyoto1 kyoto2 osaka1 osaka2 osaka3 osaka4 tokyo1 tokyo2 waseda1
kyoto2    0.86                                                         
osaka1    0.77   0.77                                                  
osaka2    0.83   0.84   0.84                                           
osaka3    0.88   0.85   0.81   0.90                                    
osaka4    0.85   0.82   0.80   0.85   0.88                             
tokyo1    0.81   0.83   0.72   0.80   0.84   0.82                      
tokyo2    0.83   0.79   0.74   0.79   0.80   0.83   0.84               
waseda1   0.87   0.83   0.77   0.81   0.82   0.82   0.77   0.84        
waseda2   0.82   0.76   0.70   0.73   0.76   0.77   0.73   0.80    0.87

結果の形式：Matrix出力

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

        kyoto1 kyoto2 osaka1 osaka2 osaka3 osaka4 tokyo1 tokyo2 waseda1 waseda2
kyoto1    1.00   0.86   0.77   0.83   0.88   0.85   0.81   0.83    0.87    0.82
kyoto2    0.86   1.00   0.77   0.84   0.85   0.82   0.83   0.79    0.83    0.76
osaka1    0.77   0.77   1.00   0.84   0.81   0.80   0.72   0.74    0.77    0.70
osaka2    0.83   0.84   0.84   1.00   0.90   0.85   0.80   0.79    0.81    0.73
osaka3    0.88   0.85   0.81   0.90   1.00   0.88   0.84   0.80    0.82    0.76
osaka4    0.85   0.82   0.80   0.85   0.88   1.00   0.82   0.83    0.82    0.77
tokyo1    0.81   0.83   0.72   0.80   0.84   0.82   1.00   0.84    0.77    0.73
tokyo2    0.83   0.79   0.74   0.79   0.80   0.83   0.84   1.00    0.84    0.80
waseda1   0.87   0.83   0.77   0.81   0.82   0.82   0.77   0.84    1.00    0.87
waseda2   0.82   0.76   0.70   0.73   0.76   0.77   0.73   0.80    0.87    1.00

階層的クラスター分析

• 参考サイト1
• 参考サイト2

複数テキストでの単語の出現頻度の比較をする場合

相対頻度行列

relative.univTable <- getFreqDir("univ", relative=TRUE)
head(relative.univTable)

階層的クラスター分析: デフォルト値：complete法, euclidean距離))

hc <- hclust(dist(t(relative.univTable)))
plot(hc)

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

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

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

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

階層的クラスター分析: ward法 & キャンベラ距離

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

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

課題3（締め切り2023年1月11日）

“app_asgnmt3”を編集し、Zipfの理論計算値の定数AとK、ならびに、頻度数プロットマーカーのタイプをインタラクティブに変更できるように拡張しなさい。

作成例: Shiny apps Demo

UIの情報

• 定数K: 最小値=10, 最大値=100, 初期値=50
• 定数A: 最小値=0.5, 最大値=1.5, 初期値=0.8, ステップ=0.1
• プロットマーカーのタイプ: “app_pch2”の例を参考