# --- 1. 設定：AONF標準フォーマットの定義 ---
AONF_CAPTION <- "Archives from 2026 Onward and Notes for the Future\n2026年以降の記録 | https://ab.cocolog-nifty.com/note/"
library(dplyr)
##
## 次のパッケージを付け加えます: 'dplyr'
## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter, lag
## 以下のオブジェクトは 'package:base' からマスクされています:
##
## intersect, setdiff, setequal, union
library(stringr)
library(ggplot2)
library(tidyr)
library(Hmisc)
##
## 次のパッケージを付け加えます: 'Hmisc'
## 以下のオブジェクトは 'package:dplyr' からマスクされています:
##
## src, summarize
## 以下のオブジェクトは 'package:base' からマスクされています:
##
## format.pval, units
# --- 2. 編集済みDIDデータの読み込み ---
# エディタで1行（タイトル行）のみ残して整理したファイルを使用
did_data <- read.csv("FEI_CITY_260320115508.csv",
skip = 1,
fileEncoding = "UTF-8",
check.names = FALSE,
na.strings = "-") # "-" をあらかじめ NA として処理
str(did_data)
## 'data.frame': 45 obs. of 3 variables:
## $ 地域 : chr "福岡県 北九州市 門司区" "福岡県 北九州市 若松区" "福岡県 北九州市 戸畑区" "福岡県 北九州市 小倉北区" ...
## $ A1801_人口集中地区人口【人】 : chr "78,081" "67,705" "57,163" "181,525" ...
## $ A1802_人口集中地区面積【ｋｍ2】: num 16.8 17.6 16.3 28.6 28.1 ...
did_processed <- did_data %>%
rename(
region = 1, # 1番目の列：地域
pop_did = 2, # 2番目の列：人口集中地区人口
area_did = 3 # 3番目の列：人口集中地区面積
) %>%
mutate(
# 数値への強制変換（カンマ除去）。NA生成の警告は filter で処理されるため無視してOKです
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)
# --- 3. 選挙データの読み込み ---
elec_data <- read.csv("data_PC_fixed.csv", fileEncoding = "UTF-8", check.names = FALSE)
str(elec_data)
## 'data.frame': 72 obs. of 30 variables:
## $ municipality: chr "門司区" "小倉北区" "小倉南区" "若松区" ...
## $ 日本共産党 : int 2361 3803 4392 2548 1540 5108 1909 5834 3181 3356 ...
## $ 日本維新の会: int 1921 3357 3965 1436 1303 4946 1150 8201 5523 5435 ...
## $ 無所属連合 : int 126 313 284 105 108 414 88 548 420 541 ...
## $ 日本保守党 : int 2249 5025 5101 1933 1569 6047 1530 10236 8532 8268 ...
## $ 立憲民主党 : int 5077 7420 9975 3923 3438 12677 2721 15805 8520 9628 ...
## $ 参政党 : int 4970 10500 12703 4957 3712 15203 3261 23856 19361 15730 ...
## $ 国民民主党 : int 3806 9143 10912 3802 3134 12931 3030 21113 17338 14660 ...
## $ チームみらい: int 757 1858 1613 567 596 2043 539 4415 3495 4735 ...
## $ 日本誠真会 : int 306 614 675 282 185 749 171 1164 815 1024 ...
## $ 社会民主党 : int 999 1465 1687 701 664 2282 514 3163 1710 1901 ...
## $ れいわ新選組: int 2661 5010 6518 2468 1762 7552 1497 10207 7252 5647 ...
## $ 日本改革党 : int 35 56 86 34 27 94 16 126 118 77 ...
## $ 自由民主党 : int 7973 13332 15551 6524 5556 18848 4979 24690 16170 17431 ...
## $ 再生の道 : int 321 710 881 285 250 1011 180 1384 1044 993 ...
## $ 公明党 : int 6226 8703 10783 4037 3812 12939 3074 14419 10086 6053 ...
## $ ＮＨＫ党 : int 432 950 919 312 328 1063 277 1675 1398 1150 ...
## $ KWM : int 4181 10277 11354 4250 3644 13877 3340 22553 18589 16964 ...
## $ SHM : int 7945 11162 13981 5207 4797 16542 4003 17804 12193 7719 ...
## $ TMN : int 366 730 781 348 236 884 195 1456 1004 1162 ...
## $ NAS : int 802 1201 1387 571 540 1943 389 2782 1803 1635 ...
## $ NKD : int 5533 11830 14060 5472 4140 17440 3756 26676 21655 17794 ...
## $ ITO : int 1744 3140 3721 1323 1144 4597 970 7450 5139 4709 ...
## $ FRK : int 696 1935 1605 612 606 2092 570 4047 3223 4206 ...
## $ YMG : int 2014 3368 3784 2411 1366 4558 1734 4918 2714 2642 ...
## $ MRK : int 242 441 533 202 173 655 156 862 721 522 ...
## $ MTS : int 7369 11826 13726 5712 5047 16646 4346 24103 15449 16569 ...
## $ MOR : int 1791 3959 4169 1506 1248 4826 1188 7985 6629 6706 ...
## $ OKZ : int 2196 4139 5461 2040 1426 6263 1230 8452 6224 4929 ...
## $ NOD : int 5488 8346 11794 4324 3671 13696 3073 17937 9579 10891 ...
# 候補者略号リスト
candidates_list <- c("KWM", "SHM", "TMN", "NAS", "NKD", "ITO", "FRK", "YMG", "MRK", "MTS", "MOR", "OKZ", "NOD")
# アルファベット略号を除外して「政党」のリストを作成
party_list <- names(elec_data)[!names(elec_data) %in% c("municipality", candidates_list)]
# 得票率の計算（全数値列の合計を分母にする）
elec_data <- elec_data %>%
mutate(Total_Votes = rowSums(select(., where(is.numeric)), na.rm = TRUE))
for (p in party_list) {
elec_data[[paste0(p, "_rate")]] <- (elec_data[[p]] / elec_data$Total_Votes) * 100
}
# --- 4. データの結合 ---
merged_final <- inner_join(did_processed, elec_data, by = c("match_key" = "municipality"))
# --- 5. 相関分析のサマリー作成 ---
rate_cols <- paste0(party_list, "_rate")
df_corr <- lapply(rate_cols, function(col) {
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, "有意な相関あり", "有意性なし"))
df_corr
## Party Correlation p_value Significant
## cor...1 日本共産党 -0.36494811 7.951822e-02 有意性なし
## cor...2 日本維新の会 0.57655863 3.187014e-03 有意な相関あり
## cor...3 無所属連合 0.61098666 1.516372e-03 有意な相関あり
## cor...4 日本保守党 0.80918187 1.689529e-06 有意な相関あり
## cor...5 立憲民主党 -0.22866759 2.824839e-01 有意性なし
## cor...6 参政党 0.32013023 1.272471e-01 有意性なし
## cor...7 国民民主党 0.47218007 1.982080e-02 有意な相関あり
## cor...8 チームみらい 0.87279105 2.669694e-08 有意な相関あり
## cor...9 日本誠真会 0.74158660 3.370505e-05 有意な相関あり
## cor...10 社会民主党 -0.04539297 8.331870e-01 有意性なし
## cor...11 れいわ新選組 -0.50109174 1.261959e-02 有意な相関あり
## cor...12 日本改革党 -0.10157212 6.367408e-01 有意性なし
## cor...13 自由民主党 -0.41774085 4.223390e-02 有意な相関あり
## cor...14 再生の道 0.51936903 9.297956e-03 有意な相関あり
## cor...15 公明党 -0.66300923 4.141411e-04 有意な相関あり
## cor...16 ＮＨＫ党 0.56257593 4.213755e-03 有意な相関あり
# --- 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)
)
