地域(municipality)と政党のクラスタリング：参議院議員選挙2025年福岡のデータに基づいて

1.地域のクラスタリング

# 必要なライブラリの読み込み
if (!require("FactoMineR")) install.packages("FactoMineR")

## 要求されたパッケージ FactoMineR をロード中です

if (!require("factoextra")) install.packages("factoextra")

## 要求されたパッケージ factoextra をロード中です

## 要求されたパッケージ ggplot2 をロード中です

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

if (!require("ggplot2")) install.packages("ggplot2")

library(FactoMineR)
library(factoextra)
library(ggplot2)

# 1. データの読み込み
df <- read.csv("data_PC.csv", row.names = 1, check.names = FALSE)

rownames(df)

##  [1] "門司区"   "小倉北区" "小倉南区" "若松区"   "八幡東区" "八幡西区"
##  [7] "戸畑区"   "東区"     "博多区"   "中央区"   "南区"     "城南区"  
## [13] "早良区"   "西区"     "大牟田市" "久留米市" "直方市"   "飯塚市"  
## [19] "田川市"   "柳川市"   "八女市"   "筑後市"   "大川市"   "行橋市"  
## [25] "豊前市"   "中間市"   "小郡市"   "筑紫野市" "春日市"   "大野城市"
## [31] "宗像市"   "太宰府市" "古賀市"   "福津市"   "うきは市" "宮若市"  
## [37] "嘉麻市"   "朝倉市"   "みやま市" "糸島市"   "那珂川市" "宇美町"  
## [43] "篠栗町"   "志免町"   "須恵町"   "新宮町"   "久山町"   "粕屋町"  
## [49] "芦屋町"   "水巻町"   "岡垣町"   "遠賀町"   "小竹町"   "鞍手町"  
## [55] "桂川町"   "筑前町"   "東峰村"   "大刀洗町" "大木町"   "広川町"  
## [61] "香春町"   "添田町"   "糸田町"   "川崎町"   "大任町"   "赤村"    
## [67] "福智町"   "苅田町"   "みやこ町" "吉富町"   "上毛町"   "築上町"

colnames(df)

##  [1] "日本共産党"   "日本維新の会" "無所属連合"   "日本保守党"   "立憲民主党"  
##  [6] "参政党"       "国民民主党"   "チームみらい" "日本誠真会"   "社会民主党"  
## [11] "れいわ新選組" "日本改革党"   "自由民主党"   "再生の道"     "公明党"      
## [16] "ＮＨＫ党"     "KWM"          "SHM"          "TMN"          "NAS"         
## [21] "NKD"          "ITO"          "FRK"          "YMG"          "MRK"         
## [26] "MTS"          "MOR"          "OKS"          "NOD"

# 2. 対応分析 (CA) の実行
res.ca <- CA(df, graph = FALSE)

summary(res.ca)

## 
## Call:
## CA(X = df, graph = FALSE) 
## 
## The chi square of independence between the two variables is equal to 146535.4 (p-value =  0 ).
## 
## Eigenvalues
##                        Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
## Variance               0.017   0.007   0.003   0.002   0.001   0.001   0.001
## % of var.             53.280  21.224   8.393   6.197   3.301   2.441   1.798
## Cumulative % of var.  53.280  74.504  82.897  89.094  92.395  94.836  96.634
##                        Dim.8   Dim.9  Dim.10  Dim.11  Dim.12  Dim.13  Dim.14
## Variance               0.000   0.000   0.000   0.000   0.000   0.000   0.000
## % of var.              0.765   0.490   0.405   0.392   0.249   0.212   0.177
## Cumulative % of var.  97.400  97.890  98.295  98.688  98.937  99.149  99.326
##                       Dim.15  Dim.16  Dim.17  Dim.18  Dim.19  Dim.20  Dim.21
## Variance               0.000   0.000   0.000   0.000   0.000   0.000   0.000
## % of var.              0.147   0.108   0.082   0.067   0.054   0.045   0.043
## Cumulative % of var.  99.473  99.581  99.663  99.729  99.783  99.829  99.871
##                       Dim.22  Dim.23  Dim.24  Dim.25  Dim.26  Dim.27  Dim.28
## Variance               0.000   0.000   0.000   0.000   0.000   0.000   0.000
## % of var.              0.035   0.026   0.019   0.018   0.015   0.012   0.002
## Cumulative % of var.  99.906  99.933  99.952  99.970  99.986  99.998 100.000
## 
## Rows (the 10 first)
##            Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
## 門司区   |     0.800 | -0.156  2.505  0.534 |  0.116  3.482  0.296 |  0.049
## 小倉北区 |     0.402 |  0.025  0.117  0.050 |  0.090  3.806  0.643 |  0.032
## 小倉南区 |     0.407 | -0.032  0.219  0.092 |  0.083  3.778  0.631 |  0.039
## 若松区   |     0.663 | -0.067  0.391  0.101 |  0.126  3.492  0.358 |  0.107
## 八幡東区 |     0.236 | -0.078  0.432  0.312 |  0.081  1.183  0.340 |  0.052
## 八幡西区 |     0.389 | -0.027  0.188  0.083 |  0.077  3.945  0.689 |  0.035
## 戸畑区   |     0.513 | -0.048  0.148  0.049 |  0.127  2.590  0.343 |  0.116
## 東区     |     0.849 |  0.111  4.606  0.925 |  0.018  0.290  0.023 |  0.010
## 博多区   |     2.646 |  0.220 13.046  0.841 |  0.043  1.234  0.032 | -0.052
## 中央区   |     3.166 |  0.251 15.545  0.837 | -0.066  2.677  0.057 |  0.026
##             ctr   cos2  
## 門司区    1.576  0.053 |
## 小倉北区  1.227  0.082 |
## 小倉南区  2.172  0.144 |
## 若松区    6.274  0.254 |
## 八幡東区  1.224  0.139 |
## 八幡西区  2.030  0.140 |
## 戸畑区    5.490  0.287 |
## 東区      0.249  0.008 |
## 博多区    4.697  0.048 |
## 中央区    1.067  0.009 |
## 
## Columns (the 10 first)
##                Iner*1000    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
## 日本共産党   |     1.565 | -0.076  0.654  0.071 |  0.189 10.239  0.444 |  0.148
## 日本維新の会 |     0.528 |  0.125  2.267  0.732 | -0.001  0.000  0.000 | -0.009
## 無所属連合   |     0.070 |  0.106  0.125  0.305 | -0.027  0.020  0.020 |  0.000
## 日本保守党   |     0.940 |  0.166  4.888  0.886 |  0.017  0.131  0.009 |  0.014
## 立憲民主党   |     0.950 | -0.079  2.104  0.378 | -0.061  3.188  0.228 |  0.057
## 参政党       |     0.638 |  0.073  2.361  0.631 | -0.006  0.035  0.004 | -0.020
## 国民民主党   |     1.940 |  0.168 10.445  0.918 |  0.000  0.000  0.000 | -0.002
## チームみらい |     1.662 |  0.338  7.935  0.814 | -0.031  0.166  0.007 |  0.044
## 日本誠真会   |     0.078 |  0.088  0.176  0.384 | -0.018  0.018  0.016 |  0.032
## 社会民主党   |     0.396 | -0.094  0.580  0.250 |  0.033  0.178  0.030 | -0.036
##                 ctr   cos2  
## 日本共産党   16.021  0.275 |
## 日本維新の会  0.074  0.004 |
## 無所属連合    0.000  0.000 |
## 日本保守党    0.226  0.006 |
## 立憲民主党    7.098  0.201 |
## 参政党        1.121  0.047 |
## 国民民主党    0.006  0.000 |
## チームみらい  0.866  0.014 |
## 日本誠真会    0.145  0.050 |
## 社会民主党    0.527  0.036 |

# 3. 地域の座標を抽出
region_coords <- as.data.frame(res.ca$row$coord)
colnames(region_coords) <- paste0("Dim", 1:ncol(region_coords))

knitr::kable(round(region_coords,digits = 3))

	Dim1	Dim2	Dim3	Dim4	Dim5
門司区	-0.156	0.116	0.049	0.019	-0.035
小倉北区	0.025	0.090	0.032	0.026	-0.041
小倉南区	-0.032	0.083	0.039	-0.018	0.003
若松区	-0.067	0.126	0.107	0.087	-0.003
八幡東区	-0.078	0.081	0.052	0.031	-0.028
八幡西区	-0.027	0.077	0.035	-0.010	0.009
戸畑区	-0.048	0.127	0.116	0.104	-0.042
東区	0.111	0.018	0.010	-0.005	0.006
博多区	0.220	0.043	-0.052	-0.033	-0.032
中央区	0.251	-0.066	0.026	0.043	-0.048
南区	0.116	-0.010	0.007	-0.015	-0.012
城南区	0.080	-0.024	0.023	0.029	0.002
早良区	0.084	-0.003	0.006	0.006	-0.013
西区	0.096	-0.028	0.012	0.010	0.029
大牟田市	-0.216	0.070	0.108	-0.027	0.000
久留米市	-0.054	-0.045	-0.031	-0.033	-0.018
直方市	-0.113	0.044	-0.024	0.053	0.027
飯塚市	-0.142	0.036	-0.070	0.015	-0.026
田川市	-0.176	0.163	-0.051	0.060	0.110
柳川市	-0.208	-0.167	0.015	-0.034	-0.040
八女市	-0.271	-0.212	0.142	-0.117	-0.037
筑後市	-0.139	-0.111	0.073	-0.128	0.012
大川市	-0.184	-0.135	-0.057	0.006	-0.067
行橋市	-0.010	-0.047	-0.053	0.036	0.057
豊前市	-0.183	-0.119	-0.088	0.110	0.004
中間市	-0.175	0.119	0.006	-0.003	-0.010
小郡市	-0.016	-0.147	0.009	0.042	0.033
筑紫野市	0.020	-0.077	0.019	-0.018	0.033
春日市	0.039	-0.018	-0.048	-0.025	0.002
大野城市	0.063	-0.046	-0.033	-0.033	0.017
宗像市	0.025	-0.022	0.052	0.058	0.069
太宰府市	0.002	-0.047	0.004	-0.006	0.044
古賀市	-0.001	0.004	-0.027	-0.020	0.041
福津市	0.060	-0.021	0.013	0.019	0.067
うきは市	-0.200	-0.054	-0.062	0.000	-0.011
宮若市	-0.170	0.074	-0.066	-0.021	-0.002
嘉麻市	-0.321	0.105	-0.090	-0.039	-0.045
朝倉市	-0.208	-0.209	-0.095	0.101	-0.053
みやま市	-0.230	-0.277	0.075	-0.009	0.006
糸島市	-0.038	-0.055	-0.030	0.023	0.007
那珂川市	0.000	0.060	-0.061	-0.015	0.017
宇美町	-0.092	0.122	-0.069	-0.116	-0.025
篠栗町	0.046	0.016	-0.036	-0.050	0.040
志免町	0.064	0.059	-0.072	-0.077	0.026
須恵町	-0.010	0.096	-0.104	-0.096	0.007
新宮町	0.139	-0.040	-0.021	-0.012	0.034
久山町	-0.027	0.003	-0.077	-0.001	-0.009
粕屋町	0.113	0.050	-0.053	-0.051	0.000
芦屋町	-0.173	0.028	-0.085	0.000	-0.064
水巻町	-0.135	0.166	0.038	0.011	-0.029
岡垣町	-0.065	0.025	0.002	0.006	0.063
遠賀町	-0.133	-0.025	0.037	0.055	0.014
小竹町	-0.280	0.076	-0.026	0.064	-0.035
鞍手町	-0.201	0.084	-0.070	0.016	0.003
桂川町	-0.218	0.051	-0.006	-0.011	0.039
筑前町	-0.104	-0.083	-0.044	-0.018	-0.001
東峰村	-0.297	-0.415	-0.171	0.263	-0.177
大刀洗町	-0.043	-0.138	-0.034	0.048	0.028
大木町	-0.121	-0.117	-0.023	-0.050	0.011
広川町	-0.199	-0.218	0.158	-0.146	0.038
香春町	-0.284	0.086	-0.107	0.049	0.016
添田町	-0.358	0.054	-0.068	0.041	-0.031
糸田町	-0.296	0.215	-0.165	-0.054	0.009
川崎町	-0.391	0.275	-0.163	-0.008	-0.043
大任町	-0.325	0.182	-0.230	-0.092	-0.072
赤村	-0.276	0.019	-0.147	0.024	0.028
福智町	-0.206	0.127	-0.119	0.037	0.083
苅田町	0.069	0.009	-0.056	-0.010	0.080
みやこ町	-0.214	-0.097	-0.025	0.075	0.020
吉富町	-0.156	-0.015	-0.027	0.107	-0.031
上毛町	-0.163	-0.192	-0.049	0.153	0.049
築上町	-0.194	-0.252	-0.140	0.250	-0.055

# 4. クラスター分析の実行（階層的クラスタリング）
dist_matrix <- dist(region_coords[, 1:2]) 
hc <- hclust(dist_matrix, method = "ward.D2")

# クラスター数は 5 とします
k_clusters <- 5
clusters <- cutree(hc, k = k_clusters)

# 結果の整理
region_results <- data.frame(
  region = rownames(region_coords),
  Dim1 = region_coords$Dim1,
  Dim2 = region_coords$Dim2,
  cluster = as.factor(clusters)
)

# 5. 可視化
p <- ggplot(region_results, aes(x = Dim1, y = Dim2, color = cluster, label = region)) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray60") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray60") +
  # 点の凡例だけを表示させる
  geom_point(size = 2, alpha = 0.7) +
  # show.legend = FALSE を追加して凡例から「a」を消去
  geom_text(vjust = -1, size = 3, family = "HiraKakuProN-W3", 
            check_overlap = TRUE, show.legend = FALSE) +
  labs(title = "対応分析に基づく地域のクラスタリング",
       subtitle = paste0("支持傾向の類似した地域を ", k_clusters, " グループに分類"),
       x = paste0("第1次元 (", round(res.ca$eig[1, 2], 1), "%)"),
       y = paste0("第2次元 (", round(res.ca$eig[2, 2], 1), "%)"),
       color = "クラスター") +
  # テーマとフォント設定を適用
  theme_minimal(base_family="HiraKakuProN-W3") +
  theme(legend.position = "right")

# グラフの表示
print(p)

2. 政党のクラスタリング

# 必要なライブラリの読み込み
if (!require("FactoMineR")) install.packages("FactoMineR")
if (!require("factoextra")) install.packages("factoextra")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("ggrepel")) install.packages("ggrepel") # ラベル調整用

## 要求されたパッケージ ggrepel をロード中です

library(FactoMineR)
library(factoextra)
library(ggplot2)
library(ggrepel)

# --- (データ読み込み・計算部分は変更なし) ---
df <- read.csv("data_PC.csv", row.names = 1, check.names = FALSE)

df <- df[,1:16] # 政党のデータだけを取り出す

colnames(df)

##  [1] "日本共産党"   "日本維新の会" "無所属連合"   "日本保守党"   "立憲民主党"  
##  [6] "参政党"       "国民民主党"   "チームみらい" "日本誠真会"   "社会民主党"  
## [11] "れいわ新選組" "日本改革党"   "自由民主党"   "再生の道"     "公明党"      
## [16] "ＮＨＫ党"

res.ca <- CA(df, graph = FALSE)
party_coords <- as.data.frame(res.ca$col$coord)
colnames(party_coords) <- c("Dim1", "Dim2", "Dim3", "Dim4", "Dim5")
dist_matrix <- dist(party_coords[, 1:2])
hc <- hclust(dist_matrix, method = "ward.D2")
k_clusters <- 4
clusters <- cutree(hc, k = k_clusters)
party_results <- data.frame(
  party = rownames(party_coords),
  Dim1 = party_coords$Dim1,
  Dim2 = party_coords$Dim2,
  cluster = as.factor(clusters)
)

# 5. 可視化（修正版）
p <- ggplot(party_results, aes(x = Dim1, y = Dim2, color = cluster, label = party)) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray") +
  geom_point(size = 3) +
  # geom_textの代わりにgeom_text_repelを使用
  geom_text_repel(
    family = "HiraKakuProN-W3",
    force = 2,              # 反発の強さ
    box.padding = 0.5,      # テキスト周りの余白
    point.padding = 0.3,    # 点との距離
    show.legend = FALSE
  ) +
  labs(title = "対応分析に基づく政党のクラスタリング",
       subtitle = paste0("階層的クラスタリング (k=", k_clusters, ")"),
       x = paste0("第1次元 (", round(res.ca$eig[1, 2], 1), "%)"),
       y = paste0("第2次元 (", round(res.ca$eig[2, 2], 1), "%)"),
       color = "クラスター") +
  # 軸の範囲を少し広げる（マージンの確保）
  expand_limits(x = c(min(party_results$Dim1)*1.2, max(party_results$Dim1)*1.2),
                y = c(min(party_results$Dim2)*1.2, max(party_results$Dim2)*1.2)) +
  theme_minimal(base_family="HiraKakuProN-W3") +
  theme(legend.position = "right")

# グラフの表示
print(p)

# （任意）デンドログラムの表示
plot(hc, hang = -1, main = "政党のクラスタリング（デンドログラム）", family = "HiraKakuProN-W3")