思い付き: 同じ意味カテゴリに属しそうな語をいくつか取り出して、それがベクトル空間内でどういう形になるかに興味がある。
具体的には、平面になってほしいような気がしている。
そこで、主成分分析をして、次元数が1つかせいぜい2つぐらいにならないか見てみる。
まずpythonでベクトルを書き出して、それをRに読ませて主成分分析(なり何なり)をする
#!/usr/bin/env python # -*- coding: utf-8 -*- import gensim, logging import sys import string, codecs import numpy as np import math sys.stdout = codecs.getwriter('utf_8')(sys.stdout) argvs = sys.argv; argc = len(argvs) logging.basicConfig(format='%(asctime)s : %(levelname)s : %(message)s', level=logging.INFO) model = gensim.models.word2vec.Word2Vec.load("jpw-wakati-model") # looking at the "model" to be a dictionary # 全ボキャブラリを対象に単語ベクトルを出力したいならば # voc = model.vocab.keys() # 対象語をファイルから読み込む voc = codecs.open(argvs[1], 'r', encoding='utf-8').read().split() outf = codecs.open(argvs[1]+'.out', 'w', encoding='utf-8') for x in voc: try: wvec = model[x] except KeyError: print x, u'を無視します' outf.write('"' + x + '"' + ', ' ) c = 0 for v in wvec: if c==0: outf.write(str(v)) else: outf.write(', '+str(v)) c += 1 outf.write('\n') outf.close()
あらかじめ単語リストファイル list-fruit.txt を用意しておく。
リンゴ バナナ ミカン イチゴ メロン カキ ブドウ グレープフルーツ
これを、上記プログラムで処理する。
python readvecs.py
出力ファイル list-fruit.out が生成される。
これを R に読み込み、主成分分析処理を行う。prcompを用いscaingをTRUEとした[Rのprcomp()関数で主成分分析をするときの注意点]。
> w1 <- read.csv('list-fruit.txt.out', header=FALSE, row.names=1) > w2 <- prcomp(w1, scaling=TRUE) > summary(w2) Importance of components: PC1 PC2 PC3 PC4 PC5 PC6 PC7 Standard deviation 0.9070 0.7501 0.5742 0.4973 0.40887 0.37208 0.29335 Proportion of Variance 0.3495 0.2390 0.1401 0.1051 0.07102 0.05882 0.03656 Cumulative Proportion 0.3495 0.5885 0.7286 0.8336 0.90462 0.96344 1.00000 PC8 Standard deviation 2.431e-16 Proportion of Variance 0.000e+00 Cumulative Proportion 1.000e+00
同様に、都市リストのデータ list-city.txt を
東京 大阪 京都 仙台 札幌 盛岡 金沢 静岡 広島 福岡 長崎 鹿児島
とし、同じ処理
python readvecs.py list-city.txt
を行うと、出力ファイル list-city.out を得る。同様にRにて主成分分析すると、
> w1 <- read.csv('list-city.out', header=FALSE, row.names=1) > w2 <- prcomp(w1, scaling=TRUE) > summary(w2) Importance of components: PC1 PC2 PC3 PC4 PC5 PC6 PC7 Standard deviation 1.0001 0.6822 0.5848 0.50667 0.43939 0.34185 0.3006 Proportion of Variance 0.3685 0.1715 0.1260 0.09458 0.07113 0.04306 0.0333 Cumulative Proportion 0.3685 0.5400 0.6660 0.76056 0.83169 0.87475 0.9080 PC8 PC9 PC10 PC11 PC12 Standard deviation 0.27398 0.26865 0.24615 0.20435 2.613e-16 Proportion of Variance 0.02766 0.02659 0.02232 0.01539 0.000e+00 Cumulative Proportion 0.93570 0.96229 0.98461 1.00000 1.000e+00
さらに同様に、動物のリスト list-mammal.txt を
イヌ ネコ ウシ ブタ サル ゾウ シカ ウマ カバ クマ ウサギ ネズミ トラ イタチ
とし、同じ処理
python readvecs.py list-mammal.txt
を行うと、出力 list-mammal.out を得る。これをRにて主成分分析すると、
> m1 <- read.csv('list-mammal.out', header=FALSE, row.names=1) > m2 <- prcomp(m1, scaling=FALSE) > summary(m2) Importance of components: PC1 PC2 PC3 PC4 PC5 PC6 PC7 Standard deviation 0.6970 0.5569 0.5103 0.4810 0.40739 0.33854 0.31129 Proportion of Variance 0.2433 0.1553 0.1304 0.1158 0.08311 0.05739 0.04853 Cumulative Proportion 0.2433 0.3986 0.5290 0.6448 0.72795 0.78534 0.83386 PC8 PC9 PC10 PC11 PC12 PC13 Standard deviation 0.29464 0.25713 0.24042 0.23252 0.19974 0.16455 Proportion of Variance 0.04347 0.03311 0.02894 0.02707 0.01998 0.01356 Cumulative Proportion 0.87734 0.91044 0.93939 0.96646 0.98644 1.00000 PC14 Standard deviation 1.625e-16 Proportion of Variance 0.000e+00 Cumulative Proportion 1.000e+00
が得られた。
これらを眺め渡すのに、まずは累積寄与率 Cumulative Proportion を並べてみると、
PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11 PC12 PC13 PC14 果物 0.3495 0.5885 0.7286 0.8336 0.90462 0.96344 1.00000 1.000e+00 都市 0.3685 0.5400 0.6660 0.76056 0.83169 0.87475 0.9080 0.93570 0.96229 0.98461 1.00000 1.000e+00 動物 0.2433 0.3986 0.5290 0.6448 0.72795 0.78534 0.83386 0.87734 0.91044 0.93939 0.96646 0.98644 1.00000 1.000e+00
これをグラフに書いてみよう。上記寄与率データをファイル list-list.txt に作っておき、Rでこんなスクリプトを作ってみた。
x <- read.table('list-list.txt', colClasses=c("character", rep("numeric",14))) pchs = c(15,16,17) par(pch=pchs[1]) plot(as.numeric(x[1,]),xlim=c(1,14),ylim=c(0,1),xlab='',ylab='',type='o') par(new=T) par(pch=pchs[2]) plot(as.numeric(x[2,]),xlim=c(1,14),ylim=c(0,1),xlab='',ylab='',type='o') par(new=T) par(pch=pchs[3]) plot(as.numeric(x[3,]),xlim=c(1,14),ylim=c(0,1),xlab='# of dims',ylab='cumulative proportion',type='o') labels <- rownames(x) legend("topleft", legend = labels, pch = pchs)
この結果だと、同じカテゴリに属する単語を選んだのだが、それが単語ベクトル空間内での平面もしくは薄い平面になるような、(線形結合による)次元圧縮はできなかった。
語群として
リンゴ バナナ ミカン イチゴ メロン イヌ ネコ ウシ ブタ サル ゾウ
を取る。前半が果物、後半が動物、いずれも5語ずつとした。
これに対して、語ベクトルを取り (list-fru-mam-out.txt) クラスタリングを試みる。
> f1 <- read.csv('list-fru-mam.out', header=FALSE, row.names=1) > fd1 <- dist(f1) > fd1 リンゴ バナナ ミカン イチゴ メロン イヌ ネコ ウシ ブタ サル バナナ 1.970062 ミカン 1.790549 2.511023 イチゴ 1.438550 2.063315 1.501940 メロン 1.773539 2.211781 2.349659 1.837267 イヌ 2.145225 2.680048 2.105527 2.218265 2.679541 ネコ 2.006368 2.360916 2.290100 2.193245 2.568588 1.443856 ウシ 2.755805 3.131311 2.091293 2.481934 3.203987 2.114679 2.557964 ブタ 1.784726 2.219938 2.177678 1.930415 2.390244 1.359422 1.236227 2.329943 サル 1.868444 2.040648 2.201255 2.124999 2.164924 1.925178 1.626010 2.526037 1.613498 ゾウ 2.262009 2.446191 2.215216 2.186955 2.487413 1.794068 1.571855 2.237841 1.499698 1.601881 > fk <- hclust(fd1, method="ward.D2") > plot(fk)
k-means法でクラスタ数=2とすると、
> fkm <- kmeans(fd1, centers=2) > fkm K-means clustering with 2 clusters of sizes 6, 5 Cluster means: リンゴ バナナ ミカン イチゴ メロン イヌ ネコ ウシ 1 2.137096 2.479842 2.180178 2.189302 2.582449 1.439534 1.405985 1.961077 2 1.394540 1.751236 1.630634 1.368214 1.634449 2.365721 2.283844 2.732866 ブタ サル ゾウ 1 1.339798 1.548767 1.450890 2 2.100600 2.080054 2.319557 Clustering vector: リンゴ バナナ ミカン イチゴ メロン イヌ ネコ ウシ ブタ サル ゾウ 2 2 2 2 2 1 1 1 1 1 1 Within cluster sum of squares by cluster: [1] 22.49424 18.49027 (between_SS / total_SS = 31.1 %)
となって、動物と果物の2つのクラスタに分かれた。
> fc1 <- read.csv('list-fru-mam-city.out', header=FALSE, row.names=1) > fcd1 <- dist(fc1) > fcd1 リンゴ バナナ ミカン イチゴ メロン イヌ ネコ ウシ ブタ サル ゾウ 東京 大阪 京都 仙台 バナナ 1.970062 ミカン 1.790549 2.511023 イチゴ 1.438550 2.063315 1.501940 メロン 1.773539 2.211781 2.349659 1.837267 イヌ 2.145225 2.680048 2.105527 2.218265 2.679541 ネコ 2.006368 2.360916 2.290100 2.193245 2.568588 1.443856 ウシ 2.755805 3.131311 2.091293 2.481934 3.203987 2.114679 2.557964 ブタ 1.784726 2.219938 2.177678 1.930415 2.390244 1.359422 1.236227 2.329943 サル 1.868444 2.040648 2.201255 2.124999 2.164924 1.925178 1.626010 2.526037 1.613498 ゾウ 2.262009 2.446191 2.215216 2.186955 2.487413 1.794068 1.571855 2.237841 1.499698 1.601881 東京 3.424360 3.638329 3.806821 3.663877 3.098019 3.586443 3.376725 4.459185 3.433395 3.174265 3.480218 大阪 3.346723 3.395097 3.701793 3.555570 3.116262 3.534008 3.324191 4.300704 3.361214 3.159386 3.468155 2.063095 京都 3.734754 3.862700 4.068500 3.920570 3.631977 3.824423 3.736952 4.549313 3.751813 3.479855 3.846242 2.241960 2.141106 仙台 3.299348 3.614781 3.705851 3.539363 3.350149 3.491068 3.260330 4.101234 3.365073 3.205548 3.518331 2.645173 2.112040 2.766430 札幌 3.221615 3.495529 3.559657 3.454006 3.157557 3.431812 3.206204 4.039476 3.299149 3.103612 3.328526 2.368928 2.040717 2.834629 1.725378 > fck <- hclust(fcd1, method="ward.D2") > plot(fck)
k-means法で、クラスタ数=3として処理すると、
> fckm <- kmeans(fcd1, centers=3) > fckm K-means clustering with 3 clusters of sizes 5, 5, 6 Cluster means: リンゴ バナナ ミカン イチゴ メロン イヌ ネコ ウシ 1 3.405360 3.601287 3.768524 3.626677 3.270793 3.573551 3.380880 4.289982 2 1.394540 1.751236 1.630634 1.368214 1.634449 2.365721 2.283844 2.732866 3 2.137096 2.479842 2.180178 2.189302 2.582449 1.439534 1.405985 1.961077 ブタ サル ゾウ 東京 大阪 京都 仙台 札幌 1 3.442129 3.224533 3.528294 1.863831 1.671392 1.996825 1.849804 1.793930 2 2.100600 2.080054 2.319557 3.526281 3.423089 3.843700 3.501898 3.377673 3 1.339798 1.548767 1.450890 3.585038 3.524610 3.864766 3.490264 3.401463 Clustering vector: リンゴ バナナ ミカン イチゴ メロン イヌ ネコ ウシ ブタ サル ゾウ 2 2 2 2 2 3 3 3 3 3 3 東京 大阪 京都 仙台 札幌 1 1 1 1 1 Within cluster sum of squares by cluster: [1] 24.64086 19.34918 26.03245 (between_SS / total_SS = 71.1 %)
のように、3つのクラスタに分かれた。
西尾氏の本の第5章に従うと、「国と首都」のような、語間での関係を、並べてみる必要があるらしい。つまり、同じカテゴリーのものを集めても、その間の関係はよく見えてこない(=次元圧縮できない)。むしろ、日本と東京、ロシアとモスクワ、といった語の間の関係が、語ベクトル間の差分(〜距離)ベクトルの関係(類似性)として出てくる、という議論らしい。
試してみたい。
西尾氏の本の5章の図5-2でやっているのは、語ペアの間の距離として数値(スカラ)の距離を見るだけではなく(これはもともとのword2vecの実験で多数されている)、 語ベクトル空間内での語ペアの位置関係を、主成分分析で次元圧縮しているようである。
ファイル list-capital.txt
東京 日本 ロシア モスクワ 中国 北京 トルコ アンカラ ポーランド ワルシャワ ドイツ ベルリン フランス パリ イタリア ローマ ギリシャ アテネ スペイン マドリード ポルトガル リスボン
を用意し、それぞれの語ベクトルを readvecs で取り出す。
python readvecs.py list-capital.txt
生成された語ベクトルのファイルは list-capital.out に格納される。
これをRを使って主成分分析すると、
> w1 <- read.csv('list-capital.out', header=FALSE, row.names=1) > w2 <- prcomp(w1, scaling=TRUE) > summary(w2) Importance of components: PC1 PC2 PC3 PC4 PC5 PC6 PC7 Standard deviation 0.8322 0.7666 0.5991 0.45433 0.43011 0.41188 0.34593 Proportion of Variance 0.2443 0.2073 0.1266 0.07282 0.06526 0.05985 0.04222 Cumulative Proportion 0.2443 0.4516 0.5783 0.65108 0.71634 0.77619 0.81841 PC8 PC9 PC10 PC11 PC12 PC13 PC14 Standard deviation 0.29572 0.27079 0.25856 0.23029 0.21238 0.18681 0.17795 Proportion of Variance 0.03085 0.02587 0.02358 0.01871 0.01591 0.01231 0.01117 Cumulative Proportion 0.84926 0.87513 0.89871 0.91742 0.93333 0.94564 0.95682 PC15 PC16 PC17 PC18 PC19 PC20 PC21 Standard deviation 0.17483 0.14279 0.13705 0.13309 0.12062 0.10692 0.09475 Proportion of Variance 0.01078 0.00719 0.00663 0.00625 0.00513 0.00403 0.00317 Cumulative Proportion 0.96760 0.97479 0.98142 0.98767 0.99280 0.99683 1.00000 PC22 Standard deviation 1.646e-16 Proportion of Variance 0.000e+00 Cumulative Proportion 1.000e+00 > plot(w2$x, type="n") > text(w2$x, rownames(w1))
次に、語ベクトル空間上での語間の差分ベクトルを計算し、その差分ベクトルに対して主成分分析をしてみる。差分ベクトルは同じ次元内にあるのではないか、という問である。
差分を計算するために、vecdiff.py を作成した。
#!/usr/bin/env python # -*- coding: utf-8 -*- # vecdiff.py # import sys, string, codecs import numpy as np import math sys.stdout = codecs.getwriter('utf_8')(sys.stdout) argvs = sys.argv; argc = len(argvs) # ベクトルをファイルから読み込む #wl = codecs.open("testvec.dat", 'r', encoding='utf-8').readlines() #for l in wl: # print l # for x in l.split(','): # print x infname = argvs[1] fname = infname.split('.')[0] data = np.loadtxt(infname, delimiter=',', dtype=object) outfname = fname + '.diff' outf = codecs.open(outfname, 'w', encoding='utf-8') maxitem = len(data[:,0]) for x in range(0,maxitem): for y in range(0,x): if (x!=y): diff = data[x,1:].astype(float) - data[y,1:].astype(float) #print diff #outf.write(str(('"'+data[x,0].decode('utf-8').strip('"')+'-'+data[y,0].decode('utf-8').strip('"')+'" '))) outf.write(('"'+data[x,0].decode('utf-8').strip('"')[0:2]+'-'+data[y,0].decode('utf-8').strip('"')[0:2]+'" ')) for u in range(0,len(data[0,:])-1): outf.write(',' + str(diff[u]) + ' ') outf.write(str('\n'))
これを用いて、
python vecdiff.py list-capital.out
として、list-capital.outに含まれる語ベクトルから、(すべての組合せについて)差分ベクトルを生成する。全部の組合せについて差分ベクトルを作ったものを list-capital.diff に置き、そこから、正しい国名−首都のペアになったエントリーだけを抜き出したものを、
list-capital-paired.diff に置く。
まず、list-capital-pairad.diff を、前と同じように主成分分析する。
> d1 <- read.csv('list-capital-paired.diff', header=FALSE, row.names=1) > d2 <- prcomp(d1, scaling=TRUE) > summary(d2) Importance of components: PC1 PC2 PC3 PC4 PC5 PC6 PC7 Standard deviation 0.8910 0.7424 0.6094 0.5435 0.52773 0.41172 0.39639 Proportion of Variance 0.2762 0.1918 0.1292 0.1028 0.09689 0.05898 0.05467 Cumulative Proportion 0.2762 0.4680 0.5972 0.6999 0.79683 0.85581 0.91047 PC8 PC9 PC10 PC11 Standard deviation 0.31055 0.31016 0.2543 2.092e-16 Proportion of Variance 0.03355 0.03347 0.0225 0.000e+00 Cumulative Proportion 0.94403 0.97750 1.0000 1.000e+00 > plot(d2$x, type="n") > text(d2$x, rownames(d1))
イタリア・ローマの関係はかなり外れており、日本・東京とギリシャ・アテネが多少外れているが、その他は割と集まっている感じがする。差分ベクトル間の距離(距離行列)を、R上でdist(d1) により計算すると
> dd1 <- dist(d1) > dd1 日本・東京 ソ・モス 中国・北京 トル・アン ポー・ワル ドイ・ベル フラ・パリ イタ・ロー ギリ・アテ スペ・マド ソ・モス 2.351636 中国・北京 2.921458 1.847766 トル・アン 2.632693 1.665206 1.851017 ポー・ワル 2.534892 1.698815 2.175155 1.977977 ドイ・ベル 2.581418 1.473037 2.075114 1.808661 1.644332 フラ・パリ 2.504862 1.614954 1.916339 2.010471 1.730841 1.452563 イタ・ロー 3.169835 2.634452 3.094171 2.689891 2.887835 2.676715 2.661344 ギリ・アテ 3.704089 2.401050 2.273844 2.834751 2.814918 2.325160 2.326286 3.573224 スペ・マド 2.902570 1.940497 2.565212 2.351040 2.125049 2.308997 2.181794 3.141020 2.946346 ポル・リス 2.712275 1.774076 2.118614 2.114721 1.581006 1.644635 1.947070 3.004948 2.481797 2.259865
差分ベクトルをクラスタ化してみる。k-means法で、上記の観察からクラスタ数=3とすると、
> dk <- kmeans(dd1, centers=3) > dk K-means clustering with 3 clusters of sizes 2, 8, 1 Cluster means: 日本・東京 ソ・モス 中国・北京 トル・アン ポー・ワル ドイ・ベル 1 1.584917 2.493044 3.007815 2.661292 2.711363 2.629066 2 2.642725 1.501794 1.818652 1.722387 1.616647 1.550917 3 3.704089 2.401050 2.273844 2.834751 2.814918 2.325160 フラ・パリ イタ・ロー ギリ・アテ スペ・マド ポル・リス 1 2.583103 1.584917 3.638657 3.021795 2.858611 2 1.606754 2.848797 2.550519 1.966557 1.679998 3 2.326286 3.573224 0.000000 2.946346 2.481797 日本・東京 ソ・モス 中国・北京 トル・アン ポー・ワル ドイ・ベル 1 2 2 2 2 2 フラ・パリ イタ・ロー ギリ・アテ スペ・マド ポル・リス 2 1 3 2 2
となり、3つのクラスタ
[(日本・東京)、(イタリア・ローマ)]
[(ソ連・モスクワ)、(中国・北京)、(トルコ・アンカラ)、(ポーランド・ワルシャワ)、(ドイツ・ベルリン)、(フランス・パリ)、(スペイン・マドリード)、(ポルトガル・リスボン)]
[(ギリシャ・アテネ)]
を得た。
またクラスタ数を4とすると、(図を見て4カ所に分かれるので)
> dk4 <- kmeans(dd1, centers=4) > dk4 K-means clustering with 4 clusters of sizes 1, 1, 1, 8 Cluster means: 日本・東京 ソ・モス 中国・北京 トル・アン ポー・ワル ドイ・ベル 1 3.704089 2.401050 2.273844 2.834751 2.814918 2.325160 2 0.000000 2.351636 2.921458 2.632693 2.534892 2.581418 3 3.169835 2.634452 3.094171 2.689891 2.887835 2.676715 4 2.642725 1.501794 1.818652 1.722387 1.616647 1.550917 フラ・パリ イタ・ロー ギリ・アテ スペ・マド ポル・リス 1 2.326286 3.573224 0.000000 2.946346 2.481797 2 2.504862 3.169835 3.704089 2.902570 2.712275 3 2.661344 0.000000 3.573224 3.141020 3.004948 4 1.606754 2.848797 2.550519 1.966557 1.679998 Clustering vector: 日本・東京 ソ・モス 中国・北京 トル・アン ポー・ワル ドイ・ベル 2 4 4 4 4 4 フラ・パリ イタ・ロー ギリ・アテ スペ・マド ポル・リス 4 3 1 4 4 Within cluster sum of squares by cluster: [1] 0.00000 0.00000 0.00000 29.95733 (between_SS / total_SS = 59.4 %)
では、全部の要素の組合せ(国名・首都に関わらず、つまり国名−国名等も含む)で差分ベクトルを作って、その差分ベクトルを主成分分析してみる。考えていることは、いろいろな差分の中で、特定の国名−首都の組合せの差分だけが、何か別枠になっていることがないか、という点である。 表示がうっとうしいので、差分ベクトルの対称分を省略している。
まず、差分ベクトルをクラスタ化してみる。階層化クラスタリングだと、
> a1 <- read.csv('list-capital.diff', header=FALSE, row.names=1) > ad <- dist(a1) > ah <- hclust(ad, method="ward.D2") > par(cex=0.7) > plot(ah)
おもしろいのは、都市ごと・国ごとにグループ化される傾向があることである。 左から見ると、アテネと何か、マドリードと何か、という具合にグループ化されている。更に、アテネグループの中で、アテネ・国名と、アテネ・都市名が、何となく分離している。次のマドリードの場合だともっと顕著に、相手が国名か都市名かで分離している。 何かの「カテゴリー」を検出しているようだ。
では、k-mean法だとどうなるか。クラスタ数をいくつにするかという問題があるが、 階層化クラスタリングの結果を参考にすると、それぞれの都市名に対して都市名・国名のペアと、都市名・都市名のペアがあるので、11の都市名に対して22クラスタができる可能性がある。 k=22 で試す。
> ak <- kmeans(ad, centers=22) > ak K-means clustering with 22 clusters of sizes 11, 9, 5, 3, 35, 7, 8, 9, 15, 10, 5, 7, 13, 16, 11, 9, 5, 16, 3, 3, 17, 14 Clustering vector: 日本-東京 ロシ-東京 ロシ-日本 モス-東京 モス-日本 モス-ロシ 中国-東京 13 13 10 7 4 14 13 中国-日本 中国-ロシ 中国-モス 北京-東京 北京-日本 北京-ロシ 北京-モス 10 12 12 7 6 1 12 北京-中国 トル-東京 トル-日本 トル-ロシ トル-モス トル-中国 トル-北京 14 13 10 5 21 9 16 アン-東京 アン-日本 アン-ロシ アン-モス アン-中国 アン-北京 アン-トル 7 6 14 5 3 9 14 ポー-東京 ポー-日本 ポー-ロシ ポー-モス ポー-中国 ポー-北京 ポー-トル 13 10 5 21 9 16 5 ポー-アン ワル-東京 ワル-日本 ワル-ロシ ワル-モス ワル-中国 ワル-北京 22 7 6 14 5 3 9 ワル-トル ワル-アン ワル-ポー ドイ-東京 ドイ-日本 ドイ-ロシ ドイ-モス 8 18 14 13 10 5 22 ドイ-中国 ドイ-北京 ドイ-トル ドイ-アン ドイ-ポー ドイ-ワル ベル-東京 9 16 18 22 18 22 7 ベル-日本 ベル-ロシ ベル-モス ベル-中国 ベル-北京 ベル-トル ベル-アン 4 8 18 3 9 8 18 ベル-ポー ベル-ワル ベル-ドイ フラ-東京 フラ-日本 フラ-ロシ フラ-モス 8 18 8 13 10 18 22 フラ-中国 フラ-北京 フラ-トル フラ-アン フラ-ポー フラ-ワル フラ-ドイ 9 16 18 22 18 22 18 フラ-ベル パリ-東京 パリ-日本 パリ-ロシ パリ-モス パリ-中国 パリ-北京 22 7 4 8 18 3 9 パリ-トル パリ-アン パリ-ポー パリ-ワル パリ-ドイ パリ-ベル パリ-フラ 8 18 8 18 8 5 14 イタ-東京 イタ-日本 イタ-ロシ イタ-モス イタ-中国 イタ-北京 イタ-トル 13 10 5 22 9 16 18 イタ-アン イタ-ポー イタ-ワル イタ-ドイ イタ-ベル イタ-フラ イタ-パリ 22 18 22 5 21 5 21 ロー-東京 ロー-日本 ロー-ロシ ロー-モス ロー-中国 ロー-北京 ロー-トル 13 6 15 17 9 16 15 ロー-アン ロー-ポー ロー-ワル ロー-ドイ ロー-ベル ロー-フラ ロー-パリ 17 15 17 15 17 15 17 ロー-イタ ギリ-東京 ギリ-日本 ギリ-ロシ ギリ-モス ギリ-中国 ギリ-北京 15 13 10 5 21 9 16 ギリ-トル ギリ-アン ギリ-ポー ギリ-ワル ギリ-ドイ ギリ-ベル ギリ-フラ 5 22 5 21 5 21 5 ギリ-パリ ギリ-イタ ギリ-ロー アテ-東京 アテ-日本 アテ-ロシ アテ-モス 21 5 12 13 6 1 11 アテ-中国 アテ-北京 アテ-トル アテ-アン アテ-ポー アテ-ワル アテ-ドイ 1 9 1 11 1 11 1 アテ-ベル アテ-フラ アテ-パリ アテ-イタ アテ-ロー アテ-ギリ スペ-東京 11 1 11 1 1 1 13 スペ-日本 スペ-ロシ スペ-モス スペ-中国 スペ-北京 スペ-トル スペ-アン 10 5 21 9 16 5 22 スペ-ポー スペ-ワル スペ-ドイ スペ-ベル スペ-フラ スペ-パリ スペ-イタ 5 21 5 21 5 21 5 スペ-ロー スペ-ギリ スペ-アテ マド-東京 マド-日本 マド-ロシ マド-モス 12 5 20 7 6 2 15 マド-中国 マド-北京 マド-トル マド-アン マド-ポー マド-ワル マド-ドイ 19 19 2 15 2 15 2 マド-ベル マド-フラ マド-パリ マド-イタ マド-ロー マド-ギリ マド-アテ 15 2 15 2 2 2 19 マド-スペ ポル-東京 ポル-日本 ポル-ロシ ポル-モス ポル-中国 ポル-北京 2 13 10 5 21 9 16 ポル-トル ポル-アン ポル-ポー ポル-ワル ポル-ドイ ポル-ベル ポル-フラ 5 22 5 21 5 21 5 ポル-パリ ポル-イタ ポル-ロー ポル-ギリ ポル-アテ ポル-スペ ポル-マド 21 5 12 5 20 5 21 リス-東京 リス-日本 リス-ロシ リス-モス リス-中国 リス-北京 リス-トル 7 6 14 5 3 9 14 リス-アン リス-ポー リス-ワル リス-ドイ リス-ベル リス-フラ リス-パリ 18 14 5 14 5 14 5 リス-イタ リス-ロー リス-ギリ リス-アテ リス-スペ リス-マド リス-ポル 14 1 14 20 14 12 14 Within cluster sum of squares by cluster: [1] 300.610775 119.236551 59.882213 9.885346 630.596354 230.907256 [7] 194.960225 96.064969 417.729167 153.298504 64.629177 245.088509 [13] 339.733609 240.028695 349.731117 127.867876 51.019780 304.450561 [19] 71.439988 64.700711 243.915489 212.425544 (between_SS / total_SS = 83.5 %)
更に、差分ベクトルを主成分分析をしてみる。
> a1 <- read.csv('list-capital.diff', header=FALSE, row.names=1) > a2 <- prcomp(a1, scaling=TRUE) > summary(a2) Importance of components: PC1 PC2 PC3 PC4 PC5 PC6 PC7 Standard deviation 1.1666 0.9428 0.8365 0.63844 0.58822 0.5556 0.48425 Proportion of Variance 0.2605 0.1702 0.1340 0.07803 0.06624 0.0591 0.04489 Cumulative Proportion 0.2605 0.4307 0.5647 0.64272 0.70896 0.7681 0.81295 PC8 PC9 PC10 PC11 PC12 PC13 PC14 Standard deviation 0.39755 0.3838 0.34650 0.32444 0.28898 0.25229 0.24864 Proportion of Variance 0.03026 0.0282 0.02299 0.02015 0.01599 0.01219 0.01184 Cumulative Proportion 0.84320 0.8714 0.89439 0.91454 0.93053 0.94271 0.95455 PC15 PC16 PC17 PC18 PC19 PC20 PC21 Standard deviation 0.23808 0.20175 0.19421 0.18489 0.1679 0.14828 0.13396 Proportion of Variance 0.01085 0.00779 0.00722 0.00654 0.0054 0.00421 0.00344 Cumulative Proportion 0.96540 0.97319 0.98041 0.98696 0.9924 0.99656 1.00000 PC22 PC23 PC24 PC25 PC26 Standard deviation 5.837e-16 3.244e-16 2.721e-16 2.297e-16 2.172e-16 Proportion of Variance 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 Cumulative Proportion 1.000e+00 1.000e+00 1.000e+00 1.000e+00 1.000e+00 (以下省略) PC97 PC98 PC99 PC100 Standard deviation 5.048e-17 4.608e-17 4.156e-17 2.495e-17 Proportion of Variance 0.000e+00 0.000e+00 0.000e+00 0.000e+00 Cumulative Proportion 1.000e+00 1.000e+00 1.000e+00 1.000e+00 > par(cex=0.5) > plot(a2$x, type="n") > text(a2$x, rownames(a1))
図に描くと
累積寄与率を見ると、90%に至るにはPC10まで必要である。
また図の中で傾向を探すことも難しそうだ。