井出草平の研究ノート

Rでクラスター分析[R]

Gabriel Martosさんによる解説より。

rstudio-pubs-static.s3.amazonaws.com

Rを使ってクラスター分析を行う方法を学ぶ。データセットwinsを使用するために,ライブラリrattleをロードする。

library(rattle)
data(wine, package='rattle')
head(wine)
  Type Alcohol Malic  Ash Alcalinity Magnesium Phenols Flavanoids Nonflavanoids Proanthocyanins Color  Hue Dilution Proline
1    1   14.23  1.71 2.43       15.6       127    2.80       3.06          0.28            2.29  5.64 1.04     3.92    1065
2    1   13.20  1.78 2.14       11.2       100    2.65       2.76          0.26            1.28  4.38 1.05     3.40    1050
3    1   13.16  2.36 2.67       18.6       101    2.80       3.24          0.30            2.81  5.68 1.03     3.17    1185
4    1   14.37  1.95 2.50       16.8       113    3.85       3.49          0.24            2.18  7.80 0.86     3.45    1480
5    1   13.24  2.59 2.87       21.0       118    2.80       2.69          0.39            1.82  4.32 1.04     2.93     735
6    1   14.20  1.76 2.45       15.2       112    3.27       3.39          0.34            1.97  6.75 1.05     2.85    1450

このデータセットでは、異なるワインの組成を観察している。各観察がd次元の実数ベクトルである観察セット(x1,x2,..,xn)が与えられたとき,k-meansクラスタリングは,クラスタ内二乗和(WCS)を最小化するように,n個の観察(k≤n)S={S1,S2,...,Sk}に分割することを目的とするのがクラスター分析である。言い換えればを見つけることである。

f:id:iDES:20210325014222p:plain

ここで、μ_iはS_iの点の平均値である。クラスタリング最適化問題はRの関数kmeansを用いて解く。

wine.stand <- scale(wine[-1])  # 変数を標準化させる
# K-Means
k.means.fit <- kmeans(wine.stand, 3) # k = 3

k.means.fitには、クラスタ出力のすべての要素が含まれている。

attributes(k.means.fit)
$names
[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss" "betweenss"    "size"         "iter"         "ifault"      

$class
[1] "kmeans"
## 中央値
k.means.fit$centers
     Alcohol      Malic        Ash Alcalinity   Magnesium     Phenols  Flavanoids Nonflavanoids Proanthocyanins      Color        Hue   Dilution    Proline
1  0.8328826 -0.3029551  0.3636801 -0.6084749  0.57596208  0.88274724  0.97506900   -0.56050853      0.57865427  0.1705823  0.4726504  0.7770551  1.1220202
2  0.1644436  0.8690954  0.1863726  0.5228924 -0.07526047 -0.97657548 -1.21182921    0.72402116     -0.77751312  0.9388902 -1.1615122 -1.2887761 -0.4059428
3 -0.9234669 -0.3929331 -0.4931257  0.1701220 -0.49032869 -0.07576891  0.02075402   -0.03343924      0.05810161 -0.8993770  0.4605046  0.2700025 -0.7517257
## クラスター
k.means.fit$cluster
  [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 2 3 3 3 3 3 3 3 3 3 3 3 1 3 3 3 3 3 3 3 3
 [83] 3 2 3 3 3 3 3 3 3 3 3 3 3 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 3 3 1 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
[165] 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## クラスターサイズ
k.means.fit$size
[1] 62 51 65

基本的な問題は、どのようにしてパラメータkの値を決定するかということである。説明された分散の割合をクラスタ数の関数として見てみよう。別のクラスターを追加してもデータのモデリングがあまり良くならないようなクラスター数を選ぶべきである。より正確には、クラスターによって説明される分散の割合をクラスターの数に対してプロットすると、最初のクラスターは多くの情報を追加するが(多くの分散を説明する)、ある時点で差益marginal gainが下がり、グラフに角度がつく。クラスタの数はこの時点で選択されるため「エルボー基準elbow criterion」と呼ばれている。

wssplot <- function(data, nc=15, seed=1234){
  wss <- (nrow(data)-1)*sum(apply(data,2,var))
  for (i in 2:nc){
    set.seed(seed)
    wss[i] <- sum(kmeans(data, centers=i)$withinss)}
  plot(1:nc, wss, type="b", xlab="Number of Clusters",
       ylab="Within groups sum of squares")}

wssplot(wine.stand, nc=6) 

f:id:iDES:20210325014236p:plain

clusterパッケージでは(PCAの助けを借りて)クラスターソリューションを2次元に表現することができる。

library(cluster)
clusplot(wine.stand, k.means.fit$cluster, main='2D representation of the Cluster solution',
         color=TRUE, shade=TRUE,
         labels=2, lines=0)

f:id:iDES:20210325014437p:plain

クラスタリングの性能を評価するために、混同行列を作成する。

table(wine[,1],k.means.fit$cluster)

階層型クラスタリング

階層型クラスタリングでは,クラスタリングアルゴリズムの入力として距離行列を使用する。ある距離では互いに近く、別の距離では遠くなる要素があるため、適切な指標の選択はクラスタの形状に影響を与える。

d <- dist(wine.stand, method = "euclidean") # ユークリッド距離行列

クラスタリングアルゴリズムの入力として、ユークリッド距離を使用する。(Wardの最小分散基準は、クラスタ内の分散の合計を最小化する)。

H.fit <- hclust(d, method="ward")

ward "メソッドは "ward.D "に改名されている。新しい "ward.D2 "に注意。

クラスタリングの結果をデンドログラムで表示することができる。

plot(H.fit) # デンドログラムを表示
groups <- cutree(H.fit, k=3) # ツリーを3つのクラスターに分割
# 3つのクラスターを赤い枠で囲んだデンドグラムを作成
rect.hclust(H.fit, k=3, border="red") 

f:id:iDES:20210325014507p:plain

以下のような混同行列を用いて評価される。

table(wine[,1],groups)
   groups
     1  2  3
  1 58  1  0
  2  7 58  6
  3  0  0 48

研究事例 I: ヨーロッパのタンパク質消費量

ヨーロッパの25カ国(n=25台)と主要な9つの食品からのタンパク質摂取量(単位:%)を検討する(p=9)。データは以下の通りです。

url = 'http://www.biz.uiowa.edu/faculty/jledolter/DataMining/protein.csv'
food <- read.csv(url)
head(food)
         Country RedMeat WhiteMeat Eggs Milk Fish Cereals Starch Nuts Fr.Veg
1        Albania    10.1       1.4  0.5  8.9  0.2    42.3    0.6  5.5    1.7
2        Austria     8.9      14.0  4.3 19.9  2.1    28.0    3.6  1.3    4.3
3        Belgium    13.5       9.3  4.1 17.5  4.5    26.6    5.7  2.1    4.0
4       Bulgaria     7.8       6.0  1.6  8.3  1.2    56.7    1.1  3.7    4.2
5 Czechoslovakia     9.7      11.4  2.8 12.5  2.0    34.3    5.0  1.1    4.0
6        Denmark    10.6      10.8  3.7 25.0  9.9    21.9    4.8  0.7    2.4

まず赤肉と白肉だけでクラスタリングを行い(p=2)、k=3のクラスタを作成する。

set.seed(123456789) ## ランダムな開始クラスタを固定
grpMeat <- kmeans(food[,c("WhiteMeat","RedMeat")], centers=3, nstart=10)
grpMeat
K-means clustering with 3 clusters of sizes 12, 5, 8

Cluster means:
  WhiteMeat   RedMeat
1  4.658333  8.258333
2  9.000000 15.180000
3 12.062500  8.837500

Clustering vector:
 [1] 1 3 2 1 3 3 3 1 2 1 3 2 1 3 1 3 1 1 1 1 2 2 1 3 1

Within cluster sum of squares by cluster:
[1] 69.85833 35.66800 39.45750
 (between_SS / total_SS =  75.7 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss" "betweenss"    "size"         "iter"         "ifault"  
## クラスター割り当てリスト
o=order(grpMeat$cluster)
data.frame(food$Country[o],grpMeat$cluster[o])
   food.Country.o. grpMeat.cluster.o.
1          Albania                  1
2         Bulgaria                  1
3          Finland                  1
4           Greece                  1
5            Italy                  1
6           Norway                  1
7         Portugal                  1
8          Romania                  1
9            Spain                  1
10          Sweden                  1
11            USSR                  1
12      Yugoslavia                  1
13         Belgium                  2
14          France                  2
15         Ireland                  2
16     Switzerland                  2
17              UK                  2
18         Austria                  3
19  Czechoslovakia                  3
20         Denmark                  3
21       E Germany                  3
22         Hungary                  3
23     Netherlands                  3
24          Poland                  3
25       W Germany                  3

クラスタリングソリューションをグラフィカルに表現するために、赤肉と白肉のクラスタ割り当てを散布図にプロットする。

plot(food$Red, food$White, type="n", xlim=c(3,19), xlab="Red Meat", ylab="White Meat")
text(x=food$Red, y=food$White, labels=food$Country,col=grpMeat$cluster+1)

f:id:iDES:20210325014311p:plain

次に、9つのタンパク質グループすべてをクラスター化し、7つのクラスターを作成するようにプログラムを準備する。
できあがったクラスターは、白肉と赤肉の散布図に色で示されていますが(他の特徴のペアを選択することもできる)理にかなっている。地理的に近接した国は、同じグループに分類される傾向がある。

## 同じ分析をするが、今度は全てのタンパク質グループにクラスタリングを行う
## タンパク質グループのクラスタ数を7に変更
set.seed(123456789)
grpProtein <- kmeans(food[,-1], centers=7, nstart=10)
o=order(grpProtein$cluster)
data.frame(food$Country[o],grpProtein$cluster[o])
   food.Country.o. grpProtein.cluster.o.
1          Denmark                     1
2          Finland                     1
3           Norway                     1
4           Sweden                     1
5          Austria                     2
6        E Germany                     2
7      Netherlands                     2
8        W Germany                     2
9         Portugal                     3
10           Spain                     3
11  Czechoslovakia                     4
12         Hungary                     4
13          Poland                     4
14        Bulgaria                     5
15         Romania                     5
16      Yugoslavia                     5
17         Belgium                     6
18          France                     6
19         Ireland                     6
20     Switzerland                     6
21              UK                     6
22         Albania                     7
23          Greece                     7
24           Italy                     7
25            USSR                     7
library(cluster)
clusplot(food[,-1], grpProtein$cluster, main='2D representation of the Cluster solution', color=TRUE, shade=TRUE, labels=2, lines=0)

f:id:iDES:20210325014259p:plain

また、階層的なアプローチを行うこともできる。ここでは、clusterパッケージのagnes関数を使用する。引数 diss=FALSEは、生データから計算される非類似度行列を使用することを示す。引数 metric="euclidian" は、ユークリッド距離を使用することを示す。標準化は使用せず、リンク関数は「平均average」である。

foodagg=agnes(food,diss=FALSE,metric="euclidian")
plot(foodagg, main='Dendrogram') ## デンドログラム

f:id:iDES:20210325014526p:plain f:id:iDES:20210325014535p:plain

groups <- cutree(foodagg, k=4) # ツリーを4つに切り分ける
rect.hclust(foodagg, k=4, border="red")

f:id:iDES:20210325014547p:plain

スタディケースII:顧客セグメンテーション

顧客セグメンテーションとは、簡単に言えば、顧客をその特徴によってグループ化することである。ここでは、Eメールマーケティングを例に説明する。こちらのリンクからデータセットを使用している。

offers<-read.csv("offers.csv", sep = ",", header=T)
head(offers)
  OfferID Campaign           Varietal MinimumQt Discount      Origin PastPeak
1       1  January             Malbec        72       56      France    FALSE
2       2  January         Pinot Noir        72       17      France    FALSE
3       3 February          Espumante       144       32      Oregon     TRUE
4       4 February          Champagne        72       48      France     TRUE
5       5 February Cabernet Sauvignon       144       44 New Zealand     TRUE
6       6    March           Prosecco       144       86       Chile    FALSE
transactions <- read.csv("transactions.csv", sep = ",", header=T)
head(transactions)
  CustomerLastName OfferID
1            Smith       2
2            Smith      24
3          Johnson      17
4          Johnson      24
5          Johnson      26
6         Williams      18

ステップ1:情報の整理

1つはオファー用、もう1つはトランザクション用の2つのデータセットがある。まず必要なのは、取引マトリックスの作成である。つまり、郵送したオファーを、各顧客の取引履歴の横に並べる必要があります。これは、ピボットテーブルで簡単に実現できます。

# トランザクションマトリクス(Excelのようなピボットテーブル)の作成
library(reshape)
pivot<-melt(transactions[1:2])
pivot<-(cast(pivot,value~CustomerLastName,fill=0,fun.aggregate=function(x) length(x)))
pivot<-cbind(offers,pivot[-1])

# write.csv(file="pivot.csv",pivot) # データ保存

cluster.data<-pivot[,8:length(pivot)]
cluster.data<-t(cluster.data)
head(cluster.data)
         1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
Adams    0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  0  0  1  0  0  0  0  0  0  0  0  0  0  1  1  0  0
Allen    0 0 0 0 0 0 0 0 1  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  1  0  0  0  0  0
Anderson 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  1  0  1  0  0  0  0  0  0
Bailey   0 0 0 0 0 0 1 0 0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  1  0  0
Baker    0 0 0 0 0 0 1 0 0  1  0  0  0  0  0  0  0  0  1  0  0  0  0  0  0  0  0  0  0  0  1  0
Barnes   0 0 0 0 0 0 0 0 0  1  0  0  0  0  0  0  0  0  0  0  1  1  0  0  0  0  0  0  0  0  1  0

クラスタリングのデータセットでは、行は顧客を、列は異なるワインのブランドやタイプを表している。

ステップ2:距離とクラスタ

ここではk=4とし、4つのクラスターを使用することを示す。これは多少恣意的なものだが、選ぶ数はビジネスとして扱えるセグメントの数を代表するものでなければなりません。つまり、100個のセグメントはEメールマーケティングキャンペーンとしては意味がない。

各顧客がクラスタの平均値からどれだけ離れているかを計算する必要がある。これには多くの距離/非類似度インデックスを使用できるが、その1つにGower's dissimilarityがある。

library(cluster)
D=daisy(cluster.data, metric='gower')

距離行列を作成した後、Ward's hierarchical clusteringの手順を実行する。

H.fit <- hclust(D, method="ward")
plot(H.fit) # デンドログラムの表示

groups <- cutree(H.fit, k=4) # ツリーを4つに切り分ける

# 4つのクラスターを赤い枠で囲んだデノグラムを描く
rect.hclust(H.fit, k=4, border="red") 

f:id:iDES:20210325014607p:plain

# セグメンテーションの2D表示:
clusplot(cluster.data, groups, color=TRUE, shade=TRUE,
         labels=2, lines=0, main= 'Customer segments')

f:id:iDES:20210325014624p:plain

上位の取引を得るためには、少しデータを操作する必要がある。まず、クラスターとトランザクションを結合する必要がある。注目すべきは、トランザクションクラスターを保持する「テーブル」の長さが異なることである。そこで、データを結合する方法が必要となる。そこで、merge()関数を使用し、列にわかりやすい名前をつける。

# データのマージ

cluster.deals<-merge(transactions[1:2],groups,by.x = "CustomerLastName", by.y = "row.names")

colnames(cluster.deals)<-c("Name","Offer","Cluster")
head(cluster.deals)
      Name Offer Cluster
1    Adams    18       1
2    Adams    29       1
3    Adams    30       1
4    Allen     9       2
5    Allen    27       2
6 Anderson    24       3

次に、ピボット処理を繰り返し、オファーを行に、クラスタを列にして、各クラスタトランザクションの合計数をカウントする。ピボットテーブルができたら、先ほどと同様にオファーのデータテーブルとマージする。

# Get top deals by cluster
cluster.pivot<-melt(cluster.deals,id=c("Offer","Cluster"))
cluster.pivot<-cast(cluster.pivot,Offer~Cluster,fun.aggregate=length)
cluster.topDeals<-cbind(offers,cluster.pivot[-1])
head(cluster.topDeals)
  OfferID Campaign           Varietal MinimumQt Discount      Origin PastPeak 1 2 3 4
1       1  January             Malbec        72       56      France    FALSE 0 8 2 0
2       2  January         Pinot Noir        72       17      France    FALSE 0 3 7 0
3       3 February          Espumante       144       32      Oregon     TRUE 1 2 0 3
4       4 February          Champagne        72       48      France     TRUE 0 8 0 4
5       5 February Cabernet Sauvignon       144       44 New Zealand     TRUE 0 4 0 0
6       6    March           Prosecco       144       86       Chile    FALSE 1 5 0 6

Study case III: ソーシャルネットワーククラスタリング分析

この分析には,2006年から2009年にかけて,有名なソーシャル・ネットワーク上にプロフィールを持っていた米国の高校生3万人を無作為に抽出したデータセットを使用している(リンク)。

全ページに掲載された上位500語の中から、「課外活動」「ファッション」「宗教」「恋愛」「反社会的行動」の5つのカテゴリーの興味を表す36語を選んだ。この36個の単語には、「サッカー」「セクシー」「キス」「聖書」「ショッピング」「死」「ドラッグ」などの言葉が含まれています。最終的なデータセットには,各人について,その人のSNSプロフィールに各単語が何回登場したかが示されている。

teens <- read.csv("snsdata.csv")
head(teens,3)
  gradyear gender    age friends basketball football soccer softball volleyball swimming cheerleading baseball tennis sports cute sex sexy hot kissed dance band marching
1     2006      M 18.982       7          0        0      0        0          0        0            0        0      0      0    0   0    0   0      0     1    0        0
2     2006      F 18.801       0          0        1      0        0          0        0            0        0      0      0    1   0    0   0      0     0    0        0
3     2006      M 18.335      69          0        1      0        0          0        0            0        0      0      0    0   0    0   0      0     0    2        0
  music rock god church jesus bible hair dress blonde mall shopping clothes hollister abercrombie die death drunk drugs
1     0    0   0      0     0     0    0     0      0    0        0       0         0           0   0     0     0     0
2     2    2   1      0     0     0    6     4      0    1        0       0         0           0   0     0     0     0
3     1    0   0      0     0     0    0     0      0    0        0       0         0           0   0     1     0     0
dim(teens)
[1] 30000    40

また、データの具体的な内容を簡単に見てみよう。str()の出力の最初の数行は以下の通りである。

str(teens)
'data.frame':    30000 obs. of  40 variables:
 $ gradyear    : int  2006 2006 2006 2006 2006 2006 2006 2006 2006 2006 ...
 $ gender      : chr  "M" "F" "M" "F" ...
 $ age         : num  19 18.8 18.3 18.9 19 ...
 $ friends     : int  7 0 69 0 10 142 72 17 52 39 ...
 $ basketball  : int  0 0 0 0 0 0 0 0 0 0 ...
 $ football    : int  0 1 1 0 0 0 0 0 0 0 ...
 $ soccer      : int  0 0 0 0 0 0 0 0 0 0 ...
 $ softball    : int  0 0 0 0 0 0 0 1 0 0 ...
 $ volleyball  : int  0 0 0 0 0 0 0 0 0 0 ...
 $ swimming    : int  0 0 0 0 0 0 0 0 0 0 ...
 $ cheerleading: int  0 0 0 0 0 0 0 0 0 0 ...
 $ baseball    : int  0 0 0 0 0 0 0 0 0 0 ...
 $ tennis      : int  0 0 0 0 0 0 0 0 0 0 ...
 $ sports      : int  0 0 0 0 0 0 0 0 0 0 ...
 $ cute        : int  0 1 0 1 0 0 0 0 0 1 ...
 $ sex         : int  0 0 0 0 1 1 0 2 0 0 ...
 $ sexy        : int  0 0 0 0 0 0 0 1 0 0 ...
 $ hot         : int  0 0 0 0 0 0 0 0 0 1 ...
 $ kissed      : int  0 0 0 0 5 0 0 0 0 0 ...
 $ dance       : int  1 0 0 0 1 0 0 0 0 0 ...
 $ band        : int  0 0 2 0 1 0 1 0 0 0 ...
 $ marching    : int  0 0 0 0 0 1 1 0 0 0 ...
 $ music       : int  0 2 1 0 3 2 0 1 0 1 ...
 $ rock        : int  0 2 0 1 0 0 0 1 0 1 ...
 $ god         : int  0 1 0 0 1 0 0 0 0 6 ...
 $ church      : int  0 0 0 0 0 0 0 0 0 0 ...
 $ jesus       : int  0 0 0 0 0 0 0 0 0 2 ...
 $ bible       : int  0 0 0 0 0 0 0 0 0 0 ...
 $ hair        : int  0 6 0 0 1 0 0 0 0 1 ...
 $ dress       : int  0 4 0 0 0 1 0 0 0 0 ...
 $ blonde      : int  0 0 0 0 0 0 0 0 0 0 ...
 $ mall        : int  0 1 0 0 0 0 2 0 0 0 ...
 $ shopping    : int  0 0 0 0 2 1 0 0 0 1 ...
 $ clothes     : int  0 0 0 0 0 0 0 0 0 0 ...
 $ hollister   : int  0 0 0 0 0 0 2 0 0 0 ...
 $ abercrombie : int  0 0 0 0 0 0 0 0 0 0 ...
 $ die         : int  0 0 0 0 0 0 0 0 0 0 ...
 $ death       : int  0 0 1 0 0 0 0 0 0 0 ...
 $ drunk       : int  0 0 0 0 1 1 0 0 0 0 ...
 $ drugs       : int  0 0 0 0 1 0 0 0 0 0 ...

予想していた通り、データには3万人のティーンエイジャーが含まれており、個人の特徴を示す4つの変数と、興味を示す36の単語が含まれている。なお、性別という変数にはNAが入っている。

summary(teens$age)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  3.086  16.312  17.287  17.994  18.259 106.927    5086

欠損値のあるデータはすべてスキップする。

teens = na.omit(teens)
dim(teens)

ここでは、10代の若者のSNSプロフィールに様々な関心事が登場した回数を表す36の特徴のみを考慮して、クラスター分析を始める。便宜上、これらの特徴のみを含むデータフレームを作成する。

interests <- teens[5:40]

z-scoreによる標準化をinterestのデータフレームに適用するには、次のようにlapply()でscale()関数を使用する。

interests_z <- as.data.frame(lapply(interests, scale))

10代の若者を5つのクラスターに分けるには、次のようなコマンドを使う。

teen_clusters <- kmeans(interests_z, 5)

それぞれのグループに該当する例の数。グループが大きすぎたり小さすぎたりすると、あまり役に立たない可能性がある。kmeans()クラスタのサイズを取得するには、次のようにteen_clusters$sizeコンポーネントを使用する。

teen_clusters$size
[1]   405   860  2232  3083 17425

クラスターをより詳しく見るには、teen_clusters$centersコンポーネントを使って、クラスターの重心の座標を調べることができ、最初の8つの特徴については以下のようになる。

teen_clusters$centers
  basketball     football      soccer    softball  volleyball    swimming  cheerleading    baseball      tennis       sports        cute          sex         sexy
1  0.1152395 -0.006253857  0.02844803 -0.04255250  0.02933352  0.04500375  0.0006386251 -0.03888461  0.05637920 -0.009560419  0.01047181  0.025147945 -0.062252867
2  0.3386771  0.350120706  0.15029767  0.13701506  0.07668272  0.20899493  0.1543723921  0.23075537  0.11597610  0.726483103  0.44428148  1.975537523  0.511518309
3  1.2300691  1.200720411  0.47116382  1.11942700  1.04345835  0.09264676  0.0244048830  1.10666395  0.15540779  1.071233927 -0.01010005 -0.038629308 -0.009825837
4  0.0284675  0.104936408  0.06895202 -0.04458681 -0.01021244  0.27949365  0.5623033380 -0.05816003  0.04890366 -0.063436948  0.82253163 -0.004130576  0.303494967
5 -0.1819922 -0.189503466 -0.08063094 -0.14127398 -0.13631801 -0.07267883 -0.1102480224 -0.14194938 -0.03559330 -0.161625338 -0.16640717 -0.092407002 -0.076237420
          hot      kissed        dance        band     marching      music       rock         god     church       jesus        bible         hair       dress
1  0.05344326 -0.03354630 -0.009405618  0.15152951  0.078953661  0.2306109  0.1425621  2.24624560  1.3185507  2.36965404  5.992483246  0.044978265  0.03931601
2  0.26019419  2.94730493  0.414987319  0.60089572  0.206976226  1.2478957  1.1739297  0.35947129  0.1521145  0.05459252  0.005037993  2.498087831  0.53055817
3 -0.01695914 -0.09929714 -0.010316408 -0.03461299 -0.038526778  0.0677092  0.1500378  0.03032044  0.1524046 -0.01081647 -0.095495897 -0.003643109 -0.05968584
4  0.67378454 -0.01425919  0.701985251  0.03514753 -0.028764717  0.2292623  0.1222727  0.06281957  0.2917329  0.02396216 -0.101020641  0.364937887  0.60853128
5 -0.13112404 -0.12944067 -0.143143422 -0.03496375 -0.002025962 -0.1161854 -0.1021044 -0.08494822 -0.1092919 -0.06062510 -0.109422950 -0.188438670 -0.12712116
        blonde        mall     shopping      clothes   hollister abercrombie         die       death       drunk       drugs
1 -0.004136652 -0.09449647 -0.006181435  0.037215586 -0.07401475 -0.03857646  0.21743896  0.29091117  0.05829588  0.08088582
2  0.355703198  0.58040544  0.216368739  1.191676922  0.21324062  0.35608241  1.72250393  0.92678665  1.76315875  2.70938830
3  0.026379582 -0.02753857  0.013336653 -0.004109565 -0.09850342 -0.10399745 -0.06606873 -0.03193388 -0.07480891 -0.09821954
4  0.032535642  0.89065699  1.125189643  0.662218098  0.94076894  0.86188708  0.03601752  0.09025773  0.03793660 -0.06647778
5 -0.026594893 -0.18050542 -0.211322853 -0.176319100 -0.16263656 -0.15584981 -0.08797663 -0.06438127 -0.08550424 -0.11125714

クラスターの特徴は円グラフで知ることができる。

par(mfrow=c(2,2))
pie(colSums(interests[teen_clusters$cluster==1,]),cex=0.5)

pie(colSums(interests[teen_clusters$cluster==2,]),cex=0.5)

pie(colSums(interests[teen_clusters$cluster==3,]),cex=0.5)

pie(colSums(interests[teen_clusters$cluster==4,]),cex=0.5)

f:id:iDES:20210325014653p:plain