DID人口密度と得票率
Yutaka
2026-03-21
OK版 RPubs公表済み
# --- 1. 設定：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/)"
library(dplyr)##
## 次のパッケージを付け加えます: 'dplyr'## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter, lag## 以下のオブジェクトは 'package:base' からマスクされています:
##
## intersect, setdiff, setequal, unionlibrary(stringr)
library(ggplot2)
library(tidyr)
# --- 2. データの読み込み ---
# DID人口密度データ
did_data <- read.csv("FEI_CITY_260320115508.csv", skip = 1, fileEncoding = "UTF-8", check.names = FALSE, na.strings = "-")
# 選挙結果生データ
elec_raw <- read.csv("data_PC_fixed.csv", fileEncoding = "UTF-8", check.names = FALSE)
head(elec_raw)## municipality 日本共産党 日本維新の会 無所属連合 日本保守党 立憲民主党 参政党
## 1 門司区 2361 1921 126 2249 5077 4970
## 2 小倉北区 3803 3357 313 5025 7420 10500
## 3 小倉南区 4392 3965 284 5101 9975 12703
## 4 若松区 2548 1436 105 1933 3923 4957
## 5 八幡東区 1540 1303 108 1569 3438 3712
## 6 八幡西区 5108 4946 414 6047 12677 15203
## 国民民主党 チームみらい 日本誠真会 社会民主党 れいわ新選組 日本改革党
## 1 3806 757 306 999 2661 35
## 2 9143 1858 614 1465 5010 56
## 3 10912 1613 675 1687 6518 86
## 4 3802 567 282 701 2468 34
## 5 3134 596 185 664 1762 27
## 6 12931 2043 749 2282 7552 94
## 自由民主党 再生の道 公明党 ＮＨＫ党 KWM SHM TMN NAS NKD ITO FRK YMG
## 1 7973 321 6226 432 4181 7945 366 802 5533 1744 696 2014
## 2 13332 710 8703 950 10277 11162 730 1201 11830 3140 1935 3368
## 3 15551 881 10783 919 11354 13981 781 1387 14060 3721 1605 3784
## 4 6524 285 4037 312 4250 5207 348 571 5472 1323 612 2411
## 5 5556 250 3812 328 3644 4797 236 540 4140 1144 606 1366
## 6 18848 1011 12939 1063 13877 16542 884 1943 17440 4597 2092 4558
## MRK MTS MOR OKZ NOD
## 1 242 7369 1791 2196 5488
## 2 441 11826 3959 4139 8346
## 3 533 13726 4169 5461 11794
## 4 202 5712 1506 2040 4324
## 5 173 5047 1248 1426 3671
## 6 655 16646 4826 6263 13696# --- 3. データの前処理（DID密度算出と結合） ---
did_processed <- did_data %>%
rename(region = 1, pop_did = 2, area_did = 3) %>%
mutate(
pop_did = as.numeric(gsub(",", "", as.character(pop_did))),
area_did = as.numeric(gsub(",", "", as.character(area_did))),
DID_Density = pop_did / area_did,
match_key = str_extract(region, "[^ ]+$")
) %>%
filter(!is.na(DID_Density) & pop_did > 0)
# ここで確実に 'merged_final' を作成
merged_final <- inner_join(did_processed, elec_raw, by = c("match_key" = "municipality"))
head(merged_final)## region pop_did area_did DID_Density match_key 日本共産党
## 1 福岡県 北九州市 門司区 78081 16.75 4661.552 門司区 2361
## 2 福岡県 北九州市 若松区 67705 17.57 3853.443 若松区 2548
## 3 福岡県 北九州市 戸畑区 57163 16.33 3500.490 戸畑区 1909
## 4 福岡県 北九州市 小倉北区 181525 28.58 6351.470 小倉北区 3803
## 5 福岡県 北九州市 小倉南区 183803 28.07 6548.023 小倉南区 4392
## 6 福岡県 北九州市 八幡東区 61232 14.47 4231.652 八幡東区 1540
## 日本維新の会 無所属連合 日本保守党 立憲民主党 参政党 国民民主党 チームみらい
## 1 1921 126 2249 5077 4970 3806 757
## 2 1436 105 1933 3923 4957 3802 567
## 3 1150 88 1530 2721 3261 3030 539
## 4 3357 313 5025 7420 10500 9143 1858
## 5 3965 284 5101 9975 12703 10912 1613
## 6 1303 108 1569 3438 3712 3134 596
## 日本誠真会 社会民主党 れいわ新選組 日本改革党 自由民主党 再生の道 公明党
## 1 306 999 2661 35 7973 321 6226
## 2 282 701 2468 34 6524 285 4037
## 3 171 514 1497 16 4979 180 3074
## 4 614 1465 5010 56 13332 710 8703
## 5 675 1687 6518 86 15551 881 10783
## 6 185 664 1762 27 5556 250 3812
## ＮＨＫ党 KWM SHM TMN NAS NKD ITO FRK YMG MRK MTS MOR OKZ NOD
## 1 432 4181 7945 366 802 5533 1744 696 2014 242 7369 1791 2196 5488
## 2 312 4250 5207 348 571 5472 1323 612 2411 202 5712 1506 2040 4324
## 3 277 3340 4003 195 389 3756 970 570 1734 156 4346 1188 1230 3073
## 4 950 10277 11162 730 1201 11830 3140 1935 3368 441 11826 3959 4139 8346
## 5 919 11354 13981 781 1387 14060 3721 1605 3784 533 13726 4169 5461 11794
## 6 328 3644 4797 236 540 4140 1144 606 1366 173 5047 1248 1426 3671# --- 4. 得票率の計算（ここが重要です） ---
# 候補者略号リストを除外
candidates_list <- c("KWM", "SHM", "TMN", "NAS", "NKD", "ITO", "FRK", "YMG", "MRK", "MTS", "MOR", "OKZ", "NOD")
# 「政党のみ」のリストを作成（市区町村名と個人名を除外）
party_list <- names(elec_raw)[!names(elec_raw) %in% c("municipality", candidates_list)]
# 各自治体の合計得票数（政党のみ）を算出し、得票率（_rate）に変換
merged_final <- merged_final %>%
mutate(Total_Votes = rowSums(select(., all_of(party_list)), na.rm = TRUE)) # ← ここで閉じカッコを補完しました
for (p in party_list) {
# 各政党の得票を「政党の合計得票数」で割って100を掛け、パーセントにします
merged_final[[paste0(p, "_rate")]] <- (merged_final[[p]] / merged_final$Total_Votes) * 100
}
# 結果の確認（最初の数行を表示）
head(merged_final)## region pop_did area_did DID_Density match_key 日本共産党
## 1 福岡県 北九州市 門司区 78081 16.75 4661.552 門司区 2361
## 2 福岡県 北九州市 若松区 67705 17.57 3853.443 若松区 2548
## 3 福岡県 北九州市 戸畑区 57163 16.33 3500.490 戸畑区 1909
## 4 福岡県 北九州市 小倉北区 181525 28.58 6351.470 小倉北区 3803
## 5 福岡県 北九州市 小倉南区 183803 28.07 6548.023 小倉南区 4392
## 6 福岡県 北九州市 八幡東区 61232 14.47 4231.652 八幡東区 1540
## 日本維新の会 無所属連合 日本保守党 立憲民主党 参政党 国民民主党 チームみらい
## 1 1921 126 2249 5077 4970 3806 757
## 2 1436 105 1933 3923 4957 3802 567
## 3 1150 88 1530 2721 3261 3030 539
## 4 3357 313 5025 7420 10500 9143 1858
## 5 3965 284 5101 9975 12703 10912 1613
## 6 1303 108 1569 3438 3712 3134 596
## 日本誠真会 社会民主党 れいわ新選組 日本改革党 自由民主党 再生の道 公明党
## 1 306 999 2661 35 7973 321 6226
## 2 282 701 2468 34 6524 285 4037
## 3 171 514 1497 16 4979 180 3074
## 4 614 1465 5010 56 13332 710 8703
## 5 675 1687 6518 86 15551 881 10783
## 6 185 664 1762 27 5556 250 3812
## ＮＨＫ党 KWM SHM TMN NAS NKD ITO FRK YMG MRK MTS MOR OKZ NOD
## 1 432 4181 7945 366 802 5533 1744 696 2014 242 7369 1791 2196 5488
## 2 312 4250 5207 348 571 5472 1323 612 2411 202 5712 1506 2040 4324
## 3 277 3340 4003 195 389 3756 970 570 1734 156 4346 1188 1230 3073
## 4 950 10277 11162 730 1201 11830 3140 1935 3368 441 11826 3959 4139 8346
## 5 919 11354 13981 781 1387 14060 3721 1605 3784 533 13726 4169 5461 11794
## 6 328 3644 4797 236 540 4140 1144 606 1366 173 5047 1248 1426 3671
## Total_Votes 日本共産党_rate 日本維新の会_rate 無所属連合_rate 日本保守党_rate
## 1 40220 5.870214 4.776231 0.3132770 5.591745
## 2 33914 7.513121 4.234240 0.3096067 5.699711
## 3 24936 7.655598 4.611806 0.3529034 6.135707
## 4 72259 5.263012 4.645788 0.4331640 6.954151
## 5 86045 5.104306 4.608054 0.3300599 5.928293
## 6 27984 5.503145 4.656232 0.3859348 5.606775
## 立憲民主党_rate 参政党_rate 国民民主党_rate チームみらい_rate 日本誠真会_rate
## 1 12.62307 12.35704 9.462954 1.882148 0.7608155
## 2 11.56749 14.61638 11.210709 1.671876 0.8315150
## 3 10.91193 13.07748 12.151107 2.161534 0.6857555
## 4 10.26862 14.53106 12.653095 2.571306 0.8497211
## 5 11.59277 14.76321 12.681736 1.874600 0.7844732
## 6 12.28559 13.26472 11.199257 2.129788 0.6610921
## 社会民主党_rate れいわ新選組_rate 日本改革党_rate 自由民主党_rate
## 1 2.483839 6.616111 0.08702138 19.82347
## 2 2.066993 7.277231 0.10025358 19.23689
## 3 2.061277 6.003369 0.06416426 19.96712
## 4 2.027429 6.933392 0.07749900 18.45030
## 5 1.960602 7.575106 0.09994770 18.07310
## 6 2.372784 6.296455 0.09648370 19.85420
## 再生の道_rate 公明党_rate ＮＨＫ党_rate
## 1 0.7981104 15.47986 1.0740925
## 2 0.8403609 11.90364 0.9199741
## 3 0.7218479 12.32756 1.1108438
## 4 0.9825766 12.04417 1.3147151
## 5 1.0238829 12.53181 1.0680458
## 6 0.8933676 13.62207 1.1720983# --- 5. 相関分析のサマリー作成 ---
rate_cols <- paste0(party_list, "_rate")
df_corr <- lapply(rate_cols, function(col) {
# merged_final の中の 'DID_Density' と 各得票率の相関を計算
res <- cor.test(merged_final$DID_Density, merged_final[[col]])
data.frame(Party = sub("_rate$", "", col), Correlation = res$estimate, p_value = res$p.value)
}) %>%
bind_rows() %>%
mutate(Significant = ifelse(p_value < 0.05, "有意な相関あり", "有意性なし"))
# --- 6. 可視化（AONF標準フォーマット） ---
ggplot(df_corr, aes(x = reorder(Party, Correlation), y = Correlation, fill = Significant)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_fill_manual(values = c("有意な相関あり" = "#d73027", "有意性なし" = "#bdbdbd")) +
labs(
title = "DID人口密度と各政党得票率の相関係数",
subtitle = "福岡県内自治体、2025年参院選比例代表",
x = "政党",
y = "相関係数 (r)",
caption = AONF_CAPTION
) +
theme_minimal(base_family = "HiraKakuProN-W3") +
theme(
legend.position = "bottom",
plot.caption = element_text(size = 8, hjust = 1, color = "darkgrey", lineheight = 1.2)
)