NHKから国民を守る党（N国党）のようなケッタイな政党を支持している地域はどこなのか、どういう人達が支持しているのかについて分析してみます。
N国党はネット上での選挙活動を主としているようで、これはドブ板選挙よりもデータ分析と親和性が高いです。
直前の参院選の投票結果を使います。
総務省｜令和元年7月21日執行 参議院議員通常選挙 速報結果
【得票率の一般モデルとポジショニング】
まず都道府県別の有権者数と得票数の相関を見ます。
なお得票数とは選挙区と比例区との合計値です。
当たり前ですが有権者数が多いと得票数も多くなります。
その関係は両対数で直線関係になることが自然で、データにも実際当てはまりがよさそうです。
式で表すと
(1)
得票数, 
有権者数です。
２つのパラメータ
パラメータ推定値は自民党
念の為
ほとんどの政党についてかなり高い
なぜか社民党だけ当てはまりが異常に悪く、特殊な政党なんだろうなと推測できますが今回ここは深堀しません。
こうして我々のモデルが得票数を説明する妥当なモデルであることが確認できました。
つぎに式(1)の両辺を
(2)
得票率これにより得票数のモデルを得票率のモデルに変換できます。
ただしここでの得票率とは一般的な
得票数 / 投票数
ではなく、投票率の影響を無視した潜在的な得票率
得票数 / 有権者数
を意味します。
得票率モデルを図示します。
自民党は右肩下がり（
つまり自民党は都会になるほど弱く、N国党は都会になるほど強いです。
他にも分かることがあります。
たとえばN国党は関東に拠点を置いて区議会議員もたくさん抱えていることもあり関東に強いと思われています。
しかし実のところN国党が関東で強いのは、都会に強いというN国党の傾向と関東には東京や神奈川や埼玉など人口が多い都会が多いという二つの要因によります。
なぜならば愛知や北海道や兵庫でも関東である埼玉や千葉と同等の得票数があるからです。
逆の見方をすればN国党は関東で活発に活動しているにもかかわらず、関東以外の都会にも同等水準の影響力を持っていると言えそうです。
なお大阪がやたらに悪いのは維新の勢力がやたら強いためでしょうか。
次にこの二つのパラメータ、基本勢力
ざっと解釈すると政党は都会性向
すなわち
- クラスタ１：田舎に強い
- 自民党、国民民主党
- クラスタ２：中立
- 公明党
- クラスタ３：都会に強い
- 立憲民主党、共産党、れいわ新選組、N国党
- クラスタ４：都会特化
- 日本維新の会
です。
左派野党がクラスタ３に偏っているのに対して、右派野党が散らばっているのが印象的です。
右派野党（国民民主党、日本維新の会、そしておそらくN国党）はポジショニングが異なるため、支持基盤の棲み分けができています。
それぞれの支持基盤で勢力を拡大できますし、良いタイミングで連合できれば大きな飛躍が狙えそうです。
自民党から見ても日本維新の会は魅力的で、もし民主主義でなければ資本の論理でM&Aの対象になるのかもしれません。
一方、左派野党のポジショニングは偏っています。
左派野党たちは彼らの中でパイの奪い合いをしている可能性があります。
そういう意味でれいわ新選組は今の路線で大きな飛躍は難しいような気がします。
れいわ新選組には路線を変更し、都会のワープアではなくマイルドヤンキーや限界集落を支えるなど田舎に活動を移すことをお勧めします。
N国党のヒトラー路線に対抗した毛沢東路線です。
【N国党の人気の地域差】
上の節で我々は得票率のモデルを構築し、このモデルによりN国党は都会に強い政党であり、有権者数が多い方が得票率が高くなることが分かりました。
このストーリーはあくまで一般論です。
一般論とは別に地域による特色はあるのでしょうか？
もちろんあります。
グラフの直線で表示しているのが我々のモデルで有権者数から予測できる得票数です。
よって線よりも上に表示されているのが一般論よりも強い支持がある地方で、逆に線よりも下であれば支持が弱い地方だと言えます。
赤色は候補者を擁立していなかった都道府県です。
候補者を擁立しなかった場合はモデルよりも得票が低いことが分かります。
人気の地域性をあぶり出すために、まずは候補者擁立の影響を補正しましょう。
式(2)を修正して候補者擁立を取り入れたものが次のモデルです。
(3)
このモデルで回帰分析を行うと
すなわち選挙区で候補者を立てると、その地域での得票数が1.48倍になるという意味です。
同時に都会性向 
候補者擁立の影響の補正後の得票数とモデル推定値との相関は下記のとおりになります。
上でも説明しましたが、線よりも上にあれば強い支持があり下であれば支持が弱いといえるので、このギャップを見れば地域での人気度を測ることができます。
都道府県を人気度で並び替えたものが下図です。
これからも色々と面白いことが分かります。
たとえば人気が高い地域のトップ５は上から岐阜、奈良、徳島、北海道、埼玉、と全く地理的に偏っていません。
人気ワースト地域についても同様です。
たとえば岩手県、宮城県、秋田県は人気があるにもかかわらず、候補者を擁立した青森県では得票が少ないです。
それにしても青森、大阪、福岡、新潟などは支持が低すぎる。
この原因は他の角度から分析する必要があるでしょう。
上の事実からN国党は特定の地域に人気が偏っているわけではないと予想されます。
これを確認するために人気度を地図上にプロットします。
画像の見せ方の問題で沖縄と小笠原諸島を隠しています。すいません。
色が明るい方が人気が高いことを意味しています。
一方東北地方は全体的に人気が高いですが、青森だけはめちゃくちゃ悪い。
このような隣接しているが人気が大きく異なる地域、たとえば『新潟と岐阜』などを比較分析すれば、N国党の支持の源泉や得票数の予測に繋げられる可能性があります。
これについてはそのうちまた続編として別の記事でやってみたいです。
【まとめ】
- N国党は都会の方が強いという傾向がある。関東だけで強いわけではない
- 都会度の影響を除くと人気に地理的な偏りは小さい。隣接している地域でも支持に極端な差があったりする。ここを深堀すれば得票数の予測ができるかもしれない
元データ
分析コード
#R
library(tidyverse)
library(readxl)
library(stringr)
library(httr)
library(estatapi)
library(modelr)
library(broom)
library(jpndistrict)
## get results of election ----
url <- "http://www.soumu.go.jp/main_content/000636675.xls"
if(!exists("tf")){
GET(url, write_disk(tf <- tempfile(fileext = ".xls")))
}
prefs <- read_excel(tf, sheet = "5110", range = "A9:A55", col_names = "pref", col_types = "text")
ranges <- c(
jimin = "B9:E55",
rikken = "F9:I55",
kokumin = "J9:M55",
koumei = "N9:Q55",
ishin = "B63:E109",
kyosan = "F63:I109",
shamin = "J63:M109",
reiwa = "N63:Q109",
nkoku = "B117:E163",
olive = "F117:I163",
kofuku = "J117:M163",
rodosha = "N117:Q163",
anraku = "B171:E217"
)
vote_by_pref <- map(
ranges,
read_excel,
path = tf,
sheet = "5110",
col_names = c("vote_total", "vote_rel", "vote_party", "vote_identity"),
col_types = rep("text", 4)
) %>%
map(mutate_all, parse_number) %>%
map(~bind_cols(., prefs)) %>%
imap(~mutate(.x, party = .y)) %>%
bind_rows %>%
mutate(pname = recode(party,
jimin = "自由民主党", rikken = "立憲民主党", kokumin = "国民民主党", koumei = "公明党", ishin = "日本維新の会",
kyosan = "共産党", shamin = "社民党", reiwa = "れいわ新選組", nkoku = "N国党",
.default = "その他")
)
# get population ----
appId <- mycode
datId <- "0003312321"
#meta <- estat_getMetaInfo(appId, datId)
if(!exists("pop_raw")){
pop_raw <- estat_getStatsData(
appId,
datId,
cdCat01 = c("001", "002"),
cdCat02 = paste0("0", c(1001:1017, 4018)),
cdCat03 = "002",
lvArea = 2) %>%
transmute(pref = `全国・都道府県`, age = 年齢5歳階級, sex = 男女別, value = value * 1000)
}
voters <- pop_raw %>%
filter(!(age %in% c("0～4歳", "5～9歳", "10～14歳", "15～19歳")))
# analysis ----
vote_pop <- vote_by_pref %>%
left_join(voters %>%
group_by(pref) %>%
summarise(voter_pop = sum(value)),
by = "pref"
) %>%
mutate(
logvote = log10(vote_total),
logpop = log10(voter_pop)
)
## 図１
gp_dist_vote <- vote_pop %>%
filter(party %in% c("jimin", "nkoku")) %>%
mutate(pref = str_replace(pref, "(県|府|都)$", "")) %>%
ggplot(aes(voter_pop, vote_total)) +
geom_text(aes(label = pref, color = pname), size = 5, alpha = 0.8) +
geom_smooth(method = "lm", aes(color = pname), se = FALSE, alpha = 0.5) +
scale_x_log10(breaks = c(1, 3, 10) * 10^6, labels = c("100万", "300万", "1000万")) +
scale_y_log10(breaks = c(1, 10, 100)*10^4, labels = c("1万", "10万", "100万")) +
theme(
axis.text = element_text(size = 12),
axis.title = element_text(size = 14),
legend.text = element_text(size = 10),
legend.position = c(1, 0),
legend.justification = c(1,0)
) +
labs(
x = "有権者数（人）（対数軸）",
y = "得票数（人）（対数軸）",
color = "",
title = "両対数軸で見ると有権者数と得票数は直線の関係になる。N国党の方が自民党よりも傾きが大きい。",
caption = "令和元年７月２１日参院選選挙結果, 総務省 都道府県別人口推計 平成３０年１０月１日"
)
vote_models <- vote_pop %>%
nest(-party, -pname) %>%
mutate(model = map(data, ~lm(data = ., logvote ~ logpop)))
## 図２
gp_r2 <- vote_models %>%
mutate(rsq = map_dbl(model, . %>% summary %>% .[["r.squared"]])) %>%
filter(pname != "その他") %>%
ggplot(aes(pname, rsq)) +
geom_point(size = 10, shape = 18) +
theme(axis.text = element_text(size = 12)) +
labs(
x = "",
y = "R-square",
title = "R^2は十分高く我々のモデルは正しいことが期待できる。社民党以外では"
)
## 図３
gp_dist_voterel <- vote_pop %>%
filter(party %in% c("jimin", "nkoku"))%>%
mutate(pref = str_replace(pref, "(県|府|都)$", ""))%>%
ggplot(aes(voter_pop, vote_total/voter_pop)) +
geom_text(aes(label = pref, color = pname), size = 5, alpha = 0.8) +
geom_smooth(method = "lm", aes(color = pname), se = FALSE, alpha = 0.5) +
scale_x_log10(breaks = c(1, 3, 10) * 10^6, labels = c("100万", "300万", "1000万")) +
scale_y_log10() +
theme(
axis.text = element_text(size = 12),
axis.title = element_text(size = 14),
legend.text = element_text(size = 10),
legend.position = c(1, 0),
legend.justification = c(1,0)
) +
labs(
x = "有権者数（人）（対数軸）",
y = "潜在得票率（対数軸）",
color = "",
title = "傾きが右肩上がりならば都会で強い、右肩下がりならば田舎で強い。",
caption = "令和元年７月２１日参院選選挙結果, 総務省 都道府県別人口推計 平成３０年１０月１日"
)
## 図４
gp_position <- vote_models %>%
mutate(coef = map(model, tidy)) %>%
unnest(coef) %>%
select(party, pname, term, estimate) %>%
spread(term, estimate)%>%
filter(pname != "その他", party != "shamin") %>%
ggplot(aes(`(Intercept)`, logpop - 1)) +
geom_text(aes(label = pname)) +
geom_hline(yintercept = 0, alpha = 0.3, size = 2) +
theme(
axis.text = element_text(size = 12),
axis.title = element_text(size = 12)
) +
labs(
x = "基本勢力b(対数軸)",
y = "都会性向a-1",
caption = "社民党はモデルが適合していないので除外した。"
)
no_yoritu <- c("富山県", "石川県", "奈良県", "和歌山県", "山口県", "佐賀県", "宮崎県", "鹿児島県")
vote_models_nkoku <- vote_models %>%
filter(party == "nkoku") %>%
mutate(data = map2(data, model, add_predictions)) %>%
mutate(data = map2(data, model, add_residuals)) %>%
unnest(data) %>%
mutate(yoritu = if_else(pref %in% no_yoritu, FALSE, TRUE))
## 図５
gp_model_resid_nkoku <- vote_models_nkoku %>%
mutate(pref = str_replace(pref, "(県|府|都)$", "")) %>%
ggplot(aes(logpop, logvote)) +
geom_text(aes(label = pref, color = yoritu), size = 5, alpha = 0.8) +
geom_smooth(method = "lm", se = FALSE, color = "gray40", alpha = 0.5) +
geom_linerange(aes(ymin = logvote, ymax = pred)) +
scale_x_continuous(breaks = log10(c(1, 3, 10) * 10^6), labels = c("100万", "300万", "1000万")) +
scale_y_continuous(breaks = log10(c(1, 3, 10) * 10^4), labels = c("1万", "3万", "10万")) +
theme(
axis.text = element_text(size = 12),
axis.title = element_text(size = 12)
) +
labs(
x = "有権者数（対数）",
y = "N国党得票数（対数）",
color = "候補者擁立"
)
m2 <- lm(data = vote_models_nkoku, logvote ~ logpop + yoritu)
vote_models2_nkoku <- vote_models_nkoku %>%
add_residuals(m2) %>%
add_predictions(m2) %>%
mutate(
yoritu_effect = 10^(m2$coefficients["yorituTRUE"]*!yoritu),
vote_mod = vote_total * yoritu_effect,
pred_partial = 10^pred * yoritu_effect
)
gp_model2_resid_nkoku <- vote_models2_nkoku %>%
mutate(pref = str_replace(pref, "(県|府|都)$", "")) %>%
ggplot(aes(voter_pop, vote_mod)) +
geom_text(aes(label = pref, color = yoritu), size = 5, alpha = 0.8) +
geom_smooth(method = "lm", se = FALSE, color = "gray40", alpha = 0.5) +
geom_linerange(aes(ymin = vote_mod, ymax = pred_partial)) +
scale_x_log10() + scale_y_log10() +
theme(
axis.text = element_text(size = 12),
axis.title = element_text(size = 12)
) +
labs(
x = "有権者数（対数）",
y = "N国党得票数（候補者擁立したとき）（対数）",
color = "候補者擁立"
)
## model residual analysis
## 図６
gp_resid_order_nkoku <- vote_models2_nkoku %>%
mutate(pref = str_replace(pref, "(県|府|都)$", "") %>% reorder(resid)) %>%
ggplot(aes(pref, resid)) +
geom_point(aes(color = resid > 0), size = 2) +
geom_hline(yintercept = 0, size = 2, alpha = 0.3) +
theme(
axis.text.x = element_text(size = 12, angle = 90, vjust = 0.5),
legend.position = "none"
) +
labs(
x = "",
y = "N国党の人気度"
)
## plot on maps
### get map data
if(!exists("pref_maps")){
pref_maps <- map(1:47, jpn_pref, district = FALSE)
}
## 図７
gp_nkoku_maps <- ggplot() +
map(pref_maps, ~geom_sf(data = ., aes(fill = filter(vote_models2_nkoku, pref == .$prefecture)$resid))) +
theme(axis.text = element_blank()) +
labs(fill = "strong<->weak")