衆院選2024福岡11区
Yutaka
2025-11-07
比例投票
# データの読み込み
data <- readRDS("d11ku2024.RDS")data <- data[,-11] # 11列目の小計を削除
# 政党名をアルファベットの略号に変える。
colnames(data) <- c("","JCP","RS","CDP","DPP","JIP","SDP","LDP","NKP","SAN")# 市町村名の略号を読み込む
Fkk72names <- readRDS("Fkk72names.RDS")# 福岡11区のリスト
Fkk72names[c(19,24,25,61,62,63,64,65,66,67,68,69,70,71,72)]## [1] "Tgws" "Ykhs" "Bzns" "Kwrm" "Sdmc" "Itdm" "Kwsk" "Otmc" "Akmr" "Fkch"
## [11] "Kndm" "Mykm" "Ysht" "Kgmc" "Chkj"data <- as.data.frame(data) # tibbleでは行名の変更ができないので。
# 行名を略号に変える
rownames(data) <- Fkk72names[c(19,24,25,61,62,63,64,65,66,67,68,69,70,71,72)]
# 表の作成
knitr::kable(data) # 対応分析では1列目は外す。| JCP | RS | CDP | DPP | JIP | SDP | LDP | NKP | SAN | ||
|---|---|---|---|---|---|---|---|---|---|---|
| Tgws | 田川市 | 1511 | 1865 | 2585 | 1253 | 2410 | 1289 | 4272 | 3781 | 632 |
| Ykhs | 行橋市 | 1284 | 2381 | 5042 | 2570 | 4366 | 1308 | 7564 | 4448 | 1224 |
| Bzns | 豊前市 | 459 | 839 | 1722 | 744 | 1440 | 528 | 3337 | 1789 | 423 |
| Kwrm | 香春町 | 236 | 366 | 619 | 263 | 549 | 265 | 1244 | 1085 | 136 |
| Sdmc | 添田町 | 215 | 314 | 540 | 189 | 448 | 215 | 1237 | 980 | 81 |
| Itdm | 糸田町 | 182 | 337 | 504 | 151 | 396 | 205 | 737 | 994 | 90 |
| Kwsk | 川崎町 | 346 | 541 | 637 | 269 | 671 | 360 | 1418 | 2099 | 142 |
| Otmc | 大任町 | 65 | 240 | 232 | 87 | 206 | 105 | 601 | 902 | 52 |
| Akmr | 赤村 | 53 | 101 | 216 | 65 | 159 | 82 | 345 | 371 | 36 |
| Fkch | 福智町 | 464 | 898 | 1119 | 465 | 893 | 634 | 2084 | 2040 | 246 |
| Kndm | 苅田町 | 547 | 1182 | 2259 | 1477 | 1864 | 487 | 3303 | 2068 | 590 |
| Mykm | みやこ町 | 403 | 646 | 1428 | 494 | 1041 | 365 | 2372 | 1593 | 298 |
| Ysht | 吉富町 | 194 | 219 | 469 | 169 | 314 | 99 | 736 | 529 | 103 |
| Kgmc | 上毛町 | 165 | 280 | 645 | 227 | 409 | 172 | 1150 | 504 | 127 |
| Chkj | 築上町 | 303 | 556 | 1100 | 473 | 1352 | 414 | 2608 | 1022 | 251 |
# オブジェクトの保存
data_p <- data対応分析
library(FactoMineR)
library(factoextra)## 要求されたパッケージ ggplot2 をロード中です## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(ca)
library(ggplot2) # ggplot2はfactoextraで使用します# ----------------------------------------------------
# グラフ2: symbiplot (対称バイプロット)
# ----------------------------------------------------
# 全体の相互関係を解釈するのに適しています
library(ca)
# ca::ca()で分析を実行
res.ca_greenacre <- ca(data[,-1])
# ca::plot()でグラフを作成
# こちらはbase R graphicsを使用するため、ggplot2のテーマは適用されません
plot(res.ca_greenacre,
map = "symbiplot",
main = "Symbiplot (Symmetric Biplot)")
# ----------------------------------------------------
# グラフ5: symmetric (対称マップ)
# ----------------------------------------------------
#
# ca()で分析を実行
res.ca_facto <- ca(data[,-1], graph = FALSE)
# factoextra::fviz_ca_biplot()でグラフを作成
fviz_ca_biplot(res.ca_facto,
map = "symmetric",
repel = TRUE) +
labs(title = "Symmetric Map") +
theme_minimal(base_family="HiraKakuProN-W3") +
theme(plot.title = element_text(hjust = 0.5))
result <- ca(data[,-1])
summary(result)##
## Principal inertias (eigenvalues):
##
## dim value % cum% scree plot
## 1 0.025959 66.4 66.4 *****************
## 2 0.006062 15.5 81.9 ****
## 3 0.004286 11.0 92.8 ***
## 4 0.001330 3.4 96.2 *
## 5 0.000758 1.9 98.2
## 6 0.000519 1.3 99.5
## 7 0.000123 0.3 99.8
## 8 7.9e-050 0.2 100.0
## -------- -----
## Total: 0.039115 100.0
##
##
## Rows:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | Tgws | 151 758 114 | -82 230 40 | -125 528 388 |
## 2 | Ykhs | 232 927 123 | 137 908 168 | -19 18 14 |
## 3 | Bzns | 87 897 32 | 80 446 21 | 80 451 92 |
## 4 | Kwrm | 37 956 16 | -119 831 20 | 46 125 13 |
## 5 | Sdmc | 32 876 32 | -144 536 26 | 115 340 71 |
## 6 | Itdm | 28 890 50 | -250 886 67 | -15 3 1 |
## 7 | Kwsk | 50 947 182 | -367 942 259 | 27 5 6 |
## 8 | Otmc | 19 862 117 | -432 784 138 | 136 78 59 |
## 9 | Akmr | 11 780 13 | -177 658 13 | 76 122 11 |
## 10 | Fkch | 68 813 67 | -175 793 80 | -28 20 9 |
## 11 | Kndm | 106 701 111 | 158 609 102 | -61 92 66 |
## 12 | Mykm | 67 500 14 | 16 30 1 | 63 470 43 |
## 13 | Ysht | 22 4 10 | -4 1 0 | -7 3 0 |
## 14 | Kgmc | 28 615 26 | 117 379 15 | 92 236 39 |
## 15 | Chkj | 62 680 93 | 146 366 51 | 135 314 188 |
##
## Columns:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | JCP | 49 587 90 | -103 149 20 | -177 438 255 |
## 2 | RS | 83 765 27 | -58 265 11 | -80 500 88 |
## 3 | CDP | 147 750 78 | 124 747 87 | -7 2 1 |
## 4 | DPP | 68 797 138 | 222 626 130 | -116 171 152 |
## 5 | JIP | 127 690 68 | 120 690 71 | 2 0 0 |
## 6 | SDP | 50 465 60 | -132 371 34 | -66 94 37 |
## 7 | LDP | 254 884 101 | 57 212 32 | 102 672 437 |
## 8 | NKP | 186 949 404 | -283 944 575 | 19 4 11 |
## 9 | SAN | 34 872 34 | 174 780 40 | -59 92 20 |モザイク図
par(family="HiraKakuProN-W3")
mosaicplot(data[,-1],shade=TRUE, main = "福岡11区")
data <- data[,-1]
d <- as.matrix(data)
my_data <- d[c(1,2,3,10,11,15),] # 投票者数の多い地域に限定par(family="HiraKakuProN-W3")
mosaicplot(my_data,shade=TRUE, main = "福岡11区")
各候補者の地域別得票数
library(readr)## Warning: パッケージ 'readr' はバージョン 4.2.3 の R の下で造られました# データの読み込み
data <- readRDS("d20251108.RDS")
data <- data[-16,] # 区計の欄を削除
data <- as.data.frame(data)
# 行と列の名前を変更
rownames(data) <- 1:15
colnames(data) <-c("Municipality","Shiki","Takeda","Murakami")
knitr::kable(data)| Municipality | Shiki | Takeda | Murakami |
|---|---|---|---|
| 田川市 | 2716 | 7723 | 9294 |
| 行橋市 | 3651 | 11829 | 14927 |
| 豊前市 | 1227 | 5201 | 4988 |
| 香春町 | 553 | 2286 | 1942 |
| 添田町 | 436 | 2061 | 1736 |
| 糸田町 | 459 | 1736 | 1403 |
| 川崎町 | 728 | 3368 | 2447 |
| 大任町 | 165 | 1699 | 694 |
| 赤村 | 143 | 748 | 561 |
| 福智町 | 1259 | 4482 | 3181 |
| 苅田町 | 1696 | 5242 | 6760 |
| みやこ町 | 851 | 3862 | 3949 |
| 吉富町 | 341 | 1308 | 1186 |
| 上毛町 | 420 | 1806 | 1486 |
| 築上町 | 652 | 3256 | 4288 |
data <- data[,-1] # 地域名の削除# オブジェクトの保存
data_c <- dataモザイク図
par(family="HiraKakuProN-W3")
# mosaicplot(data,shade=TRUE, main = "福岡11区")
mosaicplot(data,shade=TRUE, main = "福岡11区",dir = c("v","h"))
対応分析
# ----------------------------------------------------
# グラフ2: symbiplot (対称バイプロット)
# ----------------------------------------------------
# 全体の相互関係を解釈するのに適しています
library(ca)
# ca::ca()で分析を実行
res.ca_greenacre <- ca(data)
# ca::plot()でグラフを作成
# こちらはbase R graphicsを使用するため、ggplot2のテーマは適用されません
plot(res.ca_greenacre,
map = "symbiplot",
main = "Symbiplot (Symmetric Biplot)")
# ----------------------------------------------------
# グラフ5: symmetric (対称マップ)
# ----------------------------------------------------
#
# ca()で分析を実行
res.ca_facto <- ca(data, graph = FALSE)
# factoextra::fviz_ca_biplot()でグラフを作成
fviz_ca_biplot(res.ca_facto,
map = "symmetric",
repel = TRUE) +
labs(title = "Symmetric Map") +
theme_minimal(base_family="HiraKakuProN-W3") +
theme(plot.title = element_text(hjust = 0.5))
解説
2024年衆院選福岡11区における比例投票 （田川市、行橋市、豊前市、香春町、添田町、糸田町、川崎町、大任町、赤村、福智町、苅田町、みやこ町、吉富町、上毛町、築上町)
政党別得票率が第4位の政党の候補が小選挙区で当選した。当選した村上氏の得票数は58,842票で、氏が所属する日本維新の会の比例代表の得票数が16,518票であるので、その3.56倍の得票数で当選したことになる。戦略的投票（least worstの選択）をした有権者が多かったということであろう。
日本維新の会が自民党と「連立」を組むという現在の状況では、同じことが起こるかどうかは疑問である。
衆院選2024年小選挙区で、自民党武田良太候補が相対的に見て不振であったのは、田川市、行橋市、苅田町、築上町であったようだ。
逆に言えば、維新の候補が相対的に見て優勢であったのがそれらの市や町であった。
自民と維新が「連立」しているということだが、「選挙区調整」が行われない可能性があるようだ。そうなると、2024年と同じような状況が再現されるのだろうか。
だが、自民と連立した維新への支持は増えるだろうか、減るだろうか。連立の失敗が現実化すれば、支持は減るであろう。
比例代表の得票率が第2位以下の維新以外の政党が協力して候補者を立てれば、当選する可能性がでてきているかもしれない。
自民党との連立を解消した公明党の支持者が相対的に多いのは田川市、福智町である。これらの地域では、自民党の候補が、今までよりも得票数を減らすことは確実であろう。
#———————————–
政党と候補者のファイルの結合
data_pc <- cbind(data_p,data_c)
data <- data_pc
head(data)## Var.1 JCP RS CDP DPP JIP SDP LDP NKP SAN Shiki Takeda Murakami
## Tgws 田川市 1511 1865 2585 1253 2410 1289 4272 3781 632 2716 7723 9294
## Ykhs 行橋市 1284 2381 5042 2570 4366 1308 7564 4448 1224 3651 11829 14927
## Bzns 豊前市 459 839 1722 744 1440 528 3337 1789 423 1227 5201 4988
## Kwrm 香春町 236 366 619 263 549 265 1244 1085 136 553 2286 1942
## Sdmc 添田町 215 314 540 189 448 215 1237 980 81 436 2061 1736
## Itdm 糸田町 182 337 504 151 396 205 737 994 90 459 1736 1403tail(data)## Var.1 JCP RS CDP DPP JIP SDP LDP NKP SAN Shiki Takeda Murakami
## Fkch 福智町 464 898 1119 465 893 634 2084 2040 246 1259 4482 3181
## Kndm 苅田町 547 1182 2259 1477 1864 487 3303 2068 590 1696 5242 6760
## Mykm みやこ町 403 646 1428 494 1041 365 2372 1593 298 851 3862 3949
## Ysht 吉富町 194 219 469 169 314 99 736 529 103 341 1308 1186
## Kgmc 上毛町 165 280 645 227 409 172 1150 504 127 420 1806 1486
## Chkj 築上町 303 556 1100 473 1352 414 2608 1022 251 652 3256 4288caパッケージによる対応分析
# ----------------------------------------------------
# グラフ2: symbiplot (対称バイプロット)
# ----------------------------------------------------
# 全体の相互関係を解釈するのに適しています
library(ca)
# ca::ca()で分析を実行
res.ca_greenacre <- ca(data[,-1])
# ca::plot()でグラフを作成
# こちらはbase R graphicsを使用するため、ggplot2のテーマは適用されません
plot(res.ca_greenacre,
map = "symbiplot",
main = "Symbiplot (Symmetric Biplot)")
# ----------------------------------------------------
# グラフ5: symmetric (対称マップ)
# ----------------------------------------------------
#
# ca()で分析を実行
res.ca_facto <- ca(data[,-1], graph = FALSE)
# factoextra::fviz_ca_biplot()でグラフを作成
fviz_ca_biplot(res.ca_facto,
map = "symmetric",
repel = TRUE) +
labs(title = "Symmetric Map") +
theme_minimal(base_family="HiraKakuProN-W3") +
theme(plot.title = element_text(hjust = 0.5))
result <- ca(data[,-1])
summary(result)##
## Principal inertias (eigenvalues):
##
## dim value % cum% scree plot
## 1 0.018007 64.9 64.9 ****************
## 2 0.005031 18.1 83.1 *****
## 3 0.002274 8.2 91.3 **
## 4 0.001355 4.9 96.1 *
## 5 0.000549 2.0 98.1
## 6 0.000269 1.0 99.1
## 7 0.000135 0.5 99.6
## 8 6.6e-050 0.2 99.8
## 9 3.1e-050 0.1 99.9
## 10 1.8e-050 0.1 100.0
## 11 1e-06000 0.0 100.0
## -------- -----
## Total: 0.027735 100.0
##
##
## Rows:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | Tgws | 151 864 104 | -13 9 1 | -128 855 488 |
## 2 | Ykhs | 232 938 121 | 116 938 175 | -4 1 1 |
## 3 | Bzns | 87 813 26 | 27 87 3 | 77 725 104 |
## 4 | Kwrm | 37 951 17 | -109 913 24 | 22 37 4 |
## 5 | Sdmc | 32 826 30 | -130 659 30 | 65 167 27 |
## 6 | Itdm | 28 902 43 | -192 861 56 | -42 41 10 |
## 7 | Kwsk | 50 931 154 | -282 929 220 | -15 3 2 |
## 8 | Otmc | 19 935 159 | -435 831 204 | 154 103 91 |
## 9 | Akmr | 11 873 15 | -170 769 18 | 62 104 9 |
## 10 | Fkch | 68 805 91 | -169 768 108 | -37 37 18 |
## 11 | Kndm | 105 706 98 | 133 689 104 | -21 17 9 |
## 12 | Mykm | 66 574 14 | 2 1 0 | 58 573 45 |
## 13 | Ysht | 22 73 9 | -28 68 1 | 7 5 0 |
## 14 | Kgmc | 28 449 25 | 19 15 1 | 102 435 59 |
## 15 | Chkj | 62 626 95 | 126 372 55 | 104 254 134 |
##
## Columns:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | JCP | 25 689 64 | -58 47 5 | -214 641 225 |
## 2 | RS | 41 726 19 | -47 170 5 | -85 555 59 |
## 3 | CDP | 73 677 56 | 117 653 56 | 23 24 7 |
## 4 | DPP | 34 693 98 | 230 660 100 | -51 33 18 |
## 5 | JIP | 63 793 48 | 128 783 58 | 15 10 3 |
## 6 | SDP | 25 534 42 | -110 260 17 | -113 274 64 |
## 7 | LDP | 127 802 70 | 40 107 12 | 103 695 267 |
## 8 | NKP | 93 940 282 | -280 930 404 | -28 9 15 |
## 9 | SAN | 17 772 24 | 173 768 28 | -13 4 1 |
## 10 | Shik | 59 767 46 | 6 2 0 | -129 766 193 |
## 11 | Takd | 217 960 138 | -117 782 167 | 56 178 135 |
## 12 | Mrkm | 226 875 114 | 109 852 150 | -18 23 15 |FactoMineRによる対応分析
# 必要なパッケージのインストールと読み込み
if (!require("tidyverse")) install.packages("tidyverse")## 要求されたパッケージ tidyverse をロード中です## Warning: パッケージ 'tidyr' はバージョン 4.2.3 の R の下で造られました## Warning: パッケージ 'dplyr' はバージョン 4.2.3 の R の下で造られました## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ stringr 1.5.0
## ✔ forcats 1.0.0 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsif (!require("FactoMineR")) install.packages("FactoMineR") # 対応分析用
if (!require("factoextra")) install.packages("factoextra") # 視覚化用
library(tidyverse)
library(FactoMineR)
library(factoextra)df_matrix <-data[,-1]対応分析の実行
# 4. 対応分析 (Correspondence Analysis) の実行
res_ca <- CA(df_matrix, graph = FALSE)
# 5. 結果のプロット (ggplot2 + 指定テーマ)
# 指定のテーマ設定
custom_theme <- theme_minimal(base_family = "HiraKakuProN-W3") +
theme(
text = element_text(family = "HiraKakuProN-W3"),
plot.title = element_text(hjust = 0.5),
legend.position = "right"
)
# バイプロット（行と列を同時に表示）
plot_ca <- fviz_ca_biplot(res_ca,
repel = TRUE, # テキストの重なりを回避
col.row = "blue", # 市区町村の色
col.col = "red", # 政党・候補者の色
title = "対応分析 (Biplot)",
labelsize = 4 # ラベルサイズ（適宜調整）
) +
custom_theme
# プロットの表示
print(plot_ca)
# 保存する場合
ggsave("ca_result.png", plot = plot_ca, width = 10, height = 8)固有値・寄与率
# 固有値・寄与率のリストを取得
eig_val <- get_eigenvalue(res_ca)
# コンソールに表示
print(eig_val)## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 1.800711e-02 64.924844222 64.92484
## Dim.2 5.030533e-03 18.137644174 83.06249
## Dim.3 2.273968e-03 8.198816391 91.26130
## Dim.4 1.355102e-03 4.885833479 96.14714
## Dim.5 5.486022e-04 1.977991290 98.12513
## Dim.6 2.692331e-04 0.970722853 99.09585
## Dim.7 1.351541e-04 0.487299599 99.58315
## Dim.8 6.570407e-05 0.236896753 99.82005
## Dim.9 3.126103e-05 0.112711989 99.93276
## Dim.10 1.751727e-05 0.063158696 99.99592
## Dim.11 1.131755e-06 0.004080554 100.00000# 必要であればCSVに保存
# write.csv(eig_val, "eigenvalues.csv")対応分析の結果の要約(表)
# 分析結果の要約を表示（先頭に固有値の表が出ます）
summary(res_ca)##
## Call:
## CA(X = df_matrix, graph = FALSE)
##
## The chi square of independence between the two variables is equal to 7228.961 (p-value = 0 ).
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 0.018 0.005 0.002 0.001 0.001 0.000 0.000
## % of var. 64.925 18.138 8.199 4.886 1.978 0.971 0.487
## Cumulative % of var. 64.925 83.062 91.261 96.147 98.125 99.096 99.583
## Dim.8 Dim.9 Dim.10 Dim.11
## Variance 0.000 0.000 0.000 0.000
## % of var. 0.237 0.113 0.063 0.004
## Cumulative % of var. 99.820 99.933 99.996 100.000
##
## Rows (the 10 first)
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## Tgws | 2.872 | -0.013 0.145 0.009 | 0.128 48.828 0.855 | -0.049 15.884
## Ykhs | 3.356 | 0.116 17.473 0.938 | 0.004 0.057 0.001 | 0.025 6.172
## Bzns | 0.720 | 0.027 0.348 0.087 | -0.077 10.381 0.725 | -0.014 0.723
## Kwrm | 0.477 | -0.109 2.418 0.913 | -0.022 0.354 0.037 | -0.010 0.171
## Sdmc | 0.825 | -0.130 3.020 0.659 | -0.065 2.738 0.167 | -0.046 2.994
## Itdm | 1.180 | -0.192 5.641 0.861 | 0.042 0.972 0.041 | 0.027 0.877
## Kwsk | 4.266 | -0.282 22.000 0.929 | 0.015 0.228 0.003 | 0.018 0.678
## Otmc | 4.415 | -0.435 20.386 0.831 | -0.154 9.082 0.103 | 0.095 7.741
## Akmr | 0.414 | -0.170 1.768 0.769 | -0.062 0.856 0.104 | 0.022 0.230
## Fkch | 2.524 | -0.169 10.771 0.768 | 0.037 1.842 0.037 | 0.002 0.016
## cos2
## Tgws 0.126 |
## Ykhs 0.042 |
## Bzns 0.023 |
## Kwrm 0.008 |
## Sdmc 0.083 |
## Itdm 0.017 |
## Kwsk 0.004 |
## Otmc 0.040 |
## Akmr 0.013 |
## Fkch 0.000 |
##
## Columns (the 10 first)
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## JCP | 1.763 | -0.058 0.462 0.047 | 0.214 22.485 0.641 | -0.115 14.448
## RS | 0.532 | -0.047 0.504 0.170 | 0.085 5.875 0.555 | 0.020 0.711
## CDP | 1.539 | 0.117 5.582 0.653 | -0.023 0.739 0.024 | 0.044 6.369
## DPP | 2.729 | 0.230 10.002 0.660 | 0.051 1.771 0.033 | 0.147 32.353
## JIP | 1.332 | 0.128 5.789 0.783 | -0.015 0.278 0.010 | -0.023 1.449
## SDP | 1.167 | -0.110 1.686 0.260 | 0.113 6.356 0.274 | -0.117 15.195
## LDP | 1.932 | 0.040 1.151 0.107 | -0.103 26.700 0.695 | -0.047 12.553
## NKP | 7.816 | -0.280 40.368 0.930 | 0.028 1.466 0.009 | 0.037 5.739
## SAN | 0.664 | 0.173 2.831 0.768 | 0.013 0.055 0.004 | 0.077 4.386
## Shiki | 1.266 | 0.006 0.011 0.002 | 0.129 19.273 0.766 | 0.022 1.261
## cos2
## JCP 0.186 |
## RS 0.030 |
## CDP 0.094 |
## DPP 0.270 |
## JIP 0.025 |
## SDP 0.296 |
## LDP 0.148 |
## NKP 0.017 |
## SAN 0.150 |
## Shiki 0.023 |スクリープロット
# スクリープロット（固有値のグラフ）の表示
fviz_eig(res_ca,
addlabels = TRUE, # グラフの上に％数値を表示
ylim = c(0, 60), # Y軸の範囲（適宜調整）
main = "次元ごとの寄与率 (Scree Plot)"
) +
custom_theme # 日本語フォント設定の適用## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
軸座標と寄与率の関連性
# パッケージの読み込み
if (!require("FactoMineR")) install.packages("FactoMineR")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("ggrepel")) install.packages("ggrepel")## 要求されたパッケージ ggrepel をロード中ですlibrary(FactoMineR)
library(ggplot2)
library(ggrepel)
# 対応分析の実行
res.ca <- CA(df_matrix, graph = FALSE)
# --- 第1軸のデータ抽出 ---
# 行（地域）のデータ
row_data <- data.frame(
Name = rownames(res.ca$row$coord),
Coord = res.ca$row$coord[, 1], # 第1軸の座標
Contrib = res.ca$row$contrib[, 1], # 第1軸への寄与度(%)
Type = "Region" # カテゴリ（地域）
)
# 列（政党）のデータ
col_data <- data.frame(
Name = rownames(res.ca$col$coord),
Coord = res.ca$col$coord[, 1], # 第1軸の座標
Contrib = res.ca$col$contrib[, 1], # 第1軸への寄与度(%)
Type = "Party" # カテゴリ（政党）
)
# データを結合
plot_data <- rbind(row_data, col_data)
# --- プロット作成 ---
ggplot(plot_data, aes(x = Coord, y = Contrib, color = Type, label = Name)) +
# 基準線（座標0）
geom_vline(xintercept = 0, linetype = "dashed", color = "gray") +
# 点の描画
geom_point(size = 3, alpha = 0.8) +
# ラベルの描画（重なり防止）
geom_text_repel(family = "HiraKakuProN-W3", size = 3.5, max.overlaps = 20) +
# タイトルと軸ラベル
labs(
title = "第1軸: 座標と寄与度の関係",
subtitle = "",
x = "第1軸 座標 (Coordinate)",
y = "第1軸 寄与度 (Contribution %)",
color = "カテゴリ"
) +
# テーマ設定（日本語フォント指定）
theme_minimal(base_family = "HiraKakuProN-W3") +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold"),
axis.title = element_text(face = "bold")
)
# 画像を保存する場合
# ggsave("dim1_coord_contrib.png", width = 10, height = 7)# パッケージの読み込み
if (!require("FactoMineR")) install.packages("FactoMineR")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("ggrepel")) install.packages("ggrepel")
library(FactoMineR)
library(ggplot2)
library(ggrepel)
# 対応分析の実行
res.ca <- CA(df_matrix, graph = FALSE)
# --- 第2軸のデータ抽出 ---
# 行（地域）のデータ：インデックスを 2 に変更
row_data <- data.frame(
Name = rownames(res.ca$row$coord),
Coord = res.ca$row$coord[, 2], # 第2軸の座標
Contrib = res.ca$row$contrib[, 2], # 第2軸への寄与度(%)
Type = "Region"
)
# 列（政党）のデータ：インデックスを 2 に変更
col_data <- data.frame(
Name = rownames(res.ca$col$coord),
Coord = res.ca$col$coord[, 2], # 第2軸の座標
Contrib = res.ca$col$contrib[, 2], # 第2軸への寄与度(%)
Type = "Party"
)
# データを結合
plot_data <- rbind(row_data, col_data)
# --- プロット作成 ---
ggplot(plot_data, aes(x = Coord, y = Contrib, color = Type, label = Name)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray") +
geom_point(size = 3, alpha = 0.8) +
geom_text_repel(family = "HiraKakuProN-W3", size = 3.5, max.overlaps = 20) +
labs(
title = "第2軸: 座標と寄与度の関係",
subtitle = "",
x = "第2軸 座標 (Coordinate)",
y = "第2軸 寄与度 (Contribution %)",
color = "カテゴリ"
) +
theme_minimal(base_family = "HiraKakuProN-W3") +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold"),
axis.title = element_text(face = "bold")
)
# 画像を保存する場合
# ggsave("dim2_coord_contrib.png", width = 10, height = 7)