「2014 FIFA ワールドカップ Brasil」をクラスター分析

「Copa do Mundo de Futebol FIFA Brasil 2014」をクラスター分析してみた。

データは、ここから入手。
https://www.whoscored.com/Statistics
こんな風な tab 区切りファイルに保存して

Team	Rank	Rating	Shotsconceded 	Shots	Tackles	CaughtOffside	Blocks	Interception	Clearances	Save	Goals	Dribbles	PossessionLoss	AerialWon	AerialLost	Passes	KeyPpasses	Assists	Fouls	Fouled
Algeria	10	6.92	15.5	9	20.8	1.5	10.8	16.3	29.5	4.8	1.5	6.5	19.8	14.8	22	326	6.5	1.3	17.3	13.5
Argentina	4	7.12	11.1	15.4	19	1.4	12.5	14.1	26.7	2.4	0.9	12.3	24	10.4	9.7	461.3	10.4	0.3	11	16.6
Australia	30	6.39	11.3	9	12.3	1	12	15.3	21	2.7	1	10.3	24.4	12.7	10.7	401.7	7.3	0.7	16.7	13
...省略...
Switzerland	1	7.14	18.3	16.3	20	1.3	15.8	12	24.5	4.3	1.8	6.5	23.6	11	10.3	392	13	1.5	16.5	15.8
Uruguay	26	6.63	10.8	11.8	18.5	2.8	12.3	15.8	24.3	2.3	1	5.5	23.3	18.3	17.5	346	7.8	0.5	18.3	15.8
USA	11	6.91	23.5	11	20	1	17.1	13.5	38.5	5.8	1	9	17.5	15	16.3	385.3	5.8	0.8	12.3	14

R に読み込み

d <- read.table("WorldCup2014TeamStatistics.txt", header=T)

rownames(d) <- c("Algeria",
"Argentina",
"Australia",
"Belgium",
"Bosnia_and_Herzegovina",
"Brazil",
"Cameroon",
"Chile",
"Colombia",
"Costa_Rica",
"Croatia",
"Ecuador",
"England",
"France",
"Germany",
"Ghana",
"Greece",
"Honduras",
"Iran",
"Italy",
"Ivory_Coast",
"Japan",
"Mexico",
"Netherlands",
"Nigeria",
"Portugal",
"Russia",
"South_Korea",
"Spain",
"Switzerland",
"Uruguay",
"USA")

正規化

# 平均が0、分散が1となるよう正規化
d_scale <- scale(d)

最遠隣法

#最遠隣法でコーフェン行列を求める
d_clust <- hclust(d_dist, "complete")
#樹形図
plot(d_clust)
#３つのグループに分ける
rect.hclust(d_clust, k=3)

f:id:fornext1119:20180627121851p:plain

群平均法

#群平均法でコーフェン行列を求める
d_clust <- hclust(d_dist, "average")
#樹形図
plot(d_clust)
#３つのグループに分ける
rect.hclust(d_clust, k=3)

f:id:fornext1119:20180627122020p:plain

重心法

#重心法でコーフェン行列を求める
d_clust <- hclust(d_dist, "centroid")
#樹形図
plot(d_clust)
#３つのグループに分ける
rect.hclust(d_clust, k=3)

f:id:fornext1119:20180627122210p:plain

メディアン法

#メディアン法でコーフェン行列を求める
d_clust <- hclust(d_dist, "median")
#樹形図
plot(d_clust)
#３つのグループに分ける
rect.hclust(d_clust, k=3)

f:id:fornext1119:20180627122253p:plain

ウォード法

#ウォード法でコーフェン行列を求める
d_clust <- hclust(d_dist, "ward.D")
#樹形図
plot(d_clust)
#３つのグループに分ける
rect.hclust(d_clust, k=3)

f:id:fornext1119:20180627122332p:plain

ggplot2 で描画

# proxy パッケージを使用
library(proxy)
# ggplot2 パッケージを使用
library(ggplot2)
# ggdendro パッケージを使用
library(ggdendro)

#ユークリッド距離行列を求める
d_dist <- dist(d_scale, method="Euclidean")
#ウォード法でコーフェン行列を求める
d_clust <- hclust(d_dist, "ward.D")
#５つのグループに分ける
d_clust.df <- data.frame(
    label = d_clust$labels, 
    cluster = cutree(d_clust, k=5)
)
#樹形図描画情報を取得
d_dendr <- dendro_data(d_clust, type="rectangle")
#グループ分け情報とマージ
d_dendr$labels <- merge(d_dendr$labels, d_clust.df, by="label")

# フォントを準備
windowsFonts(HGKAI=windowsFont("HG正楷書体-PRO"))
windowsFonts(COURIER=windowsFont("Courier New"))

# 色を準備
RED_5    <- "#ff6b6b" # ■
PINK_5   <- "#f06595" # ■
GRAPE_5  <- "#cc5de8" # ■
VIOLET_5 <- "#845ef7" # ■
INDIGO_5 <- "#5c7cfa" # ■
BLUE_5   <- "#339af0" # ■
CYAN_5   <- "#22b8cf" # ■
TEAL_5   <- "#20c997" # ■
GREEN_5  <- "#51cf66" # ■
LIME_5   <- "#94d82d" # ■
YELLOW_5 <- "#fcc419" # ■
ORANGE_5 <- "#ff922b" # ■

#樹形図を描画
g <- ggplot()
g <- g + geom_segment(
    data=d_dendr$segment, 
    aes(
        x=x, 
        y=y, 
        xend=xend, 
        yend=yend
    )
)
g <- g + geom_text(
    data=d_dendr$label, 
    aes(
        x=x, 
        y=y, 
        label=label, 
        hjust=0,
        color=factor(cluster)
    ), 
    family="COURIER",
    size=3
)
#グループごとの色指定
g <- g + scale_colour_manual(values=c(PINK_5, BLUE_5, GRAPE_5, VIOLET_5, TEAL_5))
#横倒し
g <- g + coord_flip()
#逆向き
g <- g + scale_y_reverse()
#タイトルとフォントを設定
g <- g + labs(title="ユークリッド距離 × ウォード法")
g <- g + theme_bw(
    base_size=12, 
    base_family="HGKAI"
)
g <- g + theme(
    legend.position="none",
    plot.title=element_text(
        hjust=0.5
    ),
    axis.title.x=element_blank(),
    axis.title.y=element_blank(),
    axis.text.x=element_blank(),
    axis.text.y=element_blank(),
)
#グループごとに枠で囲む
g <- g + annotate("rect", xmin=24.5, xmax=26.4, ymin=-9,   ymax=7.5,  alpha=0.03, color=TEAL_5  , fill=TEAL_5  ,size=1)
g <- g + annotate("rect", xmin=26.5, xmax=32.4, ymin=-9,   ymax=7.5,  alpha=0.03, color=BLUE_5  , fill=BLUE_5  ,size=1)
g <- g + annotate("rect", xmin=18.5, xmax=24.4, ymin=-9,   ymax=7.5,  alpha=0.03, color=VIOLET_5, fill=VIOLET_5,size=1)
g <- g + annotate("rect", xmin=12.5, xmax=18.4, ymin=-9,   ymax=7.5,  alpha=0.03, color=GRAPE_5 , fill=GRAPE_5 ,size=1)
g <- g + annotate("rect", xmin=0.5,  xmax=12.4, ymin=-9,   ymax=7.5,  alpha=0.03, color=PINK_5  , fill=PINK_5  ,size=1)
print(g)