比例投票

# データの読み込み
data <- readRDS("d11ku2024.RDS")
#data

data <- data[,-11] # 11列目の小計を削除

# 政党名をアルファベットの略号に変える。
colnames(data) <- c("","JCP","RS","CDP","DPP","JIP","SDP","LDP","NKP","SAN")
#data

# 市町村名の略号を読み込む
Fkk72names <- readRDS("Fkk72names.RDS")
# Fkk72names

# 福岡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

対応分析

library(FactoMineR)
library(factoextra)

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

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

library(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 <- read_csv("データ.csv")
#saveRDS(data,"d20251108.RDS")

# データの読み込み
data <- readRDS("d20251108.RDS")

data <- data[-16,] # 区計の欄を削除

# str(data)

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] # 地域名の削除

モザイク図

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位以下の維新以外の政党が協力して候補者を立てれば、当選する可能性がでてきているかもしれない。

自民党との連立を解消した公明党の支持者が相対的に多いのは田川市、福智町である。これらの地域では、自民党の候補が、今までよりも得票数を減らすことは確実であろう。

衆院選2024福岡11区

Yutaka

2025-11-07

比例投票

対応分析

モザイク図

各候補者の地域別得票数

モザイク図

対応分析

解説