旧統一教会が参院選に与えた影響の推定
朝日新聞デジタル企画報道部 小宮山亮磨 @ryomakom
2024-05-13
この文書について
日本選挙学会の機関誌「選挙研究」に掲載される予定の論文「旧統一教会が参院選に与えた影響の推定 自民党・井上義行氏の得票を例に」の分析手法や結果について、もとになったデータやRのコードとともに公開します。なお、以下のコードはR version 4.2.2とRStudio 2023.06.0 Build 421で動くことを確認しています。
必要なパッケージをとってくる
library(tidyverse)
library(modelsummary)
library(MatchIt)
library(rgenoud)
library(cobalt)
library(zipangu)
library(estimatr)
library(gt)
if (!require("broom", character.only = TRUE)) {
install.packages("broom")
library("broom", character.only = TRUE)
}元データを加工
以下の四つのファイルを読み込み、分析用に加工する。
・各市区町村に割り振られたコード
・旧統一教会がウェブサイトで公表している「家庭教会」の所在地
・参院選における井上義行氏の得票記録
・e-Statから取得した各市区町村の「社会・人口統計体系」データ
# 市区町村ごとに割り振られたコード
jiscode <- read_csv("data/提出用/jiscode.csv")## Rows: 1896 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): code, pref, pref_city
## dbl (1): asahicode
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.#旧統一教会の拠点289カ所がおかれた259自治体にタグを振る
church <- read_csv("data/提出用/教会所在地.csv") %>%
mutate(address_components=separate_address(address)) %>%
unnest_wider(col = address_components) %>%
select(-address) %>%
mutate(prefecture=str_sub(prefecture,start=11,end=-1),
pref_city=str_c(prefecture,city),
uc=1) %>%
distinct(pref_city,uc) %>%
left_join(jiscode %>% select(code,pref_city)) %>%
select(code,uc)## Rows: 289 Columns: 1
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): address
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(pref_city)`# 井上氏の得票データを読み込み、「社会・人口統計体系」データを合体
inoue <- read_csv("data/提出用/votes.csv") %>%
mutate(inoue_ratio=井上得票*100/投票者数,
exp_inoue_ratio=(自民得票計-井上得票)*100/投票者数,
ldp_ratio=自民_党_の得票*100/投票者数) %>%
select(year,code,pref_city,inoue_ratio,exp_inoue_ratio,ldp_ratio) %>%
pivot_wider(names_from = year,
values_from = c(inoue_ratio,exp_inoue_ratio,ldp_ratio)) %>%
mutate(inoue_ratio_change=inoue_ratio_2022-inoue_ratio_2019,
exp_inoue_ratio_change=exp_inoue_ratio_2022-exp_inoue_ratio_2019,
ldp_ratio_change=ldp_ratio_2022-ldp_ratio_2019) %>%
dplyr::select(-inoue_ratio_2022,
-inoue_ratio_2019,
-exp_inoue_ratio_2022,
-exp_inoue_ratio_2019,
-ldp_ratio_2022,
-ldp_ratio_2019) %>%
left_join(church) %>%
mutate(uc=ifelse(is.na(uc),0,1)) %>%
left_join(read_csv("data/提出用/mun_data.csv") %>% # 各市区町村の「社会・人口統計体系」データ
select(-地域),
by=c("code"="area_code")) %>%
select_if(negate(anyNA)) %>% # NAを含む列を除外
select(-contains("（男）"), # 意味が重複する列を除外
-contains("（女）"),
-contains("（外国人）"),
-contains("その他")) %>%
dplyr::select(code,pref_city,uc,inoue_ratio_change,exp_inoue_ratio_change,
ldp_ratio_change,`A2301_住民基本台帳人口（総数）`,everything())## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`
## Rows: 1917 Columns: 263
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): area_code, 地域
## dbl (261): A2101_住民基本台帳人口（日本人）, A210101_住民基本台帳人口（日本人）（男）, A210102_住民基本台帳人口（日...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.glimpse(inoue)## Rows: 1,896
## Columns: 105
## $ code <chr> "011…
## $ pref_city <chr> "北…
## $ uc <dbl> 0, 1…
## $ inoue_ratio_change <dbl> 0.00…
## $ exp_inoue_ratio_change <dbl> -0.0…
## $ ldp_ratio_change <dbl> 1.77…
## $ `A2301_住民基本台帳人口（総数）` <dbl> 2381…
## $ `A2101_住民基本台帳人口（日本人）` <dbl> 2352…
## $ A4101_出生数 <dbl> 1560…
## $ A4200_死亡数 <dbl> 2177…
## $ `A5101_転入者数（日本人移動者）` <dbl> 2095…
## $ `A5102_転出者数（日本人移動者）` <dbl> 1782…
## $ A5103_転入者数 <dbl> 2145…
## $ A5104_転出者数 <dbl> 1835…
## $ `A7103_住民基本台帳世帯数（日本人）` <dbl> 1417…
## $ A9101_婚姻件数 <dbl> 1650…
## $ A9201_離婚件数 <dbl> 567,…
## $ `B1101_総面積（北方地域及び竹島を除く）` <dbl> 4642…
## $ `B1102_総面積（北方地域及び竹島を含む）` <dbl> 4642…
## $ B1103_可住地面積 <dbl> 2685…
## $ B1104_主要湖沼面積 <dbl> 0, 0…
## $ B1105_林野面積 <dbl> 2039…
## $ B1106_森林面積 <dbl> 2038…
## $ B1107_森林以外の草生地面積 <dbl> 1, 1…
## $ `C2109_事業所数（国・地方公共団体）（経済センサス‐基礎調査結果）` <dbl> 178,…
## $ `C310201_農家数（販売農家）` <dbl> 6, 6…
## $ `C310202_農家数（自給的農家）` <dbl> 4, 4…
## $ C3403_製造業事業所数 <dbl> 85, …
## $ C3404_製造業従業者数 <dbl> 1651…
## $ E1101_幼稚園数 <dbl> 14, …
## $ E1501_幼稚園在園者数 <dbl> 1677…
## $ E2101_小学校数 <dbl> 16, …
## $ E2401_小学校教員数 <dbl> 491,…
## $ E2501_小学校児童数 <dbl> 9719…
## $ E3101_中学校数 <dbl> 10, …
## $ E3401_中学校教員数 <dbl> 278,…
## $ E3501_中学校生徒数 <dbl> 4233…
## $ E3901_義務教育学校数 <dbl> 0, 0…
## $ E3902_義務教育学校前期課程学級数 <dbl> 0, 0…
## $ E3903_義務教育学校後期課程学級数 <dbl> 0, 0…
## $ E3904_義務教育学校教員数 <dbl> 0, 0…
## $ E3905_義務教育学校前期課程児童数 <dbl> 0, 0…
## $ E3906_義務教育学校後期課程生徒数 <dbl> 0, 0…
## $ E4101_高等学校数 <dbl> 8, 9…
## $ E4501_高等学校生徒数 <dbl> 6305…
## $ F1101_労働力人口 <dbl> 1088…
## $ F1102_就業者数 <dbl> 1037…
## $ `F1103_就業者数・主に仕事` <dbl> 8793…
## $ `F1104_就業者数・家事のほか仕事` <dbl> 1076…
## $ `F1105_就業者数・通学のかたわら仕事` <dbl> 2247…
## $ `F1106_就業者数・休業者` <dbl> 2765…
## $ F1107_完全失業者数 <dbl> 5099…
## $ F1108_非労働力人口 <dbl> 6551…
## $ `F1109_非労働力人口・家事` <dbl> 2549…
## $ `F1110_非労働力人口・通学` <dbl> 9619…
## $ `F2116_就業者数（65歳以上）` <dbl> 1198…
## $ F2201_第1次産業就業者数 <dbl> 303,…
## $ F2211_第2次産業就業者数 <dbl> 8534…
## $ F2221_第3次産業就業者数 <dbl> 9159…
## $ `F2401_雇用者数（国勢調査結果）` <dbl> 8373…
## $ F2402_役員数 <dbl> 8752…
## $ F2403_雇人のある業主数 <dbl> 2156…
## $ F2404_雇人のない業主数 <dbl> 5865…
## $ `F2405_家族従業者数（国勢調査結果）` <dbl> 1187…
## $ F2406_自営業主及び家族従業者数 <dbl> 9208…
## $ `F2409_雇用者数（正規の職員・従業員）` <dbl> 5665…
## $ `F2410_雇用者数（労働者派遣事業所の派遣社員）` <dbl> 3074…
## $ F2701_自市区町村で従業している就業者数 <dbl> 7283…
## $ F2702_県内他市区町村で従業している就業者数 <dbl> 2747…
## $ F2703_他県で従業している就業者数 <dbl> 260,…
## $ F2705_他市区町村への通勤者数 <dbl> 2773…
## $ F2801_従業地による就業者数 <dbl> 2470…
## $ F2802_他県に常住している就業者数 <dbl> 466,…
## $ F2803_他市区町村からの通勤者数 <dbl> 1710…
## $ G1201_公民館数 <dbl> 0, 0…
## $ G1401_図書館数 <dbl> 2, 1…
## $ H7701_テレビ放送受信契約数 <dbl> 1094…
## $ H770101_衛星放送受信契約数 <dbl> 6770…
## $ I5101_病院数 <dbl> 39, …
## $ I510110_精神科病院数 <dbl> 4, 5…
## $ I510120_一般病院数 <dbl> 35, …
## $ I510150_療養病床を有する病院数 <dbl> 10, …
## $ I5102_一般診療所数 <dbl> 371,…
## $ I510201_有床一般診療所数 <dbl> 26, …
## $ I5103_歯科診療所数 <dbl> 285,…
## $ I5211_病院病床数 <dbl> 8590…
## $ I5212_一般診療所病床数 <dbl> 264,…
## $ `I5511_介護老人保健施設数（基本票）` <dbl> 5, 7…
## $ `I5512_介護老人保健施設定員数（基本票）` <dbl> 491,…
## $ `J2221_保護施設数（基本票）（医療保護施設を除く）` <dbl> 0, 0…
## $ `J230127_介護老人福祉施設数（基本票）` <dbl> 6, 1…
## $ `J230128_介護老人福祉施設定員数（基本票）` <dbl> 513,…
## $ `J2304_老人福祉施設数（基本票）` <dbl> 4, 4…
## $ `J230411_養護老人ホーム数（基本票）` <dbl> 2, 0…
## $ `J230412_養護老人ホーム定員数（基本票）` <dbl> 130,…
## $ `J230421_有料老人ホーム数（基本票）` <dbl> 43, …
## $ `J230422_有料老人ホーム定員数（基本票）` <dbl> 2342…
## $ `J230431_軽費老人ホーム数（基本票）` <dbl> 1, 3…
## $ `J230432_軽費老人ホーム定員数（基本票）` <dbl> 100,…
## $ `J250204_児童福祉施設等数（基本票）` <dbl> 80, …
## $ `J250302_保育所等数（基本票）` <dbl> 38, …
## $ `J250303_公営保育所等数（基本票）` <dbl> 1, 4…
## $ `J2804_母子・父子福祉施設数（基本票）` <dbl> 2, 0…
## $ `J2905_障害者支援施設等数（基本票）` <dbl> 12, …
## $ `J2906_婦人保護施設数（基本票）` <dbl> 0, 0…井上氏の得票に各変数が与える効果を調べる
各変数を標準化したうえで、井上氏の得票率変化量を目的変数とした単回帰分析をして、それぞれの効果量を調べる。
# 得票率とUC有無以外のすべての説明変数を人口で割る
for(i in 8:105){
inoue[,i] <- inoue[,i]/inoue[,7]
}
# 井上氏の得票率変化量とUC有無以外のすべての変数を標準化
for(i in 5:105){
inoue[,i] <- inoue[,i] %>%
scale()
}
# 分析のためにデータフレーム形式に変える
inoue <- inoue %>%
as.data.frame()
# 各変数と井上氏の得票率変化量との単回帰分析をする
resFrame1<-data.frame() # forループのたびに上書きする一時的なデータフレーム
resFrame2<-data.frame() # 最終結果を書き込むデータフレーム
for(i in 5:105){
result <- summary(lm(inoue$inoue_ratio_change~inoue[,i]))
coef <- result$coefficients
resFrame1 <- coef # i番目の出力結果を代入
resFrame2 <- rbind(resFrame2,resFrame1) # resFrame2の末行にresFrame1を代入
}効果量の大きい順に変数を並べると以下のようになる。
resFrame2 %>%
as_tibble() %>%
mutate(num=row_number()/2,
int=ifelse(str_sub(num,-2,-2)==".",0,1)) %>%
filter(int==1) %>%
select(-int) %>%
left_join(names(inoue) %>%
as_tibble() %>%
mutate(num=row_number()-4) %>%
filter(num>=1) %>%
rename(variable=value)) %>%
mutate(abs_estimate=abs(Estimate)) %>%
select(num,variable,everything()) %>%
arrange(desc(abs_estimate)) %>%
knitr::kable()## Joining with `by = join_by(num)`| num | variable | Estimate | Std. Error | t value | Pr(>|t|) | abs_estimate |
|---|---|---|---|---|---|---|
| 73 | H7701_テレビ放送受信契約数 | -0.0438120 | 0.0067474 | -6.4931276 | 0.0000000 | 0.0438120 |
| 11 | A7103_住民基本台帳世帯数（日本人） | -0.0344873 | 0.0067759 | -5.0896695 | 0.0000004 | 0.0344873 |
| 58 | F2403_雇人のある業主数 | -0.0312255 | 0.0067843 | -4.6026146 | 0.0000044 | 0.0312255 |
| 54 | F2211_第2次産業就業者数 | 0.0280497 | 0.0067916 | 4.1300541 | 0.0000378 | 0.0280497 |
| 74 | H770101_衛星放送受信契約数 | -0.0271988 | 0.0067934 | -4.0036895 | 0.0000648 | 0.0271988 |
| 5 | A4101_出生数 | 0.0265545 | 0.0067948 | 3.9080719 | 0.0000963 | 0.0265545 |
| 51 | F1110_非労働力人口・通学 | 0.0261241 | 0.0067957 | 3.8442263 | 0.0001249 | 0.0261241 |
| 1 | exp_inoue_ratio_change | -0.0251714 | 0.0067976 | -3.7029965 | 0.0002192 | 0.0251714 |
| 88 | J230128_介護老人福祉施設定員数（基本票） | -0.0251376 | 0.0067976 | -3.6980006 | 0.0002235 | 0.0251376 |
| 10 | A5104_転出者数 | -0.0234283 | 0.0068009 | -3.4449041 | 0.0005837 | 0.0234283 |
| 30 | E2501_小学校児童数 | 0.0233908 | 0.0068009 | 3.4393573 | 0.0005957 | 0.0233908 |
| 8 | A5102_転出者数（日本人移動者） | -0.0221734 | 0.0068031 | -3.2593279 | 0.0011366 | 0.0221734 |
| 67 | F2705_他市区町村への通勤者数 | 0.0216796 | 0.0068039 | 3.1863491 | 0.0014643 | 0.0216796 |
| 65 | F2702_県内他市区町村で従業している就業者数 | 0.0216616 | 0.0068039 | 3.1836868 | 0.0014777 | 0.0216616 |
| 6 | A4200_死亡数 | -0.0208530 | 0.0068053 | -3.0642363 | 0.0022130 | 0.0208530 |
| 3 | A2301_住民基本台帳人口（総数） | 0.0205608 | 0.0068057 | 3.0211013 | 0.0025523 | 0.0205608 |
| 16 | B1103_可住地面積 | -0.0203284 | 0.0068061 | -2.9867843 | 0.0028555 | 0.0203284 |
| 64 | F2701_自市区町村で従業している就業者数 | -0.0201710 | 0.0068064 | -2.9635530 | 0.0030790 | 0.0201710 |
| 85 | I5512_介護老人保健施設定員数（基本票） | -0.0201636 | 0.0068064 | -2.9624560 | 0.0030900 | 0.0201636 |
| 33 | E3501_中学校生徒数 | 0.0199719 | 0.0068067 | 2.9341615 | 0.0033847 | 0.0199719 |
| 21 | C2109_事業所数（国・地方公共団体）（経済センサス‐基礎調査結果） | -0.0193451 | 0.0068076 | -2.8416816 | 0.0045357 | 0.0193451 |
| 25 | C3404_製造業従業者数 | 0.0191186 | 0.0068080 | 2.8082732 | 0.0050319 | 0.0191186 |
| 87 | J230127_介護老人福祉施設数（基本票） | -0.0185773 | 0.0068088 | -2.7284404 | 0.0064223 | 0.0185773 |
| 15 | B1102_総面積（北方地域及び竹島を含む） | -0.0185752 | 0.0068088 | -2.7281357 | 0.0064282 | 0.0185752 |
| 14 | B1101_総面積（北方地域及び竹島を除く） | -0.0185647 | 0.0068088 | -2.7265875 | 0.0064583 | 0.0185647 |
| 61 | F2406_自営業主及び家族従業者数 | -0.0182216 | 0.0068093 | -2.6760066 | 0.0075147 | 0.0182216 |
| 95 | J230432_軽費老人ホーム定員数（基本票） | 0.0181220 | 0.0068094 | 2.6613200 | 0.0078493 | 0.0181220 |
| 60 | F2405_家族従業者数（国勢調査結果） | -0.0177122 | 0.0068100 | -2.6009188 | 0.0093698 | 0.0177122 |
| 23 | C310202_農家数（自給的農家） | 0.0176357 | 0.0068101 | 2.5896446 | 0.0096811 | 0.0176357 |
| 28 | E2101_小学校数 | -0.0174986 | 0.0068103 | -2.5694459 | 0.0102620 | 0.0174986 |
| 53 | F2201_第1次産業就業者数 | -0.0174842 | 0.0068103 | -2.5673235 | 0.0103248 | 0.0174842 |
| 18 | B1105_林野面積 | -0.0172838 | 0.0068106 | -2.5377911 | 0.0112350 | 0.0172838 |
| 20 | B1107_森林以外の草生地面積 | -0.0169612 | 0.0068110 | -2.4902657 | 0.0128499 | 0.0169612 |
| 19 | B1106_森林面積 | -0.0168347 | 0.0068111 | -2.4716402 | 0.0135368 | 0.0168347 |
| 52 | F2116_就業者数（65歳以上） | -0.0165184 | 0.0068116 | -2.4250547 | 0.0153990 | 0.0165184 |
| 62 | F2409_雇用者数（正規の職員・従業員） | 0.0163157 | 0.0068118 | 2.3952032 | 0.0167078 | 0.0163157 |
| 84 | I5511_介護老人保健施設数（基本票） | -0.0158665 | 0.0068124 | -2.3290672 | 0.0199602 | 0.0158665 |
| 98 | J250303_公営保育所等数（基本票） | -0.0158038 | 0.0068125 | -2.3198453 | 0.0204551 | 0.0158038 |
| 83 | I5212_一般診療所病床数 | -0.0154813 | 0.0068128 | -2.2723658 | 0.0231761 | 0.0154813 |
| 29 | E2401_小学校教員数 | -0.0153856 | 0.0068130 | -2.2582834 | 0.0240414 | 0.0153856 |
| 27 | E1501_幼稚園在園者数 | 0.0150361 | 0.0068134 | 2.2068487 | 0.0274442 | 0.0150361 |
| 56 | F2401_雇用者数（国勢調査結果） | 0.0142447 | 0.0068143 | 2.0904178 | 0.0367133 | 0.0142447 |
| 94 | J230431_軽費老人ホーム数（基本票） | 0.0134095 | 0.0068152 | 1.9675919 | 0.0492607 | 0.0134095 |
| 99 | J2804_母子・父子福祉施設数（基本票） | 0.0133887 | 0.0068152 | 1.9645433 | 0.0496131 | 0.0133887 |
| 63 | F2410_雇用者数（労働者派遣事業所の派遣社員） | 0.0133843 | 0.0068152 | 1.9638904 | 0.0496889 | 0.0133843 |
| 89 | J2304_老人福祉施設数（基本票） | 0.0123567 | 0.0068162 | 1.8128385 | 0.0700150 | 0.0123567 |
| 40 | E4101_高等学校数 | -0.0123261 | 0.0068162 | -1.8083432 | 0.0707117 | 0.0123261 |
| 57 | F2402_役員数 | -0.0122691 | 0.0068163 | -1.7999659 | 0.0720251 | 0.0122691 |
| 49 | F1108_非労働力人口 | -0.0120455 | 0.0068165 | -1.7671079 | 0.0773712 | 0.0120455 |
| 82 | I5211_病院病床数 | 0.0120096 | 0.0068165 | 1.7618278 | 0.0782597 | 0.0120096 |
| 55 | F2221_第3次産業就業者数 | -0.0117624 | 0.0068168 | -1.7255163 | 0.0845976 | 0.0117624 |
| 24 | C3403_製造業事業所数 | 0.0117517 | 0.0068168 | 1.7239426 | 0.0848814 | 0.0117517 |
| 32 | E3401_中学校教員数 | -0.0110308 | 0.0068174 | -1.6180300 | 0.1058226 | 0.0110308 |
| 68 | F2801_従業地による就業者数 | -0.0107887 | 0.0068176 | -1.5824796 | 0.1137071 | 0.0107887 |
| 46 | F1105_就業者数・通学のかたわら仕事 | 0.0107674 | 0.0068176 | 1.5793448 | 0.1144240 | 0.0107674 |
| 31 | E3101_中学校数 | -0.0106863 | 0.0068177 | -1.5674378 | 0.1171794 | 0.0106863 |
| 59 | F2404_雇人のない業主数 | -0.0102719 | 0.0068180 | -1.5065799 | 0.1320851 | 0.0102719 |
| 97 | J250302_保育所等数（基本票） | -0.0102150 | 0.0068181 | -1.4982230 | 0.1342420 | 0.0102150 |
| 7 | A5101_転入者数（日本人移動者） | -0.0095574 | 0.0068186 | -1.4016648 | 0.1611792 | 0.0095574 |
| 9 | A5103_転入者数 | -0.0095374 | 0.0068186 | -1.3987274 | 0.1620585 | 0.0095374 |
| 72 | G1401_図書館数 | 0.0088796 | 0.0068191 | 1.3021686 | 0.1930171 | 0.0088796 |
| 45 | F1104_就業者数・家事のほか仕事 | -0.0088695 | 0.0068191 | -1.3006915 | 0.1935223 | 0.0088695 |
| 12 | A9101_婚姻件数 | 0.0083544 | 0.0068194 | 1.2250869 | 0.2206948 | 0.0083544 |
| 71 | G1201_公民館数 | 0.0082674 | 0.0068195 | 1.2123160 | 0.2255426 | 0.0082674 |
| 96 | J250204_児童福祉施設等数（基本票） | -0.0082506 | 0.0068195 | -1.2098607 | 0.2264833 | 0.0082506 |
| 90 | J230411_養護老人ホーム数（基本票） | 0.0081618 | 0.0068195 | 1.1968292 | 0.2315229 | 0.0081618 |
| 17 | B1104_主要湖沼面積 | -0.0081448 | 0.0068196 | -1.1943260 | 0.2325000 | 0.0081448 |
| 80 | I510201_有床一般診療所数 | -0.0076444 | 0.0068199 | -1.1209064 | 0.2624698 | 0.0076444 |
| 2 | ldp_ratio_change | -0.0073203 | 0.0068201 | -1.0733531 | 0.2832495 | 0.0073203 |
| 76 | I510110_精神科病院数 | 0.0070016 | 0.0068202 | 1.0265957 | 0.3047420 | 0.0070016 |
| 79 | I5102_一般診療所数 | -0.0067542 | 0.0068204 | -0.9902992 | 0.3221544 | 0.0067542 |
| 81 | I5103_歯科診療所数 | -0.0065236 | 0.0068205 | -0.9564794 | 0.3389522 | 0.0065236 |
| 93 | J230422_有料老人ホーム定員数（基本票） | -0.0063223 | 0.0068206 | -0.9269494 | 0.3540709 | 0.0063223 |
| 78 | I510150_療養病床を有する病院数 | 0.0063174 | 0.0068206 | 0.9262267 | 0.3544462 | 0.0063174 |
| 69 | F2802_他県に常住している就業者数 | -0.0062431 | 0.0068206 | -0.9153257 | 0.3601372 | 0.0062431 |
| 47 | F1106_就業者数・休業者 | -0.0061459 | 0.0068207 | -0.9010641 | 0.3676688 | 0.0061459 |
| 91 | J230412_養護老人ホーム定員数（基本票） | 0.0059050 | 0.0068208 | 0.8657396 | 0.3867426 | 0.0059050 |
| 36 | E3903_義務教育学校後期課程学級数 | -0.0049706 | 0.0068212 | -0.7287078 | 0.4662705 | 0.0049706 |
| 13 | A9201_離婚件数 | -0.0048021 | 0.0068212 | -0.7039948 | 0.4815226 | 0.0048021 |
| 34 | E3901_義務教育学校数 | -0.0047784 | 0.0068212 | -0.7005220 | 0.4836874 | 0.0047784 |
| 4 | A2101_住民基本台帳人口（日本人） | -0.0046982 | 0.0068213 | -0.6887547 | 0.4910620 | 0.0046982 |
| 70 | F2803_他市区町村からの通勤者数 | -0.0046321 | 0.0068213 | -0.6790653 | 0.4971795 | 0.0046321 |
| 92 | J230421_有料老人ホーム数（基本票） | 0.0044267 | 0.0068214 | 0.6489474 | 0.5164511 | 0.0044267 |
| 37 | E3904_義務教育学校教員数 | -0.0041806 | 0.0068214 | -0.6128586 | 0.5400434 | 0.0041806 |
| 22 | C310201_農家数（販売農家） | 0.0038978 | 0.0068215 | 0.5713973 | 0.5677981 | 0.0038978 |
| 39 | E3906_義務教育学校後期課程生徒数 | -0.0037786 | 0.0068216 | -0.5539129 | 0.5797038 | 0.0037786 |
| 38 | E3905_義務教育学校前期課程児童数 | -0.0037783 | 0.0068216 | -0.5538749 | 0.5797299 | 0.0037783 |
| 66 | F2703_他県で従業している就業者数 | 0.0037620 | 0.0068216 | 0.5514856 | 0.5813659 | 0.0037620 |
| 35 | E3902_義務教育学校前期課程学級数 | -0.0036613 | 0.0068216 | -0.5367275 | 0.5915189 | 0.0036613 |
| 101 | J2906_婦人保護施設数（基本票） | 0.0034579 | 0.0068217 | 0.5068994 | 0.6122844 | 0.0034579 |
| 100 | J2905_障害者支援施設等数（基本票） | -0.0033062 | 0.0068217 | -0.4846526 | 0.6279788 | 0.0033062 |
| 26 | E1101_幼稚園数 | 0.0032439 | 0.0068217 | 0.4755188 | 0.6344721 | 0.0032439 |
| 42 | F1101_労働力人口 | -0.0031255 | 0.0068217 | -0.4581673 | 0.6468848 | 0.0031255 |
| 43 | F1102_就業者数 | -0.0028581 | 0.0068218 | -0.4189663 | 0.6752882 | 0.0028581 |
| 77 | I510120_一般病院数 | -0.0022168 | 0.0068219 | -0.3249564 | 0.7452500 | 0.0022168 |
| 48 | F1107_完全失業者数 | -0.0021213 | 0.0068220 | -0.3109486 | 0.7558739 | 0.0021213 |
| 44 | F1103_就業者数・主に仕事 | -0.0015716 | 0.0068220 | -0.2303774 | 0.8178234 | 0.0015716 |
| 41 | E4501_高等学校生徒数 | 0.0013567 | 0.0068221 | 0.1988688 | 0.8423868 | 0.0013567 |
| 50 | F1109_非労働力人口・家事 | -0.0006041 | 0.0068221 | -0.0885447 | 0.9294531 | 0.0006041 |
| 86 | J2221_保護施設数（基本票）（医療保護施設を除く） | 0.0005347 | 0.0068221 | 0.0783794 | 0.9375345 | 0.0005347 |
| 75 | I5101_病院数 | -0.0000993 | 0.0068221 | -0.0145578 | 0.9883865 | 0.0000993 |
マッチングをしていく
以下の３モデルのそれぞれについて、最近傍マッチングと遺伝的マッチングを行う。つまり計６パターンのマッチングをする。
- 社会・人口統計体系から入手した98個の変数すべてに、井上氏以外の自民党得票率変化量を加えた計99個
- 社会・人口統計体系の変数全体のうち効果量の大きいもの10個に、井上氏以外の自民党得票率変化量を加えた計11個
- 社会・人口統計体系の各分野のうち効果量が最大の変数9個に、井上氏以外の自民党得票率変化量を加えた計10個
まずは最近傍マッチングをする。
# 各モデルで使う変数を指定する
varsA <- c("exp_inoue_ratio_change",
"`A2301_住民基本台帳人口（総数）`",
"`A2101_住民基本台帳人口（日本人）`",
"`A4101_出生数`",
"`A4200_死亡数`",
"`A5101_転入者数（日本人移動者）`",
"`A5102_転出者数（日本人移動者）`",
"`A5103_転入者数`",
"`A5104_転出者数`",
"`A7103_住民基本台帳世帯数（日本人）`",
"`A9101_婚姻件数`",
"`A9201_離婚件数`",
"`B1101_総面積（北方地域及び竹島を除く）`",
"`B1102_総面積（北方地域及び竹島を含む）`",
"`B1103_可住地面積`",
"`B1104_主要湖沼面積`",
"`B1105_林野面積`",
"`B1106_森林面積`",
"`B1107_森林以外の草生地面積`",
"`C2109_事業所数（国・地方公共団体）（経済センサス‐基礎調査結果）`",
"`C310201_農家数（販売農家）`",
"`C310202_農家数（自給的農家）`",
"`C3403_製造業事業所数`",
"`C3404_製造業従業者数`",
"`E1101_幼稚園数`",
"`E1501_幼稚園在園者数`",
"`E2101_小学校数`",
"`E2401_小学校教員数`",
"`E2501_小学校児童数`",
"`E3101_中学校数`",
"`E3401_中学校教員数`",
"`E3501_中学校生徒数`",
"`E3901_義務教育学校数`",
"`E3902_義務教育学校前期課程学級数`",
"`E3903_義務教育学校後期課程学級数`",
"`E3904_義務教育学校教員数`",
"`E3905_義務教育学校前期課程児童数`",
"`E3906_義務教育学校後期課程生徒数`",
"`E4101_高等学校数`",
"`E4501_高等学校生徒数`",
"`F1101_労働力人口`",
"`F1102_就業者数`",
"`F1103_就業者数・主に仕事`",
"`F1104_就業者数・家事のほか仕事`",
"`F1105_就業者数・通学のかたわら仕事`",
"`F1106_就業者数・休業者`",
"`F1107_完全失業者数`",
"`F1108_非労働力人口`",
"`F1109_非労働力人口・家事`",
"`F1110_非労働力人口・通学`",
"`F2116_就業者数（65歳以上）`",
"`F2201_第1次産業就業者数`",
"`F2211_第2次産業就業者数`",
"`F2221_第3次産業就業者数`",
"`F2401_雇用者数（国勢調査結果）`",
"`F2402_役員数`",
"`F2403_雇人のある業主数`",
"`F2404_雇人のない業主数`",
"`F2405_家族従業者数（国勢調査結果）`",
"`F2406_自営業主及び家族従業者数`",
"`F2409_雇用者数（正規の職員・従業員）`",
"`F2410_雇用者数（労働者派遣事業所の派遣社員）`",
"`F2701_自市区町村で従業している就業者数`",
"`F2702_県内他市区町村で従業している就業者数`",
"`F2703_他県で従業している就業者数`",
"`F2705_他市区町村への通勤者数`",
"`F2801_従業地による就業者数`",
"`F2802_他県に常住している就業者数`",
"`F2803_他市区町村からの通勤者数`",
"`G1201_公民館数`",
"`G1401_図書館数`",
"`H7701_テレビ放送受信契約数`",
"`H770101_衛星放送受信契約数`",
"`I5101_病院数`",
"`I510110_精神科病院数`",
"`I510120_一般病院数`",
"`I510150_療養病床を有する病院数`",
"`I5102_一般診療所数`",
"`I510201_有床一般診療所数`",
"`I5103_歯科診療所数`",
"`I5211_病院病床数`",
"`I5212_一般診療所病床数`",
"`I5511_介護老人保健施設数（基本票）`",
"`I5512_介護老人保健施設定員数（基本票）`",
"`J2221_保護施設数（基本票）（医療保護施設を除く）`",
"`J230127_介護老人福祉施設数（基本票）`",
"`J230128_介護老人福祉施設定員数（基本票）`",
"`J2304_老人福祉施設数（基本票）`",
"`J230411_養護老人ホーム数（基本票）`",
"`J230412_養護老人ホーム定員数（基本票）`",
"`J230421_有料老人ホーム数（基本票）`",
"`J230422_有料老人ホーム定員数（基本票）`",
"`J230431_軽費老人ホーム数（基本票）`",
"`J230432_軽費老人ホーム定員数（基本票）`",
"`J250204_児童福祉施設等数（基本票）`",
"`J250302_保育所等数（基本票）`",
"`J250303_公営保育所等数（基本票）`",
"`J2804_母子・父子福祉施設数（基本票）`",
"`J2905_障害者支援施設等数（基本票）`",
"`J2906_婦人保護施設数（基本票）`")
varsB <- c("exp_inoue_ratio_change",
"`A4101_出生数`",
"`A5104_転出者数`",
"`A7103_住民基本台帳世帯数（日本人）`",
"`E2501_小学校児童数`",
"`F1110_非労働力人口・通学`",
"`F2211_第2次産業就業者数`",
"`F2403_雇人のある業主数`",
"`H7701_テレビ放送受信契約数`",
"`H770101_衛星放送受信契約数`",
"`J230128_介護老人福祉施設定員数（基本票）`")
varsC <- c("exp_inoue_ratio_change",
"`A7103_住民基本台帳世帯数（日本人）`",
"`B1103_可住地面積`",
"`C2109_事業所数（国・地方公共団体）（経済センサス‐基礎調査結果）`",
"`E2501_小学校児童数`",
"`F2403_雇人のある業主数`",
"`G1401_図書館数`",
"`H7701_テレビ放送受信契約数`",
"`I5512_介護老人保健施設定員数（基本票）`",
"`J230128_介護老人福祉施設定員数（基本票）`")
# モデルAの最近傍マッチング
model_a_n <- matchit(as.formula(paste("uc ~", paste(varsA, collapse = " + "))),
mehod = "nearest",
distance = "mahalanobis",
data=inoue)
# モデルBの最近傍マッチング
model_b_n <- matchit(as.formula(paste("uc ~", paste(varsB, collapse = " + "))),
mehod = "nearest",
distance = "mahalanobis",
data=inoue)
# モデルCの最近傍マッチング
model_c_n <- matchit(as.formula(paste("uc ~", paste(varsC, collapse = " + "))),
mehod = "nearest",
distance = "mahalanobis",
data=inoue)次に遺伝的マッチングをする。コードはチャンクの中に埋め込んでいるが、チャンクの中身を表示すると、膨大な計算の途中経過まで出力されてしまうため、やむを得ず非表示にしてある。マッチングのための様々なパラメータは以下の通り。
method = “genetic”,
distance = “mahalanobis”,
pop.size = 1000,
nboots = 1000,
replace = TRUE,
verbose = TRUE,
estimand = “ATT”
マッチングの結果を確認
共変量のバランスを確かめる。いずれのモデルでも遺伝的マッチングのほうがAbsolute Standardized Mean Differencesの平均値が小さくなる。つまり、よりよいマッチングができている。
# モデルA、最近傍
balance_a_n <- bal.tab(model_a_n,un=TRUE)
balance_a_n$Balance %>%
as_tibble() %>%
mutate(un_abs_mean_dif=abs(Diff.Un),
adj_abs_mean_dif=abs(Diff.Adj)) %>%
summarize(mean(un_abs_mean_dif),
mean(adj_abs_mean_dif))## # A tibble: 1 × 2
## `mean(un_abs_mean_dif)` `mean(adj_abs_mean_dif)`
## <dbl> <dbl>
## 1 1.26 0.151# モデルA、遺伝的
balance_a_g <- bal.tab(model_a_g,un=TRUE)
balance_a_g$Balance %>%
as_tibble() %>%
mutate(un_abs_mean_dif=abs(Diff.Un),
adj_abs_mean_dif=abs(Diff.Adj)) %>%
summarize(mean(un_abs_mean_dif),
mean(adj_abs_mean_dif))## # A tibble: 1 × 2
## `mean(un_abs_mean_dif)` `mean(adj_abs_mean_dif)`
## <dbl> <dbl>
## 1 1.26 0.118# モデルB、最近傍
balance_b_n <- bal.tab(model_b_n,un=TRUE)
balance_b_n$Balance %>%
as_tibble() %>%
mutate(un_abs_mean_dif=abs(Diff.Un),
adj_abs_mean_dif=abs(Diff.Adj)) %>%
summarize(mean(un_abs_mean_dif),
mean(adj_abs_mean_dif))## # A tibble: 1 × 2
## `mean(un_abs_mean_dif)` `mean(adj_abs_mean_dif)`
## <dbl> <dbl>
## 1 0.723 0.122# モデルB、遺伝的
balance_b_g <- bal.tab(model_b_g,un=TRUE)
balance_b_g$Balance %>%
as_tibble() %>%
mutate(un_abs_mean_dif=abs(Diff.Un),
adj_abs_mean_dif=abs(Diff.Adj)) %>%
summarize(mean(un_abs_mean_dif),
mean(adj_abs_mean_dif))## # A tibble: 1 × 2
## `mean(un_abs_mean_dif)` `mean(adj_abs_mean_dif)`
## <dbl> <dbl>
## 1 0.723 0.0456# モデルC、最近傍
balance_c_n <- bal.tab(model_c_n,un=TRUE)
balance_c_n$Balance %>%
as_tibble() %>%
mutate(un_abs_mean_dif=abs(Diff.Un),
adj_abs_mean_dif=abs(Diff.Adj)) %>%
summarize(mean(un_abs_mean_dif),
mean(adj_abs_mean_dif))## # A tibble: 1 × 2
## `mean(un_abs_mean_dif)` `mean(adj_abs_mean_dif)`
## <dbl> <dbl>
## 1 1.79 0.127# モデルC、遺伝的
balance_c_g <- bal.tab(model_c_g,un=TRUE)
balance_c_g$Balance %>%
as_tibble() %>%
mutate(un_abs_mean_dif=abs(Diff.Un),
adj_abs_mean_dif=abs(Diff.Adj)) %>%
summarize(mean(un_abs_mean_dif),
mean(adj_abs_mean_dif))## # A tibble: 1 × 2
## `mean(un_abs_mean_dif)` `mean(adj_abs_mean_dif)`
## <dbl> <dbl>
## 1 1.79 0.0441教団施設の効果を確認
マッチングした市区町村を比べ、教団施設の有無によって井上氏の得票率変化量がどれだけ変わるかを見てみる。いずれのモデル、マッチング法でも0.07%ポイント前後で、有意な値となっている。
# モデルA、最近傍
data_a_n <- get_matches(model_a_n) %>%
as_tibble() %>%
left_join(read_csv("data/提出用/votes.csv") %>%
filter(year==2022) %>%
dplyr::select(code,投票者数))## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`summary(lm(inoue_ratio_change ~ uc, data = data_a_n, weights = 投票者数))##
## Call:
## lm(formula = inoue_ratio_change ~ uc, data = data_a_n, weights = 投票者数)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -452.28 -16.68 -0.52 19.20 221.42
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.10751 0.01098 9.788 < 2e-16 ***
## uc 0.06556 0.01388 4.724 2.98e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 41.41 on 516 degrees of freedom
## Multiple R-squared: 0.04146, Adjusted R-squared: 0.0396
## F-statistic: 22.32 on 1 and 516 DF, p-value: 2.985e-06confint(lm(inoue_ratio_change ~ uc, data = data_a_n, weights = 投票者数))## 2.5 % 97.5 %
## (Intercept) 0.08592909 0.12908308
## uc 0.03829490 0.09282246# モデルA、遺伝的
data_a_g <- get_matches(model_a_g) %>%
as_tibble() %>%
left_join(read_csv("data/提出用/votes.csv") %>%
filter(year==2022) %>%
dplyr::select(code,投票者数))## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`summary(lm(inoue_ratio_change ~ uc, data = data_a_g, weights = 投票者数))##
## Call:
## lm(formula = inoue_ratio_change ~ uc, data = data_a_g, weights = 投票者数)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -452.28 -18.85 -2.13 20.28 221.42
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.11446 0.01086 10.535 < 2e-16 ***
## uc 0.05861 0.01412 4.151 3.88e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 44.03 on 516 degrees of freedom
## Multiple R-squared: 0.03231, Adjusted R-squared: 0.03043
## F-statistic: 17.23 on 1 and 516 DF, p-value: 3.88e-05confint(lm(inoue_ratio_change ~ uc, data = data_a_g, weights = 投票者数))## 2.5 % 97.5 %
## (Intercept) 0.09311206 0.13580107
## uc 0.03086718 0.08634922# モデルB、最近傍
data_b_n <- get_matches(model_b_n) %>%
as_tibble() %>%
left_join(read_csv("data/提出用/votes.csv") %>%
filter(year==2022) %>%
dplyr::select(code,投票者数))## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`summary(lm(inoue_ratio_change ~ uc, data = data_b_n, weights = 投票者数))##
## Call:
## lm(formula = inoue_ratio_change ~ uc, data = data_b_n, weights = 投票者数)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -452.28 -13.89 -0.32 18.79 221.42
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.09898 0.01228 8.064 5.20e-15 ***
## uc 0.07408 0.01498 4.946 1.03e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 41.9 on 516 degrees of freedom
## Multiple R-squared: 0.04526, Adjusted R-squared: 0.04341
## F-statistic: 24.46 on 1 and 516 DF, p-value: 1.026e-06confint(lm(inoue_ratio_change ~ uc, data = data_b_n, weights = 投票者数))## 2.5 % 97.5 %
## (Intercept) 0.07486919 0.1230994
## uc 0.04465560 0.1035053# モデルB、遺伝的
data_b_g <- get_matches(model_b_g) %>%
as_tibble() %>%
left_join(read_csv("data/提出用/votes.csv") %>%
filter(year==2022) %>%
dplyr::select(code,投票者数))## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`summary(lm(inoue_ratio_change ~ uc, data = data_b_g, weights = 投票者数))##
## Call:
## lm(formula = inoue_ratio_change ~ uc, data = data_b_g, weights = 投票者数)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -452.28 -14.22 -1.10 19.77 221.42
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.10507 0.01133 9.277 < 2e-16 ***
## uc 0.06799 0.01418 4.795 2.14e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 41.66 on 516 degrees of freedom
## Multiple R-squared: 0.04265, Adjusted R-squared: 0.04079
## F-statistic: 22.99 on 1 and 516 DF, p-value: 2.136e-06confint(lm(inoue_ratio_change ~ uc, data = data_b_g, weights = 投票者数))## 2.5 % 97.5 %
## (Intercept) 0.08282280 0.12732505
## uc 0.04013147 0.09585021# モデルC、最近傍
data_c_n <- get_matches(model_c_n) %>%
as_tibble() %>%
left_join(read_csv("data/提出用/votes.csv") %>%
filter(year==2022) %>%
dplyr::select(code,投票者数))## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`summary(lm(inoue_ratio_change ~ uc, data = data_c_n, weights = 投票者数))##
## Call:
## lm(formula = inoue_ratio_change ~ uc, data = data_c_n, weights = 投票者数)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -452.28 -14.49 0.10 18.12 221.42
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.10120 0.01202 8.420 3.74e-16 ***
## uc 0.07186 0.01475 4.871 1.48e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 41.75 on 516 degrees of freedom
## Multiple R-squared: 0.04397, Adjusted R-squared: 0.04212
## F-statistic: 23.73 on 1 and 516 DF, p-value: 1.476e-06confint(lm(inoue_ratio_change ~ uc, data = data_c_n, weights = 投票者数))## 2.5 % 97.5 %
## (Intercept) 0.07758941 0.1248145
## uc 0.04288199 0.1008436# モデルC、遺伝的
data_c_g <- get_matches(model_c_g) %>%
as_tibble() %>%
left_join(read_csv("data/提出用/votes.csv") %>%
filter(year==2022) %>%
dplyr::select(code,投票者数))## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`summary(lm(inoue_ratio_change ~ uc, data = data_c_g, weights = 投票者数))##
## Call:
## lm(formula = inoue_ratio_change ~ uc, data = data_c_g, weights = 投票者数)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -452.28 -16.70 0.09 20.28 221.42
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.09917 0.01198 8.28 1.06e-15 ***
## uc 0.07389 0.01484 4.98 8.69e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 42.76 on 516 degrees of freedom
## Multiple R-squared: 0.04586, Adjusted R-squared: 0.04401
## F-statistic: 24.8 on 1 and 516 DF, p-value: 8.692e-07confint(lm(inoue_ratio_change ~ uc, data = data_c_g, weights = 投票者数))## 2.5 % 97.5 %
## (Intercept) 0.07564407 0.1227052
## uc 0.04474013 0.1030401良いマッチングができていることをグラフで確認
モデルAの遺伝的マッチングを例に、共変量のバランスがマッチングによって大幅に改善されていることを確認する。
love.plot(model_a_g,
threshold = 0.1,
abs = TRUE,
colors=c("black","black"),
shapes = c("triangle filled", "circle filled"),
sample.names = c("マッチングなし","マッチングあり"),
title="Figure1 共変量のバランス（モデルA、遺伝的）") +
theme(legend.position = c(0.8, 0.05),
axis.text.y = element_text(size = 6)) # 縦軸のテキストサイズを小さくする## Warning: Large mean differences detected; you may not be using standardized
## mean differences for continuous variables.## Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
## 3.5.0.
## ℹ Please use the `legend.position.inside` argument of `theme()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
井上氏の得票率変化量の違いをグラフで確認
モデルAで遺伝的マッチングをした各市区町村のペアをみると、教団施設のある自治体のほうが、ない自治体より井上氏の得票率増え幅が大きいケースが多い。
data_a_g %>%
select(subclass, uc, inoue_ratio_change, 投票者数) %>%
group_by(subclass) %>%
mutate(mean_vote = mean(投票者数)) %>%
select(subclass, uc, inoue_ratio_change, mean_vote) %>%
pivot_wider(names_from = uc, values_from = inoue_ratio_change) %>%
rename(平均投票者数 = mean_vote, 教団施設あり = `1`, 教団施設なし = `0`) %>%
ggplot(aes(x = 教団施設なし, y = 教団施設あり, size = 平均投票者数)) +
geom_point(alpha = .1) +
geom_abline(slope = 1, intercept = 0) +
scale_size_continuous(breaks = c(10000, 50000, 100000),
labels = c("10,000", "50,000", "100,000")) +
scale_x_continuous(breaks = seq(-0.3,0.7,by=0.2)) +
scale_y_continuous(breaks = seq(-1.5,2, by = 0.2)) +
theme(legend.title = element_text(size = 12),
legend.text = element_text(size = 10)) +
labs(title = "マッチングした各自治体での得票率変化量",
subtitle = "%ポイント。教団施設「あり」のほうが「なし」を上回るケースが多い")
付録
DID分析をする。
inoue2019_2022 <- read_csv("data/提出用/votes.csv") %>%
select(-自民_党_の得票) %>%
left_join(church)## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`did <- inoue2019_2022 %>%
mutate(inoue_ratio=井上得票*100/投票者数,
exp_inoue_ratio=(自民得票計-井上得票)*100/投票者数,
uc=ifelse(is.na(uc),0,1),
year_dummy=ifelse(year==2022,1,0)) %>%
select(-有権者数,-井上得票,-自民得票計) %>%
select(year,code,pref_city,inoue_ratio,everything()) %>%
left_join(read_csv("data/提出用/mun_data.csv") %>%
select(-地域),
by=c("code"="area_code")) %>%
select_if(negate(anyNA)) ## Rows: 1917 Columns: 263
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): area_code, 地域
## dbl (261): A2101_住民基本台帳人口（日本人）, A210101_住民基本台帳人口（日本人）（男）, A210102_住民基本台帳人口（日...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.controls <- colnames(did)[9:128] %>%
sapply(function(x) {
x <- sub("^", "`", x)
sub("$", "`", x)
})
# DID分析
lm(as.formula(paste("inoue_ratio ~ year_dummy + uc + year_dummy:uc + exp_inoue_ratio +",
paste(controls, collapse = " + "))),
data = did, weights = 投票者数) %>%
tidy() %>%
mutate(across(estimate:statistic, ~format(., scientific = FALSE, digits = 3))) %>%
mutate(across(estimate:p.value, ~format(., scientific = TRUE, digits = 3))) %>%
gt()| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | 0.46508188 | 0.08512869 | 5.4633 | 4.98e-08 |
| year_dummy | 0.09415377 | 0.02647046 | 3.5569 | 3.80e-04 |
| uc | 0.12601879 | 0.03626945 | 3.4745 | 5.18e-04 |
| exp_inoue_ratio | -0.00505216 | 0.00218096 | -2.3165 | 2.06e-02 |
| `A2101_住民基本台帳人口（日本人）` | -0.00001867 | 0.00001630 | -1.1452 | 2.52e-01 |
| `A210101_住民基本台帳人口（日本人）（男）` | 0.00003434 | 0.00002978 | 1.1530 | 2.49e-01 |
| `A210102_住民基本台帳人口（日本人）（女）` | NA | NA | NA | NA |
| `A2201_住民基本台帳人口（外国人）` | -0.00005219 | 0.00001066 | -4.8950 | 1.02e-06 |
| `A2301_住民基本台帳人口（総数）` | NA | NA | NA | NA |
| A4101_出生数 | 0.00063645 | 0.00016397 | 3.8815 | 1.06e-04 |
| A4200_死亡数 | 0.00033109 | 0.00012519 | 2.6446 | 8.21e-03 |
| `A5101_転入者数（日本人移動者）` | -0.00023901 | 0.00006712 | -3.5611 | 3.74e-04 |
| `A5102_転出者数（日本人移動者）` | -0.00005526 | 0.00004165 | -1.3268 | 1.85e-01 |
| A5103_転入者数 | 0.00019497 | 0.00006014 | 3.2418 | 1.20e-03 |
| A5104_転出者数 | 0.00005962 | 0.00003059 | 1.9491 | 5.14e-02 |
| `A7103_住民基本台帳世帯数（日本人）` | -0.00000471 | 0.00000659 | -0.7155 | 4.74e-01 |
| A9101_婚姻件数 | 0.00027608 | 0.00019644 | 1.4055 | 1.60e-01 |
| A9201_離婚件数 | -0.00111297 | 0.00048200 | -2.3091 | 2.10e-02 |
| `B1101_総面積（北方地域及び竹島を除く）` | -0.00005367 | 0.00008773 | -0.6117 | 5.41e-01 |
| `B1102_総面積（北方地域及び竹島を含む）` | 0.00000552 | 0.00007487 | 0.0737 | 9.41e-01 |
| B1103_可住地面積 | 0.00004181 | 0.00004475 | 0.9342 | 3.50e-01 |
| B1104_主要湖沼面積 | 0.00002539 | 0.00004524 | 0.5612 | 5.75e-01 |
| B1105_林野面積 | 0.00003784 | 0.00004916 | 0.7698 | 4.41e-01 |
| B1106_森林面積 | 0.00000909 | 0.00002738 | 0.3321 | 7.40e-01 |
| B1107_森林以外の草生地面積 | NA | NA | NA | NA |
| `C2109_事業所数（国・地方公共団体）（経済センサス‐基礎調査結果）` | 0.00125924 | 0.00047212 | 2.6672 | 7.68e-03 |
| `C310201_農家数（販売農家）` | 0.00001300 | 0.00004117 | 0.3157 | 7.52e-01 |
| `C310202_農家数（自給的農家）` | 0.00000901 | 0.00003500 | 0.2575 | 7.97e-01 |
| C3403_製造業事業所数 | -0.00004077 | 0.00014897 | -0.2737 | 7.84e-01 |
| C3404_製造業従業者数 | 0.00000127 | 0.00000413 | 0.3070 | 7.59e-01 |
| E1101_幼稚園数 | 0.00977053 | 0.00301707 | 3.2384 | 1.21e-03 |
| E1501_幼稚園在園者数 | -0.00012426 | 0.00002916 | -4.2619 | 2.08e-05 |
| E2101_小学校数 | 0.00082431 | 0.00531792 | 0.1550 | 8.77e-01 |
| E2401_小学校教員数 | 0.00014228 | 0.00047999 | 0.2964 | 7.67e-01 |
| E2501_小学校児童数 | 0.00000304 | 0.00003168 | 0.0960 | 9.24e-01 |
| E3101_中学校数 | 0.02079237 | 0.00780731 | 2.6632 | 7.77e-03 |
| E3401_中学校教員数 | -0.00254183 | 0.00073229 | -3.4711 | 5.24e-04 |
| E3501_中学校生徒数 | 0.00004987 | 0.00004306 | 1.1582 | 2.47e-01 |
| E3901_義務教育学校数 | 0.16278597 | 0.13276421 | 1.2261 | 2.20e-01 |
| E3902_義務教育学校前期課程学級数 | -0.03099479 | 0.03663169 | -0.8461 | 3.98e-01 |
| E3903_義務教育学校後期課程学級数 | 0.01209698 | 0.05515083 | 0.2193 | 8.26e-01 |
| E3904_義務教育学校教員数 | 0.00046792 | 0.00709723 | 0.0659 | 9.47e-01 |
| E3905_義務教育学校前期課程児童数 | 0.00067233 | 0.00101395 | 0.6631 | 5.07e-01 |
| E3906_義務教育学校後期課程生徒数 | -0.00019045 | 0.00129637 | -0.1469 | 8.83e-01 |
| E4101_高等学校数 | 0.00848925 | 0.01144459 | 0.7418 | 4.58e-01 |
| E4501_高等学校生徒数 | -0.00001358 | 0.00001313 | -1.0345 | 3.01e-01 |
| F1101_労働力人口 | -0.00107849 | 0.00018993 | -5.6783 | 1.47e-08 |
| `F110101_労働力人口（男）` | 0.00156571 | 0.00028451 | 5.5032 | 3.98e-08 |
| `F110102_労働力人口（女）` | NA | NA | NA | NA |
| F1102_就業者数 | 0.00146232 | 0.00024622 | 5.9390 | 3.13e-09 |
| `F110201_就業者数（男）` | -0.00168460 | 0.00034773 | -4.8445 | 1.32e-06 |
| `F110202_就業者数（女）` | NA | NA | NA | NA |
| `F1103_就業者数・主に仕事` | -0.00028570 | 0.00010924 | -2.6154 | 8.95e-03 |
| `F1104_就業者数・家事のほか仕事` | -0.00024138 | 0.00011271 | -2.1417 | 3.23e-02 |
| `F1105_就業者数・通学のかたわら仕事` | -0.00033173 | 0.00012629 | -2.6267 | 8.66e-03 |
| `F1106_就業者数・休業者` | NA | NA | NA | NA |
| F1107_完全失業者数 | NA | NA | NA | NA |
| `F110701_完全失業者数（男）` | NA | NA | NA | NA |
| `F110702_完全失業者数（女）` | NA | NA | NA | NA |
| F1108_非労働力人口 | 0.00003340 | 0.00002432 | 1.3731 | 1.70e-01 |
| `F110801_非労働力人口（男）` | -0.00011066 | 0.00004228 | -2.6173 | 8.90e-03 |
| `F110802_非労働力人口（女）` | NA | NA | NA | NA |
| `F1109_非労働力人口・家事` | -0.00000242 | 0.00002626 | -0.0921 | 9.27e-01 |
| `F1110_非労働力人口・通学` | 0.00000118 | 0.00002689 | 0.0438 | 9.65e-01 |
| `F1111_非労働力人口・その他` | NA | NA | NA | NA |
| `F2116_就業者数（65歳以上）` | -0.00000158 | 0.00002382 | -0.0661 | 9.47e-01 |
| F2201_第1次産業就業者数 | 0.00016244 | 0.00007688 | 2.1130 | 3.47e-02 |
| F2211_第2次産業就業者数 | 0.00006170 | 0.00006591 | 0.9361 | 3.49e-01 |
| F2221_第3次産業就業者数 | 0.00008615 | 0.00006788 | 1.2691 | 2.04e-01 |
| `F2401_雇用者数（国勢調査結果）` | -0.00020368 | 0.00011095 | -1.8358 | 6.65e-02 |
| F2402_役員数 | -0.00012263 | 0.00011351 | -1.0804 | 2.80e-01 |
| F2403_雇人のある業主数 | -0.00043535 | 0.00016053 | -2.7119 | 6.72e-03 |
| F2404_雇人のない業主数 | -0.00035804 | 0.00010693 | -3.3483 | 8.21e-04 |
| `F2405_家族従業者数（国勢調査結果）` | -0.00032485 | 0.00014614 | -2.2229 | 2.63e-02 |
| F2406_自営業主及び家族従業者数 | NA | NA | NA | NA |
| `F2409_雇用者数（正規の職員・従業員）` | -0.00009131 | 0.00002319 | -3.9369 | 8.41e-05 |
| `F2410_雇用者数（労働者派遣事業所の派遣社員）` | 0.00017677 | 0.00004897 | 3.6101 | 3.10e-04 |
| `F2411_雇用者数（パート・アルバイト・その他）` | NA | NA | NA | NA |
| F2701_自市区町村で従業している就業者数 | 0.00014328 | 0.00015351 | 0.9333 | 3.51e-01 |
| `F270101_自市区町村で従業している就業者数（男）` | 0.00000447 | 0.00025621 | 0.0175 | 9.86e-01 |
| `F270102_自市区町村で従業している就業者数（女）` | NA | NA | NA | NA |
| F2702_県内他市区町村で従業している就業者数 | 0.00010134 | 0.00015412 | 0.6575 | 5.11e-01 |
| `F270201_県内他市区町村で従業している就業者数（男）` | 0.00006622 | 0.00025843 | 0.2563 | 7.98e-01 |
| `F270202_県内他市区町村で従業している就業者数（女）` | NA | NA | NA | NA |
| F2703_他県で従業している就業者数 | 0.00013440 | 0.00015670 | 0.8577 | 3.91e-01 |
| `F270301_他県で従業している就業者数（男）` | 0.00000671 | 0.00026276 | 0.0255 | 9.80e-01 |
| `F270302_他県で従業している就業者数（女）` | NA | NA | NA | NA |
| F2705_他市区町村への通勤者数 | NA | NA | NA | NA |
| `F270501_他市区町村への通勤者数（男）` | NA | NA | NA | NA |
| `F270502_他市区町村への通勤者数（女）` | NA | NA | NA | NA |
| F2801_従業地による就業者数 | 0.00000300 | 0.00000126 | 2.3724 | 1.77e-02 |
| F2802_他県に常住している就業者数 | -0.00000902 | 0.00000237 | -3.8082 | 1.42e-04 |
| F2803_他市区町村からの通勤者数 | NA | NA | NA | NA |
| G1201_公民館数 | -0.00064366 | 0.00079625 | -0.8084 | 4.19e-01 |
| G1401_図書館数 | -0.01783976 | 0.00490428 | -3.6376 | 2.79e-04 |
| H7701_テレビ放送受信契約数 | -0.00000127 | 0.00000497 | -0.2558 | 7.98e-01 |
| H770101_衛星放送受信契約数 | 0.00000248 | 0.00000408 | 0.6076 | 5.44e-01 |
| I5101_病院数 | 0.02390061 | 0.00606458 | 3.9410 | 8.26e-05 |
| I510110_精神科病院数 | 0.00924477 | 0.01320591 | 0.7000 | 4.84e-01 |
| I510120_一般病院数 | NA | NA | NA | NA |
| I510150_療養病床を有する病院数 | -0.02833900 | 0.00732401 | -3.8693 | 1.11e-04 |
| I5102_一般診療所数 | -0.00046843 | 0.00062193 | -0.7532 | 4.51e-01 |
| I510201_有床一般診療所数 | -0.01980398 | 0.00900608 | -2.1990 | 2.79e-02 |
| I5103_歯科診療所数 | 0.00191198 | 0.00094580 | 2.0216 | 4.33e-02 |
| I5211_病院病床数 | -0.00006467 | 0.00002349 | -2.7534 | 5.93e-03 |
| I5212_一般診療所病床数 | 0.00078916 | 0.00057799 | 1.3654 | 1.72e-01 |
| `I5511_介護老人保健施設数（基本票）` | -0.01564718 | 0.01241654 | -1.2602 | 2.08e-01 |
| `I5512_介護老人保健施設定員数（基本票）` | 0.00000395 | 0.00014904 | 0.0265 | 9.79e-01 |
| `J2221_保護施設数（基本票）（医療保護施設を除く）` | -0.02398622 | 0.02083427 | -1.1513 | 2.50e-01 |
| `J230127_介護老人福祉施設数（基本票）` | -0.02612838 | 0.00720151 | -3.6282 | 2.89e-04 |
| `J230128_介護老人福祉施設定員数（基本票）` | 0.00033874 | 0.00010156 | 3.3353 | 8.60e-04 |
| `J2304_老人福祉施設数（基本票）` | -0.00412936 | 0.00428149 | -0.9645 | 3.35e-01 |
| `J230411_養護老人ホーム数（基本票）` | -0.00927873 | 0.02846338 | -0.3260 | 7.44e-01 |
| `J230412_養護老人ホーム定員数（基本票）` | -0.00055414 | 0.00034365 | -1.6125 | 1.07e-01 |
| `J230421_有料老人ホーム数（基本票）` | -0.00410053 | 0.00149486 | -2.7431 | 6.12e-03 |
| `J230422_有料老人ホーム定員数（基本票）` | 0.00014063 | 0.00004567 | 3.0792 | 2.09e-03 |
| `J230431_軽費老人ホーム数（基本票）` | 0.00087507 | 0.01214587 | 0.0720 | 9.43e-01 |
| `J230432_軽費老人ホーム定員数（基本票）` | -0.00008059 | 0.00023057 | -0.3495 | 7.27e-01 |
| `J250204_児童福祉施設等数（基本票）` | 0.00151380 | 0.00087670 | 1.7267 | 8.43e-02 |
| `J250302_保育所等数（基本票）` | -0.00313912 | 0.00219546 | -1.4298 | 1.53e-01 |
| `J250303_公営保育所等数（基本票）` | -0.01029339 | 0.00268479 | -3.8340 | 1.28e-04 |
| `J2804_母子・父子福祉施設数（基本票）` | -0.08989745 | 0.04154522 | -2.1638 | 3.05e-02 |
| `J2905_障害者支援施設等数（基本票）` | 0.00008769 | 0.00334738 | 0.0262 | 9.79e-01 |
| `J2906_婦人保護施設数（基本票）` | -0.10429151 | 0.05009789 | -2.0818 | 3.74e-02 |
| year_dummy:uc | 0.07664716 | 0.04008132 | 1.9123 | 5.59e-02 |
inoue2013 <- read_csv("data/提出用/福元データ23.csv") %>%
mutate(年=(as.double(as.double(str_sub(選挙回,-2,-1)))-19)*3+2001) %>%
mutate(名前=str_replace(名前," ","")) %>%
filter(名前=="井上義行") %>%
rename(pref=都道府県名,
city=市区町村名,
井上得票=市区町村別得票数,
party="党派・会派等",
name=名前,
year=年,
code=JISコード) %>%
select(year,
code,
pref,
city,
name,
井上得票,
投票者数,
有権者数) %>%
mutate(code=as.character(ifelse(str_length(code)==4,str_c(0,code),code))) %>%
mutate(city=str_replace(city,"ケ","ヶ"))## Rows: 307314 Columns: 17
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): 選挙回, 都道府県名, 市区町村名, 名前, 党派・会派等, 現新
## dbl (10): 都道府県コード, JISコード, 有権者数, 投票者数, 有効投票数, 定数, 候補者数, 市区町村別得票数, 得票総数, 年齢...
## lgl (1): 順位
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.did_chart <- bind_rows(inoue2013, read_csv("data/提出用/votes.csv") %>%
select(-自民_党_の得票)) %>%
left_join(church) %>%
group_by(year,uc) %>%
summarize(井上得票=sum(井上得票),
投票者数=sum(投票者数)) %>%
mutate(inoue_ratio=井上得票*100/投票者数) %>%
mutate(uc=ifelse(is.na(uc), "なし", "あり")) %>%
ggplot(aes(year,inoue_ratio,color=uc))+geom_line() +
scale_x_continuous(breaks = c(2013, 2019, 2022)) +
scale_color_manual(name = "教団施設",
values = c("あり" = "red", "なし" = "blue")) +
labs(title="3回の参院選における井上氏の得票率の推移",
x="年",
y="得票率（％）")## Rows: 3792 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): code, pref_city
## dbl (6): year, 有権者数, 投票者数, 井上得票, 自民得票計, 自民_党_の得票
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Joining with `by = join_by(code)`
## `summarise()` has grouped output by 'year'. You can override using the `.groups` argument.# Define the points and the slope for the new line
x1 <- 2019
y1 <- 0.19
slope <- 0.03266667
x2 <- 2022
y2 <- y1 + slope * (x2 - x1)
# Add the line segment to the plot
did_chart + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2),
color = "black", linetype = "dotted")## Warning in geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color = "black", : All aesthetics have length 1, but the data has 6 rows.
## ℹ Did you mean to use `annotate()`?
以上。