- 対応分析とクラスタリング(2026年3月25日投稿記事関連)
SASのコード
/* 1. データの読み込み */
proc import datafile="data_parties.csv"
out=work.parties_raw dbms=csv replace;
getnames=yes;
run;
/* 2. 対応分析の実行 */
proc corresp data=work.parties_raw dimens=3 outc=work.coords;
id 市区町村名;
var 日本共産党 -- ＮＨＫ党;
run;
/* 3. 政党（VAR）側のクラスター分析を実行 */
proc cluster data=work.coords(where=(_TYPE_='VAR'))
method=ward outtree=work.tree_var;
/* _NAME_ ではなく、PROC CORRESP の ID文で指定した変数名を使います */
id 市区町村名;
var Dim1 Dim2 Dim3;
run;
/* 4. デンドログラム（樹形図）の表示 */
proc tree data=work.tree_var;
title "政党の階層的クラスター分析（デンドログラム）";
run;
/* 5. クラスター所属リスト（4グループ）の出力 */
proc tree data=work.tree_var nclusters=4 out=work.party_clusters;
id 市区町村名;
run;
title "政党のクラスター分類結果（所属リスト）";
proc print data=work.party_clusters noobs;
var cluster 市区町村名;
label cluster="グループ" 市区町村名="政党名";
run;
1. 政党の対応分析とクラスター分類（統合マップ）
# 1. 必要なライブラリの読み込み
library(FactoMineR)
library(factoextra)
## 要求されたパッケージ ggplot2 をロード中です
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(ggplot2)
library(ggrepel) # 政党名の重なりを防ぐために使用
library(dplyr)
##
## 次のパッケージを付け加えます: 'dplyr'
## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter, lag
## 以下のオブジェクトは 'package:base' からマスクされています:
##
## intersect, setdiff, setequal, union
library(tibble)
# AONF形式のキャプション定義
AONF_CAPTION <- "Archives from 2026 Onward and Notes for the Future\n2026年以降の記録 | https://ab.cocolog-nifty.com/note/"
# 2. データの読み込み
df_raw <- read.csv("data_parties.csv", check.names = FALSE)
# head(df_raw)
# 分析用データの整形（市区町村名を行名にし、数値列のみ抽出）
df_analysis <- df_raw %>%
column_to_rownames("市区町村名") %>%
select(`日本共産党`:`ＮＨＫ党`)
# head(df_analysis)
# 3. 対応分析 (CA) の実行
res_ca <- CA(df_analysis, ncp = 3, graph = FALSE)
# 4. 政党（列）の座標抽出とクラスター分析 (Ward法)
col_coords <- as.data.frame(res_ca$col$coord)
dist_matrix <- dist(col_coords)
hc_result <- hclust(dist_matrix, method = "ward.D2")
# クラスターの分割（4グループ）
k_num <- 4
col_coords$cluster <- as.factor(cutree(hc_result, k = k_num))
col_coords$party_name <- rownames(col_coords)
# 5. ggplot2 による統合可視化
# 軸の寄与率（%）を取得
eig_val <- res_ca$eig
dim1_pct <- round(eig_val[1, 2], 1)
dim2_pct <- round(eig_val[2, 2], 1)
p <- ggplot(col_coords, aes(x = `Dim 1`, y = `Dim 2`, color = cluster)) +
# 点の描画
geom_point(size = 3) +
# 政党名の描画（重ならないように調整）
geom_text_repel(aes(label = party_name),
family = "HiraKakuProN-W3",
size = 4,
box.padding = 0.5) +
# AONF形式の設定
theme_minimal(base_family = "HiraKakuProN-W3") +
labs(title = "政党の対応分析とクラスター分類（統合マップ）",
x = paste0("Dimension 1 (", dim1_pct, "%)"),
y = paste0("Dimension 2 (", dim2_pct, "%)"),
color = "グループ",
caption = AONF_CAPTION) +
theme(legend.position = "bottom",
plot.caption = element_text(size = 8, hjust = 1, color = "gray30"))
# プロットの表示
print(p)
# 6. 所属リストの出力（SASのPROC PRINTに相当）
party_list <- col_coords %>%
select(party_name, cluster) %>%
rename(政党名 = party_name, グループ = cluster) %>%
arrange(グループ)
print(party_list)
## 政党名 グループ
## 日本共産党 日本共産党 1
## 日本維新の会 日本維新の会 2
## 無所属連合 無所属連合 2
## 日本保守党 日本保守党 2
## 参政党 参政党 2
## 国民民主党 国民民主党 2
## 日本誠真会 日本誠真会 2
## 日本改革党 日本改革党 2
## 再生の道 再生の道 2
## ＮＨＫ党 ＮＨＫ党 2
## 立憲民主党 立憲民主党 3
## 社会民主党 社会民主党 3
## れいわ新選組 れいわ新選組 3
## 自由民主党 自由民主党 3
## 公明党 公明党 3
## チームみらい チームみらい 4
2. 市区町村と政党クラスターの対応分析（バイプロット）
# 1. 必要なライブラリの読み込み
library(FactoMineR)
library(factoextra)
library(ggplot2)
library(ggrepel)
library(dplyr)
library(tibble)
# AONF形式のキャプション定義
AONF_CAPTION <- "Archives from 2026 Onward and Notes for the Future\n2026年以降の記録 | https://ab.cocolog-nifty.com/note/"
# 2. データの読み込み
df_raw <- read.csv("data_parties.csv", check.names = FALSE)
# 分析用データの整形
df_analysis <- df_raw %>%
column_to_rownames("市区町村名") %>%
select(`日本共産党`:`ＮＨＫ党`)
# 3. 対応分析 (CA) の実行
res_ca <- CA(df_analysis, ncp = 3, graph = FALSE)
# 4. 座標データの抽出
# 政党（列）の座標とクラスター分け
col_coords <- as.data.frame(res_ca$col$coord)
dist_matrix <- dist(col_coords)
hc_result <- hclust(dist_matrix, method = "ward.D2")
col_coords$cluster <- as.factor(cutree(hc_result, k = 4))
col_coords$name <- rownames(col_coords)
col_coords$type <- "政党"
# 市区町村（行）の座標
row_coords <- as.data.frame(res_ca$row$coord)
row_coords$cluster <- NA # 市区町村にはクラスター色を割り当てない
row_coords$name <- rownames(row_coords)
row_coords$type <- "市区町村"
# 5. ggplot2 によるバイプロットの作成
# 軸の寄与率を取得
dim1_pct <- round(res_ca$eig[1, 2], 1)
dim2_pct <- round(res_ca$eig[2, 2], 1)
p_biplot <- ggplot() +
# 市区町村（行）を薄いグレーでプロット
geom_point(data = row_coords, aes(x = `Dim 1`, y = `Dim 2`),
color = "grey70", alpha = 0.6, size = 1) +
geom_text_repel(data = row_coords, aes(x = `Dim 1`, y = `Dim 2`, label = name),
family = "HiraKakuProN-W3", color = "grey50", size = 2.5, max.overlaps = 15) +
# 政党（列）をクラスター色で強調プロット
geom_point(data = col_coords, aes(x = `Dim 1`, y = `Dim 2`, color = cluster),
size = 3, shape = 17) + # 政党は▲で表示
geom_text_repel(data = col_coords, aes(x = `Dim 1`, y = `Dim 2`, label = name, color = cluster),
family = "HiraKakuProN-W3", size = 3, fontface = "bold", box.padding = 0.5) +
# テーマとラベルの設定
theme_minimal(base_family = "HiraKakuProN-W3") +
labs(title = "市区町村と政党クラスターの対応分析（バイプロット）",
subtitle = "▲は政党（色分けはクラスター分析結果）、点は市区町村を示す",
x = paste0("Dimension 1 (", dim1_pct, "%)"),
y = paste0("Dimension 2 (", dim2_pct, "%)"),
color = "政党グループ",
caption = AONF_CAPTION) +
theme(legend.position = "bottom",
plot.caption = element_text(size = 8, hjust = 1, color = "gray30"))
# プロットの表示
print(p_biplot)
3. 衆院選福岡11区を構成する自治体と政党クラスター
# 1. 必要なライブラリの読み込み
library(FactoMineR)
library(factoextra)
library(ggplot2)
library(ggrepel)
library(dplyr)
library(tibble)
# AONF形式のキャプション定義
AONF_CAPTION <- "Archives from 2026 Onward and Notes for the Future\n2026年以降の記録 | [https://ab.cocolog-nifty.com/note/](https://ab.cocolog-nifty.com/note/)"
# 2. データの読み込み
df_raw <- read.csv("data_parties.csv", check.names = FALSE)
# 列名が空（""）の列を削除してエラーを回避
df_raw <- df_raw[, names(df_raw) != ""]
# 福岡11区の自治体リスト
fukuoka_11th_dist <- c("田川市", "行橋市", "豊前市",
"香春町", "添田町", "糸田町", "川崎町", "大任町", "赤村", "福智町",
"苅田町", "みやこ町", "吉富町", "上毛町", "築上町")
# 3. 対応分析 (CA) の実行
# 「_percentage」および「合計_vote」を除外し、各党の投票数のみを抽出
df_analysis <- df_raw %>%
column_to_rownames("市区町村名") %>%
# 不要な列（比率データおよび合計値）をまとめて除外
select(-ends_with("_percentage"), -any_of("合計_vote")) %>%
select(where(is.numeric))
res_ca <- CA(df_analysis, ncp = 3, graph = FALSE)
# 4. 座標データの抽出とクラスタリング
# 政党（列）の座標取得と4グループ分類
col_coords <- as.data.frame(res_ca$col$coord)
dist_matrix <- dist(col_coords)
hc_result <- hclust(dist_matrix, method = "ward.D2")
col_coords$cluster <- as.factor(cutree(hc_result, k = 4))
col_coords$name <- rownames(col_coords)
# 市区町村（行）の座標取得と11区へのフィルタリング
row_coords <- as.data.frame(res_ca$row$coord) %>%
rownames_to_column("name") %>%
filter(name %in% fukuoka_11th_dist)
# 5. ggplot2 によるクローズアップ・バイプロット
# 寄与率（%）を取得
eig_val <- res_ca$eig
dim1_pct <- round(eig_val[1, 2], 1)
dim2_pct <- round(eig_val[2, 2], 1)
p_closeup <- ggplot() +
# 11区の自治体を強調
geom_point(data = row_coords, aes(x = `Dim 1`, y = `Dim 2`),
color = "royalblue", size = 3, alpha = 0.8) +
geom_text_repel(data = row_coords, aes(x = `Dim 1`, y = `Dim 2`, label = name),
family = "HiraKakuProN-W3", color = "black", size = 4,
fontface = "bold", box.padding = 0.6, max.overlaps = Inf) +
# 政党（投票数ベース）を配置
geom_point(data = col_coords, aes(x = `Dim 1`, y = `Dim 2`, color = cluster),
size = 4, shape = 17) +
geom_text_repel(data = col_coords, aes(x = `Dim 1`, y = `Dim 2`, label = name, color = cluster),
family = "HiraKakuProN-W3", size = 4, box.padding = 0.5, max.overlaps = Inf) +
# AONF形式のテーマ・キャプション設定
theme_minimal(base_family = "HiraKakuProN-W3") +
# 軸ラベルに寄与率を表示
labs(title = "衆院選福岡11区を構成する自治体と政党クラスター",
subtitle = "2025年参院選における同一範囲のデータ",
x = paste0("Dimension 1 (", dim1_pct, "%)"),
y = paste0("Dimension 2 (", dim2_pct, "%)"),
color = "政党グループ",
caption = AONF_CAPTION) +
theme(legend.position = "bottom",
plot.caption = element_text(size = 8, hjust = 1, color = "gray30"))
# プロットの表示
print(p_closeup)
4.
衆院選福岡11区を構成する自治体と政党クラスター（第1軸×第3軸）
# 1. 必要なライブラリの読み込み
library(FactoMineR)
library(factoextra)
library(ggplot2)
library(ggrepel)
library(dplyr)
library(tibble)
# AONF形式のキャプション定義
AONF_CAPTION <- "Archives from 2026 Onward and Notes for the Future\n2026年以降の記録 | [https://ab.cocolog-nifty.com/note/](https://ab.cocolog-nifty.com/note/)"
# 2. データの読み込み
df_raw <- read.csv("data_parties.csv", check.names = FALSE)
# 【重要】列名が空の列を事前に完全に排除
df_raw <- df_raw[, nzchar(names(df_raw))]
# 福岡11区の自治体リスト
fukuoka_11th_dist <- c("田川市", "行橋市", "豊前市",
"香春町", "添田町", "糸田町", "川崎町", "大任町", "赤村", "福智町",
"苅田町", "みやこ町", "吉富町", "上毛町", "築上町")
# 3. 対応分析 (CA) の実行
# 「_percentage」および「合計_vote」を除外し、数値列のみを抽出
df_analysis <- df_raw %>%
column_to_rownames("市区町村名") %>%
select(-ends_with("_percentage")) %>%
select(-any_of("合計_vote")) %>%
select(where(is.numeric))
# 第3軸を計算に含めるため ncp = 5 程度を確保
res_ca <- CA(df_analysis, ncp = 5, graph = FALSE)
# 4. 座標データの抽出
# 政党（列）の座標取得と4グループ分類
col_coords <- as.data.frame(res_ca$col$coord)
dist_matrix <- dist(col_coords)
hc_result <- hclust(dist_matrix, method = "ward.D2")
col_coords$cluster <- as.factor(cutree(hc_result, k = 4))
col_coords$name <- rownames(col_coords)
# 市区町村（行）の座標取得と11区へのフィルタリング
row_coords <- as.data.frame(res_ca$row$coord) %>%
rownames_to_column("name") %>%
filter(name %in% fukuoka_11th_dist)
# 5. ggplot2 によるバイプロットの作成（第1軸×第3軸）
# 寄与率（%）を取得
eig_val <- res_ca$eig
dim1_pct <- round(eig_val[1, 2], 1)
dim3_pct <- round(eig_val[3, 2], 1)
p_dim1_dim3 <- ggplot() +
# 11区の自治体を強調
geom_point(data = row_coords, aes(x = `Dim 1`, y = `Dim 3`),
color = "royalblue", size = 3, alpha = 0.8) +
geom_text_repel(data = row_coords, aes(x = `Dim 1`, y = `Dim 3`, label = name),
family = "HiraKakuProN-W3", color = "black", size = 4,
fontface = "bold", box.padding = 0.6, max.overlaps = Inf) +
# 政党（投票数ベース）を配置
geom_point(data = col_coords, aes(x = `Dim 1`, y = `Dim 3`, color = cluster),
size = 4, shape = 17) +
geom_text_repel(data = col_coords, aes(x = `Dim 1`, y = `Dim 3`, label = name, color = cluster),
family = "HiraKakuProN-W3", size = 4, box.padding = 0.5, max.overlaps = Inf) +
# テーマ・キャプション設定
theme_minimal(base_family = "HiraKakuProN-W3") +
labs(title = "衆院選福岡11区を構成する自治体と政党クラスター（第1軸×第3軸）",
subtitle = "第3次産業従事者率との相関が示唆される第1軸と、地域独自の構造を示す第3軸",
x = paste0("Dimension 1 (", dim1_pct, "%)"),
y = paste0("Dimension 3 (", dim3_pct, "%)"),
color = "政党グループ",
caption = AONF_CAPTION) +
theme(legend.position = "bottom",
plot.caption = element_text(size = 8, hjust = 1, color = "gray30"))
# プロットの表示
print(p_dim1_dim3)
5. 福岡11区 自治体別 統計一覧
# 対応分析の結果から一覧表を抽出
# 1. 政党（列）の座標値と寄与度
party_stats <- data.frame(
政党名 = rownames(res_ca$col$coord),
座標_Dim1 = res_ca$col$coord[,1],
寄与_Dim1 = res_ca$col$contrib[,1],
座標_Dim2 = res_ca$col$coord[,2],
寄与_Dim2 = res_ca$col$contrib[,2],
座標_Dim3 = res_ca$col$coord[,3],
寄与_Dim3 = res_ca$col$contrib[,3]
)
# 2. 市区町村（行）の座標値と寄与度（11区のみ抽出）
town_stats <- data.frame(
自治体名 = rownames(res_ca$row$coord),
座標_Dim1 = res_ca$row$coord[,1],
寄与_Dim1 = res_ca$row$contrib[,1],
座標_Dim2 = res_ca$row$coord[,2],
寄与_Dim2 = res_ca$row$contrib[,2],
座標_Dim3 = res_ca$row$coord[,3],
寄与_Dim3 = res_ca$row$contrib[,3]
) %>%
filter(自治体名 %in% fukuoka_11th_dist)
# 結果の表示（コンソール出力）
print("--- 政党別 統計一覧 ---")
## [1] "--- 政党別 統計一覧 ---"
print(party_stats)
## 政党名 座標_Dim1 寄与_Dim1 座標_Dim2 寄与_Dim2
## 日本共産党 日本共産党 -0.08683656 1.786656045 0.1983620092 2.788954e+01
## 日本維新の会 日本維新の会 0.12419552 4.598738562 0.0003141415 8.801689e-05
## 無所属連合 無所属連合 0.10596024 0.258140478 -0.0241627677 4.015616e-02
## 日本保守党 日本保守党 0.16417627 9.917416367 0.0295372172 9.602970e-01
## 立憲民主党 立憲民主党 -0.07552475 4.025897377 -0.0602319505 7.659963e+00
## 参政党 参政党 0.07323823 4.858989830 -0.0022378893 1.357176e-02
## 国民民主党 国民民主党 0.16673304 21.217654480 0.0064943663 9.629778e-02
## チームみらい チームみらい 0.33814252 16.421075156 -0.0055810766 1.338217e-02
## 日本誠真会 日本誠真会 0.08681717 0.356289199 -0.0101012965 1.442893e-02
## 社会民主党 社会民主党 -0.09919117 1.328528416 0.0156114824 9.844682e-02
## れいわ新選組 れいわ新選組 -0.05777733 1.472915881 0.0242433650 7.757778e-01
## 日本改革党 日本改革党 0.01471266 0.001191458 0.0011923802 2.341069e-05
## 自由民主党 自由民主党 -0.10853799 14.162463472 -0.0957379072 3.296338e+01
## 再生の道 再生の道 0.03425104 0.068720273 0.0453685678 3.606918e-01
## 公明党 公明党 -0.16849286 18.812371113 0.1198399600 2.846902e+01
## ＮＨＫ党 ＮＨＫ党 0.10678771 0.712951893 0.0587226008 6.449364e-01
## 座標_Dim3 寄与_Dim3
## 日本共産党 0.173937593 50.293202361
## 日本維新の会 0.005575640 0.065028400
## 無所属連合 0.002590765 0.001082712
## 日本保守党 0.004276377 0.047208098
## 立憲民主党 0.049058100 11.917695274
## 参政党 -0.037859613 9.109809017
## 国民民主党 -0.003024343 0.048978198
## チームみらい 0.046386329 2.168046994
## 日本誠真会 0.039175742 0.508993833
## 社会民主党 0.020936961 0.415277827
## れいわ新選組 -0.055667836 9.593084933
## 日本改革党 -0.041637029 0.066948705
## 自由民主党 0.008641534 0.629859477
## 再生の道 -0.020153047 0.166918912
## 公明党 -0.056614216 14.901095201
## ＮＨＫ党 -0.012337827 0.066770057
print("--- 福岡11区 自治体別 統計一覧 ---")
## [1] "--- 福岡11区 自治体別 統計一覧 ---"
print(town_stats)
## 自治体名 座標_Dim1 寄与_Dim1 座標_Dim2 寄与_Dim2 座標_Dim3
## 田川市 田川市 -0.18003324 1.58853960 0.137328426 2.765045e+00 -0.001029959
## 行橋市 行橋市 -0.01580144 0.02168233 -0.050037973 6.504299e-01 -0.013958477
## 豊前市 豊前市 -0.17451530 0.91731012 -0.153453553 2.121738e+00 0.014738497
## 香春町 香春町 -0.29885914 1.07574301 0.039294650 5.563280e-02 -0.029305139
## 添田町 添田町 -0.35263103 1.30795092 0.001752662 9.665749e-05 -0.023452704
## 糸田町 糸田町 -0.30079638 0.82754630 0.148959661 6.071179e-01 -0.167760263
## 川崎町 川崎町 -0.40805145 2.63875682 0.195114758 1.804839e+00 -0.134462673
## 大任町 大任町 -0.32715506 0.61435117 0.112799995 2.184823e-01 -0.250761461
## 赤村 赤村 -0.27065579 0.25205441 -0.049099951 2.481478e-02 -0.063009794
## 福智町 福智町 -0.22803442 1.17765326 0.090443436 5.541909e-01 -0.065895410
## 苅田町 苅田町 0.06087095 0.16297068 -0.004618791 2.806950e-03 -0.047897447
## みやこ町 みやこ町 -0.20127722 0.88841857 -0.090097882 5.325326e-01 0.039671066
## 吉富町 吉富町 -0.16652697 0.22286159 0.007455491 1.336310e-03 0.053223374
## 上毛町 上毛町 -0.15698375 0.23819563 -0.182819722 9.664048e-01 0.079876695
## 築上町 築上町 -0.17263735 0.63336899 -0.186862263 2.219827e+00 0.048539733
## 寄与_Dim3
## 田川市 0.0003647701
## 行橋市 0.1187066866
## 豊前市 0.0459031246
## 香春町 0.0725687586
## 添田町 0.0405903606
## 糸田町 1.8059759204
## 川崎町 2.0102944039
## 大任町 2.5323146899
## 赤村 0.0958434522
## 福智町 0.6899436543
## 苅田町 0.7079470768
## みやこ町 0.2421379128
## 吉富町 0.1597193622
## 上毛町 0.4326644493
## 築上町 0.3512923897
# CSVとして保存する場合（ブログ資料用）
# write.csv(party_stats, "party_stats.csv", row.names = FALSE)
# write.csv(town_stats, "town_stats.csv", row.names = FALSE)