library(DT)
library(plyr)
library(tidyverse)theme_set(theme_bw(base_size = 10,
base_family = "HiraginoSans-W3"))theme_set(theme_gray(base_size = 10,
base_family = "HiraginoSans-W3")) theme_set(theme_bw(base_size = 10, base_family = "HiraginoSans-W3"))hr96-21.csv)RProject フォルダ内に data という名称のフォルダを作成するcsv ファイルがパソコンにダウンロードされ、data 内に自動的に保存されるdownload.file(url = "http://www.ner.takushoku-u.ac.jp/masano/class_material/waseda/keiryo/Data/hr96-21.csv",
destfile = "data/hr96-21.csv")注意:一度ダウンロードを完了すれば、このコマンドを実行する必要はありません
hr96-21.csv をクリックしてデータをパソコンにダウンロード
RProject フォルダ内に data という名称のフォルダを作成する
ダウンロードした hr96-21.csv を手動でRProject フォルダ内にある data フォルダに入れる
hr96-21.csv を読み取るna = "."というコマンドは「欠損値をドットで置き換える」という意味numeric)」型のデータが「」文字型 (character)」として認識されるなど、エラーの原因になるため、読み取る時点で事前に対処するhr <- read_csv("data/hr96-21.csv",
na = ".") locale()関数を使って日本語エンコーディング (cp932) を指定するhr <- read_csv("data/hr96-21.csv",
na = ".",
locale = locale(encoding = "cp932"))hr <- read.csv("data/hr96-21.csv",
na = ".") hr96_17.csv は1996年に衆院選挙に小選挙区が導入されて以来実施された 9 回の衆議院選挙(1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021)の結果のデータhr に含まれる変数名を表示させるnames(hr) [1] "year" "pref" "ku" "kun"
[5] "wl" "rank" "nocand" "seito"
[9] "j_name" "gender" "name" "previous"
[13] "age" "exp" "status" "vote"
[17] "voteshare" "eligible" "turnout" "seshu_dummy"
[21] "jiban_seshu" "nojiban_seshu"
df1 には 22 個の変数が入っている| 変数名 | 詳細 |
|---|---|
| year | 選挙年 (1996-2017) |
| pref | 都道府県名 |
| ku | 小選挙区名 |
| kun | 小選挙区 |
| rank | 当選順位 |
| wl | 選挙の当落: 1 = 小選挙区当選、2 = 復活当選、0 = 落選 |
| nocand | 立候補者数 |
| seito | 候補者の所属政党 |
| j_name | 候補者の氏名(日本語) |
| name | 候補者の氏名(ローマ字) |
| previous | これまでの当選回数(当該総選挙結果は含まない) |
| gender | 立候補者の性別: “male”, “female” |
| age | 立候補者の年齢 |
| exp | 立候補者が使った選挙費用(総務省届け出) |
| status | 候補者のステータス: 0 = 非現職、1 現職、2 = 元職 |
| vote | 得票数 |
| voteshare | 得票率 (%) |
| eligible | 小選挙区の有権者数 |
| turnout | 小選挙区の投票率 (%) |
| seshu_dummy | 世襲候補者ダミー: 1 = 世襲、0 = 非世襲(地盤世襲 or 非世襲) |
| jiban_seshu | 地盤の受け継ぎ元の政治家の氏名と関係 |
| nojiban_seshu | 世襲元の政治家の氏名と関係 |
str(hr)spec_tbl_df [9,660 × 22] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
$ year : num [1:9660] 1996 1996 1996 1996 1996 ...
$ pref : chr [1:9660] "愛知" "愛知" "愛知" "愛知" ...
$ ku : chr [1:9660] "aichi" "aichi" "aichi" "aichi" ...
$ kun : num [1:9660] 1 1 1 1 1 1 1 2 2 2 ...
$ wl : num [1:9660] 1 0 0 0 0 0 0 1 0 2 ...
$ rank : num [1:9660] 1 2 3 4 5 6 7 1 2 3 ...
$ nocand : num [1:9660] 7 7 7 7 7 7 7 8 8 8 ...
$ seito : chr [1:9660] "新進" "自民" "民主" "共産" ...
$ j_name : chr [1:9660] "河村たかし" "今枝敬雄" "佐藤泰介" "岩中美保子" ...
$ gender : chr [1:9660] "male" "male" "male" "female" ...
$ name : chr [1:9660] "KAWAMURA, TAKASHI" "IMAEDA, NORIO" "SATO, TAISUKE" "IWANAKA, MIHOKO" ...
$ previous : num [1:9660] 2 2 2 0 0 0 0 2 0 0 ...
$ age : num [1:9660] 47 72 53 43 51 51 45 51 71 30 ...
$ exp : num [1:9660] 9828097 9311555 9231284 2177203 NA ...
$ status : num [1:9660] 1 2 1 0 0 0 0 1 2 0 ...
$ vote : num [1:9660] 66876 42969 33503 22209 616 ...
$ voteshare : num [1:9660] 40 25.7 20.1 13.3 0.4 0.3 0.2 32.9 26.4 25.7 ...
$ eligible : num [1:9660] 346774 346774 346774 346774 346774 ...
$ turnout : num [1:9660] 49.2 49.2 49.2 49.2 49.2 49.2 49.2 51.8 51.8 51.8 ...
$ seshu_dummy : num [1:9660] 0 0 0 0 0 0 0 0 1 0 ...
$ jiban_seshu : chr [1:9660] NA NA NA NA ...
$ nojiban_seshu: chr [1:9660] NA NA NA NA ...
- attr(*, "spec")=
.. cols(
.. year = col_double(),
.. pref = col_character(),
.. ku = col_character(),
.. kun = col_double(),
.. wl = col_double(),
.. rank = col_double(),
.. nocand = col_double(),
.. seito = col_character(),
.. j_name = col_character(),
.. gender = col_character(),
.. name = col_character(),
.. previous = col_double(),
.. age = col_double(),
.. exp = col_double(),
.. status = col_double(),
.. vote = col_double(),
.. voteshare = col_double(),
.. eligible = col_double(),
.. turnout = col_double(),
.. seshu_dummy = col_double(),
.. jiban_seshu = col_character(),
.. nojiban_seshu = col_character()
.. )
numeric 文字は character として認識されていることがわかるDT::datatable(hr)turnout) の平均 (mean.turnout) を計算するdf1 <- hr %>%
filter(rank == 1) %>%
ddply(.(year), summarize,
mean.turnout = mean(turnout)) %>%
round(digits = 1)head(df1) year mean.turnout
1 1996 60.3
2 2000 63.1
3 2003 60.2
4 2005 67.8
5 2009 69.6
6 2012 59.4
・str() 関数を使って欠測値を確認
str(df1)'data.frame': 9 obs. of 2 variables:
$ year : num 1996 2000 2003 2005 2009 ...
$ mean.turnout: num 60.3 63.1 60.2 67.8 69.6 59.4 NA NA 56.1
・2014年と2017年総選挙における投票率が欠測 (NA) している
→ na.omit()関数を使って欠測のない観測だけを残す
df1 <- na.omit(df1)・1996年から2021年総選挙における投票率の平均を計算する
mean(df1$mean.turnout)[1] 62.35714
df1 %>%
ggplot(aes(x = year, y = mean.turnout)) +
geom_point() +
geom_line() +
ggtitle("総選挙の得票率: 1996-2021") +
geom_text(aes(y = mean.turnout + 0.5, label = mean.turnout), size = 3, vjust = 0) +
geom_text(label = "平均投票率: 63.4%",
x = 2007, y = 64, family = "HiraginoSans-W3", color = "tomato", size = 3) +
geom_hline(yintercept = mean(df1$mean.turnout), # 投票率の平均に線を引く
col = "tomato",
linetype = "dotted",
size = 1) +
labs(x = "総選挙年", y = "投票率(%)") hr を使って自民党と民主党候補者それぞれの得票率を選挙ごとに計算ddply() 使うためのパケージをロードするlibrary(plyr)vs_ldp_dpj <- hr %>%
filter(seito == "自民" | seito == "民主") %>% # 自民と民主だけを選ぶ
plyr::ddply(.(year, seito), summarize, # 選挙年- 政党ごとに得票率の平均を計算
mean.vs = mean(voteshare, na.rm = TRUE)) vs_ldp_dpj$mean.vs <- round(vs_ldp_dpj$mean.vs,
digits = 1) # 小数点 1 位まで表示
head(vs_ldp_dpj) year seito mean.vs
1 1996 自民 40.9
2 1996 民主 22.1
3 2000 自民 46.2
4 2000 民主 33.6
5 2003 自民 48.1
6 2003 民主 40.5
f1 <- vs_ldp_dpj %>%
ggplot(aes(x = year, y = mean.vs,
color = seito, linetype = seito, shape = seito)) +
geom_point() +
geom_line() +
geom_text(aes(y = mean.vs + 0.5, label = mean.vs), size = 4, vjust = 0) +
ggtitle("自民党と民主党候補者の平均得票率: 1996-2021年衆院選") +
labs(x = "総選挙年", y = "得票率") +
theme(legend.position = c(0.93, 0.2))
f1 ・自民党と民主党それぞれの得票率の記述統計を示してみる
summary_by_party <- vs_ldp_dpj %>%
group_by(seito) %>%
summarise(mean_vs = mean(mean.vs),
count = n())summary_by_party# A tibble: 2 x 3
seito mean_vs count
<chr> <dbl> <int>
1 自民 47.0 9
2 民主 35.3 7
注:2017年総選挙では民主党は解党したため、2017年総選挙の民主党の得票率データは欠測
・グラフを figs フォルダ に保存(任意のサイズに指定できる)
ggsave(filename = "fig/vs_ldp_dpj.png",
width = 10, height = 7, units = "cm")vs_ldp_cdp <- hr %>%
filter(seito == "自民" | seito == "立憲") %>% # 自民と民主だけを選ぶ
plyr::ddply(.(year, seito), summarize, # 選挙年- 政党ごとに得票率の平均を計算
mean.vs = mean(voteshare, na.rm = TRUE)) vs_ldp_cdp$mean.vs <- round(vs_ldp_cdp$mean.vs,
digits = 1) # 小数点 1 位まで表示
head(vs_ldp_dpj) year seito mean.vs
1 1996 自民 40.9
2 1996 民主 22.1
3 2000 自民 46.2
4 2000 民主 33.6
5 2003 自民 48.1
6 2003 民主 40.5
f1 <- vs_ldp_cdp %>%
ggplot(aes(x = year, y = mean.vs,
color = seito, linetype = seito, shape = seito)) +
geom_point() +
geom_line() +
geom_text(aes(y = mean.vs + 0.5, label = mean.vs), size = 4, vjust = 0) +
ggtitle("自民党と立憲民主党候補者の平均得票率: 1996-2021年衆院選") +
labs(x = "総選挙年", y = "得票率") +
theme(legend.position = c(0.5, 0.2))
f1hr を使って安倍晋三氏のこれまでの選挙結果の履歴を表示してみようhr に含まれる変数を表示させるnames(hr) [1] "year" "pref" "ku" "kun"
[5] "wl" "rank" "nocand" "seito"
[9] "j_name" "gender" "name" "previous"
[13] "age" "exp" "status" "vote"
[17] "voteshare" "eligible" "turnout" "seshu_dummy"
[21] "jiban_seshu" "nojiban_seshu"
filter() 関数を使って取り出し、shinzo と名前を付けるshinzo <- hr %>%
filter(name == "ABE, SHINZO") %>%
select(year, pref, kun, seito, age, nocand, rank, previous, vote, voteshare)datatable 関数を使うと、インターアクティブなデータの記述統計を表示できるDT::datatable(shinzo)mean(shinzo$voteshare) # voteshare の平均値[1] 71.15444
安倍晋三氏の得票率を1996年から2021年まで表示する
ggplot(shinzo, aes(x = year, y = voteshare)) +
geom_point() +
geom_line() +
ggtitle("安倍晋三氏の得票率: 1996-2021衆院選") +
geom_hline(yintercept = mean(shinzo$voteshare), # 安倍氏の得票率の平均に線を引く
col = "tomato",
linetype = "dotted",
size = 1) +
geom_text(aes(y = voteshare + 1, label = voteshare), size = 4, vjust = 0) +
geom_text(label = "平均得票率: 71.15%",
x = 2014, y = 72, family = "HiraginoSans-W3", color = "tomato", size = 3) +
labs(x = "総選挙年", y = "得票率(%)") hr を使って石破茂氏のこれまでの選挙結果の履歴を表示してみようfilter() 関数を使って取り出し、shigeru と名前を付けるshigeru <- hr %>%
filter(name == "ISHIBA, SHIGERU") %>%
select(year, pref, kun, seito, age, nocand, rank, previous, vote, voteshare)datatable 関数を使うと、インターアクティブなデータの記述統計を表示できるDT::datatable(shigeru)mean(shigeru$voteshare) # voteshare の平均値[1] 70.76667
ggplot(shigeru, aes(x = year, y = voteshare)) +
geom_point() +
geom_line() +
ggtitle("石破茂氏の得票率: 1996-2021衆院選") +
geom_text(aes(y = voteshare + 1, label = voteshare), size = 4, vjust = 0) +
geom_text(label = "平均得票率: 70.77%",
x = 2014, y = 68, family = "HiraginoSans-W3", color = "blue", size = 3) +
geom_hline(yintercept = mean(shigeru$voteshare), # 石破氏の得票率の平均に線を引く
col = "blue",
linetype = "dotted",
size = 1) +
geom_text(aes(y = voteshare + 1, label = voteshare), size = 4, vjust = 0) +
labs(x = "総選挙年", y = "得票率(%)") filter() 関数を使って取り出し、abe_ishiba と名前を付けるabe_ishiba <- hr %>%
filter(name == "ISHIBA, SHIGERU" | name == "ABE, SHINZO") %>%
select(year, pref, kun, seito, j_name, age, nocand, rank, previous, vote, voteshare)datatable 関数を使うと、インターアクティブなデータの記述統計を表示できるDT::datatable(abe_ishiba)vs_abe_ishiba <- ggplot(data = abe_ishiba, aes(x = year, y = voteshare, colour = j_name, linetype = j_name, shape = j_name)) +
geom_point() +
geom_line() +
ggtitle("安倍晋三氏と石破茂氏の得票率: 1996-2021衆院選") +
geom_text(aes(y = voteshare + 1, label = voteshare), size = 4, vjust = 0) +
theme(legend.position = c(0.85, 0.45)) +
labs(x = "総選挙年", y = "得票率(%)")
vs_abe_ishiba1996年から2021年衆議院における、小泉進次郎氏と河野太郎氏の選挙結果(得票率)の履歴を折れ線グラフで「同時に」表示しなさい
その際、小泉氏、河野氏それぞれの得票率の平均を点線で示しなさい
dplyr::arrange(desc())
- 得票率の高い候補者順に並べる(=降順 (descending) )
- 得票率の高い順にソートする → 得票率が欠損でないことが必要
- 表示する変数を指定 → 選挙年、選挙区名、政党名、年齢、氏名、票数、得票率
hr %>%
filter(!is.na(voteshare)) %>% # 欠損のある投票率を除外
arrange(desc(voteshare)) %>% # 得票率を大きい順に並べる
select(year, pref, seito, age, j_name, wl, vote, voteshare) %>%
print(n = 20) # 全て表示したければ n = inf と指定# A tibble: 9,660 x 8
year pref seito age j_name wl vote voteshare
<dbl> <chr> <chr> <dbl> <chr> <dbl> <dbl> <dbl>
1 2009 栃木 みんな 57 渡辺喜美 1 142482 95.3
2 2003 愛知 民主 38 古本伸一郎 1 181747 89.6
3 2017 宮城 自民 57 小野寺五典 1 123871 85.7
4 1996 富山 自民 42 住博司 1 126734 84.8
5 2012 鳥取 自民 55 石破茂 1 124746 84.5
6 2021 鳥取 自民 64 石破茂 1 105441 84.1
7 2017 鳥取 自民 60 石破茂 1 106425 83.6
8 2000 愛媛 自民 52 山本公一 1 142982 83.6
9 1996 栃木 自民 44 渡辺喜美 1 90082 83.4
10 2000 茨城 自民 44 梶山弘志 1 139817 83.4
11 2000 栃木 自民 48 渡辺喜美 1 112358 83.4
12 2014 神奈川 自民 33 小泉進次郎 1 168953 83.3
13 2021 宮城 自民 61 小野寺五典 1 119555 83.2
14 2012 鹿児島 自民 67 森山裕 1 107933 83.1
15 2003 佐賀 自民 56 今村雅弘 1 107522 82.4
16 2012 宮崎 自民 47 古川禎久 1 119174 81.8
17 2014 富山 自民 53 橘慶一郎 1 138991 81.2
18 2021 宮崎 自民 56 古川禎久 1 111845 80.7
19 2021 広島 自民 64 岸田文雄 1 133704 80.7
20 2014 鳥取 自民 57 石破茂 1 93105 80.3
# … with 9,640 more rows
渡辺喜美氏はずっと高い得票率なのか?
filter() 関数を使って取り出し yoshimi と名前を付けるyoshimi <- hr %>%
filter(j_name == "渡辺喜美") %>%
select(year, pref, kun, seito, wl, nocand, age, previous, vote, voteshare)DT::datatable(yoshimi)mean(yoshimi$voteshare) # voteshare の平均値[1] 71.62857
theme_set(theme_classic(base_size = 10,
base_family = "HiraginoSans-W3"))ggplot(yoshimi, aes(x = year, y = voteshare)) +
geom_point() +
geom_line() +
ggtitle("渡辺喜美氏の得票率: 1996-2014衆院選") +
geom_hline(yintercept = mean(yoshimi$voteshare), # 渡辺氏の得票率の平均に線を引く
col = "tomato",
linetype = "dotted",
size = 1) +
geom_text(aes(y = voteshare + 1, label = voteshare), size = 4, vjust = 0) +
geom_text(label = "平均得票率: 71.6%",
x = 2000, y = 73, family = "HiraginoSans-W3", color = "tomato", size = 3) +
geom_text(aes(y = voteshare + 1, label = voteshare), size = 4, vjust = 0) +
labs(x = "総選挙年", y = "得票率(%)") なぜ渡辺喜美氏は95%も得票したのか?
「第45回衆議院議員総選挙にはみんなの党公認で栃木3区から出馬し、5選 当初、自民党は栃木3区に元法務大臣の森山眞弓を擁立する方向で調整していたが、自民党栃木県連の反対により撤回し、公明党も候補者を擁立しない与党空白区となった 栃木3区は日本共産党も候補を擁立しない共産空白区となり、他に候補が立候補する気配を見せなかったため、戦後衆議院選挙初の無投票当選の可能性があったが、幸福実現党の斎藤克巳が立候補したため無投票当選とはならなかった 選挙結果は渡辺が14万2482票- 得票率95.3%で圧勝 渡辺の得票率は、小選挙区制導入後現在に至るまでの最高記録である (ウィキペディアの記事からの引用)」
yoshimi_2009 <- hr %>%
filter(year == 2009,
pref == "栃木",
kun == 3) %>%
select(year, pref, kun, seito, nocand, j_name, age, vote, voteshare)
yoshimi_2009# A tibble: 2 x 9
year pref kun seito nocand j_name age vote voteshare
<dbl> <chr> <dbl> <chr> <dbl> <chr> <dbl> <dbl> <dbl>
1 2009 栃木 3 みんな 2 渡辺喜美 57 142482 95.3
2 2009 栃木 3 幸福 2 斎藤克巳 53 7024 4.7
2014年総選挙での渡辺喜美氏は?
「2014年に、後述の8億円借入問題が発生し、4月にみんなの党の代表の辞任を余儀なくされる これを契機にみんなの党は離党者が相次ぐなど、内部対立が激しくなり、第47回衆議院議員総選挙を前に解党に至る 渡辺本人は無所属で出馬するも、落選した 」(上記ウィキペディアの記事からの引用)
yoshimi_2014 <- hr %>%
filter(year == 2014,
pref == "栃木",
kun == 3) %>%
select(year, pref, kun, seito, nocand, j_name, age, vote, voteshare)
yoshimi_2014# A tibble: 3 x 9
year pref kun seito nocand j_name age vote voteshare
<dbl> <chr> <dbl> <chr> <dbl> <chr> <dbl> <dbl> <dbl>
1 2014 栃木 3 自民 3 簗和生 35 62814 48.7
2 2014 栃木 3 無所 3 渡辺喜美 62 51627 40.1
3 2014 栃木 3 共産 3 秋山幸子 63 14438 11.2
その後の渡辺喜美氏は?
「2017年10月の第48回衆議院議員総選挙が間近に迫った同年9月に小池百合子による希望の党の設立に影の存在として関わり、衆議院栃木3区へのくら替え出馬に意欲を示していたが、小池側の要請で出馬断念し、代わりに妹の渡辺美由紀を栃木3区から希望の党候補として擁立したが落選 その後、「当面は無所属議員として仕事をやらせてもらう」と述べ、希望の党に参加しない意向を明らかにした 11月1日の首班指名選挙では安倍晋三に投票した 」(上記ウィキペディアの記事からの引用)
yoshimi_2017 <- hr %>%
filter(year == 2017,
pref == "栃木",
kun == 3) %>%
select(year, pref, kun, seito, nocand, j_name, age, vote, voteshare)
yoshimi_2017# A tibble: 4 x 9
year pref kun seito nocand j_name age vote voteshare
<dbl> <chr> <dbl> <chr> <dbl> <chr> <dbl> <dbl> <dbl>
1 2017 栃木 3 自民 4 簗和生 38 74371 57.8
2 2017 栃木 3 希望 4 渡辺美由紀 58 42820 33.3
3 2017 栃木 3 共産 4 槙昌三 74 9990 7.76
4 2017 栃木 3 緒派 4 石渡剛 48 1561 1.21
最も選挙費用を費やしている小選挙区は?
hr)から2012年のデータだけを抜き出して hr2012 と名前をつけるhr2012 <- hr %>%
dplyr::filter(year == 2012) %>%
dplyr::select(exp, pref, ku, kun)datatable 関数を使うと、インターアクティブなデータの記述統計を表示できるDT::datatable(hr2012)exp) を総務省に報告「小選挙区別」に候補者が使った選挙費用の平均を計算したい
nocand) が異なるため、エクセルでは計算が大変(^_^;)変数一覧
names(hr2012)[1] "exp" "pref" "ku" "kun"
exp のクラスをチェックするstr(hr2012$exp) num [1:1294] 15215857 3864350 11853832 1220570 7592182 ...
exp のクラスが numeric だと確認できたexp のクラスが numeric 以外なら(例えば character なら)numeric に変更するhr2012$exp <- as.numeric(as.character(hr2012$exp))exp のクラスが character から numeric に変更されたことを確認すること
衆議院の小選挙区は「愛知 1」のように「都道府県名 (pref)」と「小選挙区番号 (kun)」から構成
plyr::ddply() 関数を使って、小選挙区ごとに候補者の選挙費用 (exp) の平均値を計算し mean.exp.smd12 と変数名を付ける
データフレームの名前を df_12_ と指定
df_12 <- hr2012 %>%
group_by(ku, kun) %>%
summarize(mean.exp.smd12 = mean(exp, na.rm = TRUE),
.groups = "drop")mean.exp.smmd12 の値の小数点第 1 位を切り上げて表示df_12$mean.exp.smd12 <- round(df_12$mean.exp.smd12,
digits = 0) DT::datatable(df_12)mean.exp.smd12) の記述統計を表示summary(df_12$mean.exp.smd12) Min. 1st Qu. Median Mean 3rd Qu. Max.
1555688 4737474 5611496 5860720 6811150 14068155
mean.exp.12) をヒストグラムで描いてみるhist(df_12$mean.exp.smd12)総選挙の選挙費用額は増えているのか?
exp: 立候補者が使う選挙費用額
df_exp <- plyr::ddply(hr, .(year), summarize,
mean.exp = mean(exp, na.rm = TRUE)) %>%
round(digits = 0)head(df_exp) year mean.exp
1 1996 9136316
2 2000 8388889
3 2003 7935408
4 2005 8142244
5 2009 6118181
6 2012 5769988
na.omit() 関数を使って非数値や欠測値以外の観測値だけを残すdf_exp <- na.omit(df_exp)mean(df_exp$mean.exp)[1] 7778742
ggplot(df_exp, aes(x = year, y = mean.exp)) +
geom_point() +
geom_line() +
ggtitle("立候補者が使う選挙費用平均額: 1996-2021") +
geom_hline(yintercept = mean(df_exp$mean.exp), # 平均に線を引く
col = "tomato",
linetype = "dotted",
size = 1) +
geom_text(label = "平均選挙費用: 758万円",
x = 2000, y = 7700000, family = "HiraginoSans-W3", color = "tomato", size = 3) +
geom_text(aes(y = mean.exp + 200000, label = mean.exp), size = 3, vjust = 0) +
labs(x = "総選挙年", y = "選挙費用額(円)") exppv: 一人あたりの有権者に費やす選挙費用額
exppv) を作るhr <- hr %>%
mutate(exppv = exp/eligible) # eligible は小選挙区ごとの有権者数 df_exppv <- plyr::ddply(hr, .(year), summarize,
mean.exppv = mean(exppv, na.rm = TRUE)) %>%
round(digits = 0)head(df_exppv) year mean.exppv
1 1996 29
2 2000 26
3 2003 24
4 2005 25
5 2009 18
6 2012 17
・2012年総選挙における mean.exppv が非数値 (NaN)
NaN (Not a Number): 計算不可能な式の結果(= 非数値)NA (Not Available):本来データが存在しているが、何らかの理由でデータが存在していない(= 欠測値)na.omit() 関数を使って非数値や欠測値以外の観測値だけを残すdf_exppv <- na.omit(df_exppv)mean(df_exppv$mean.exppv)[1] 24.625
ggplot(df_exppv, aes(x = year, y = mean.exppv)) +
geom_point() +
geom_line() +
ggtitle("有権者一人あたりの選挙費用平均額: 1996-2009") +
geom_hline(yintercept = mean(df_exppv$mean.exppv), # 平均に線を引く
col = "tomato",
linetype = "dotted",
size = 1) +
geom_text(label = "平均選挙費用: 24.6円",
x = 1999, y = 24, family = "HiraginoSans-W3", color = "tomato", size = 3) +
geom_text(aes(y = mean.exppv + 0.5, label = mean.exppv), size = 4, vjust = 0) +
labs(x = "総選挙年", y = "有権者一人あたりの選挙費用額(円)") 誰が多額の選挙費用を使っているのか?
dplyr::arrange(desc())
hr %>%
filter(!is.na(exp)) %>% # 欠損のある選挙費用を除外
arrange(desc(exp)) %>% # 選挙費用額を大きい順に並べる
select(year, pref, seito, age, j_name, wl, exp) %>%
print(n = 20) # 全て表示したければ n = inf と指定# A tibble: 6,829 x 7
year pref seito age j_name wl exp
<dbl> <chr> <chr> <dbl> <chr> <dbl> <dbl>
1 2012 福岡 民主 61 松本龍 0 27462362
2 2000 北海道 自民 50 岩倉博文 2 27179308
3 1996 鹿児島 自由連合 58 徳田虎雄 0 26999782
4 2000 鹿児島 自由連合 62 徳田虎雄 1 26973809
5 2012 鹿児島 自民 41 徳田毅 1 26465523
6 2000 長崎 自由 58 山田正彦 2 25690655
7 1996 香川 新進 38 平井卓也 0 25608680
8 1996 東京 自民 67 越智通雄 2 25596853
9 2000 香川 無所 42 平井卓也 1 25530255
10 2003 北海道 自民 56 北村直人 1 25529813
11 2003 長崎 民主 61 山田正彦 2 25482858
12 2003 福島 自民 66 佐藤剛男 1 25399111
13 2009 愛知 自民 78 海部俊樹 0 25354069
14 1996 東京 新進 37 古山和宏 0 25087603
15 2009 鹿児島 自民 38 徳田毅 1 25029285
16 2000 東京 自民 66 島村宜伸 0 24819076
17 2005 北海道 自民 62 金田英行 0 24649710
18 2000 北海道 自民 52 北村直人 1 24605343
19 1996 埼玉 新進 41 石田勝之 1 24464522
20 2005 岐阜 無所 62 藤井孝男 0 24437002
# … with 6,809 more rows
2012年総選挙で多額の選挙費用を使った候補者
hr %>%
filter(!is.na(exp)) %>% # 欠損のある選挙費用を除外
filter(year == 2012) %>%
arrange(desc(exp)) %>% # 得票率を大きい順に並べる
select(year, pref, seito, age, j_name, wl, exp) %>%
print(n = 20) # 全て表示したければ n = inf と指定# A tibble: 1,280 x 7
year pref seito age j_name wl exp
<dbl> <chr> <chr> <dbl> <chr> <dbl> <dbl>
1 2012 福岡 民主 61 松本龍 0 27462362
2 2012 鹿児島 自民 41 徳田毅 1 26465523
3 2012 熊本 自民 71 野田毅 1 23593097
4 2012 鹿児島 自民 67 森山裕 1 20428510
5 2012 千葉 日本未来 42 中後淳 0 19859907
6 2012 岡山 自民 47 山下貴司 1 19366527
7 2012 岐阜 自民 69 金子一義 1 19365846
8 2012 愛知 自民 69 江崎鉄磨 1 18933861
9 2012 奈良 民主 37 百武威 0 18680610
10 2012 栃木 自民 57 茂木敏充 1 18669798
11 2012 愛媛 自民 62 塩崎恭久 1 18228041
12 2012 鹿児島 民主 51 川内博史 0 18141072
13 2012 埼玉 自民 37 今野智博 2 17984123
14 2012 広島 自民 54 寺田稔 1 17888076
15 2012 福岡 自民 52 藤丸敏 1 17725028
16 2012 沖縄 国民新党 51 下地幹郎 0 17624616
17 2012 岐阜 自民 49 棚橋泰文 1 17572438
18 2012 山梨 日本維新の会 58 小沢鋭仁 2 17092273
19 2012 北海道 民主 70 小平忠正 0 17012898
20 2012 北海道 民主 53 仲野博子 0 16972595
# … with 1,260 more rows
2012年総選挙で少額の選挙費用で当選した候補者
dplyr::arrange()
hr %>%
filter(!is.na(exp)) %>% # 欠損のある選挙費用を除外
filter(year == 2012) %>%
filter(wl > 0) %>%
arrange(exp) %>% # 選挙費用額を小さい順に並べる
select(year, pref, seito, age, j_name, wl, exp) %>%
print(n = 20) # 全て表示したければ n = inf と指定# A tibble: 421 x 7
year pref seito age j_name wl exp
<dbl> <chr> <chr> <dbl> <chr> <dbl> <dbl>
1 2012 茨城 自民 68 額賀福志郎 1 1332443
2 2012 福島 民主 48 玄葉光一郎 1 1351182
3 2012 山形 自民 30 鈴木憲和 1 1423753
4 2012 神奈川 自民 49 河野太郎 1 1500237
5 2012 沖縄 共産 64 赤嶺政賢 2 2061222
6 2012 埼玉 自民 41 牧原秀樹 2 2063977
7 2012 東京 自民 51 伊藤達也 1 2577536
8 2012 兵庫 みんな 38 井坂信彦 2 3237212
9 2012 広島 日本維新の会 30 坂元大輔 2 3302348
10 2012 静岡 民主 41 細野豪志 1 3486965
11 2012 神奈川 みんな 48 浅尾慶一郎 1 3602077
12 2012 神奈川 自民 36 牧島かれん 1 3636093
13 2012 静岡 日本維新の会 63 鈴木望 2 3678605
14 2012 東京 自民 31 小倉将信 1 3701343
15 2012 兵庫 日本維新の会 46 三木圭恵 2 3772410
16 2012 広島 日本維新の会 49 中丸啓 2 3776897
17 2012 大阪 日本維新の会 28 丸山穂高 1 3807457
18 2012 大阪 日本維新の会 29 村上政俊 1 3823710
19 2012 千葉 自民 62 渡辺博道 1 3855657
20 2012 大阪 日本維新の会 43 木下智彦 1 3918767
# … with 401 more rows
・2005年総選挙における「選挙費用」と「得票率」の散布図を描いてみる
hr %>%
select(seito, exp, voteshare, year) %>%
filter(year == 2005) %>%
ggplot(aes(x = exp, y = voteshare, col = seito)) +
geom_point(alpha = 0.5) +
geom_smooth(method = lm)hr %>%
select(seito, exp, voteshare, year) %>%
filter(year == 2005) %>%
ggplot(aes(x = exp, y = voteshare, col = seito)) +
geom_point(alpha = 0.5, size = 0.5) +
geom_smooth(method = lm) +
facet_wrap(~seito)・2009年総選挙における「選挙費用」と「得票率」の散布図を描いてみる
hr %>%
select(seito, exp, voteshare, year) %>%
filter(year == 2009) %>%
ggplot(aes(x = exp, y = voteshare, col = seito)) +
geom_point(alpha = 0.5) +
geom_smooth(method = lm)hr %>%
select(seito, exp, voteshare, year) %>%
filter(year == 2009) %>%
ggplot(aes(x = exp, y = voteshare, col = seito)) +
geom_point(alpha = 0.5, size = 0.5) +
geom_smooth(method = lm) +
facet_wrap(~seito)hr は1996年に衆院選挙に小選挙区が導入されて以来実施された 9 回の衆議院選挙(1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021)の結果のデータDT::datatable(hr)hr_party <- hr %>%
group_by(seito) %>%
summarize(frequence = n(), .groups = "drop")DT::datatable(hr_party)hr_cand <- hr %>%
group_by(seito, j_name) %>%
summarize(frequence = n(), .groups = "drop")DT::datatable(hr_cand)hr_winner <- hr %>%
filter(wl > 0) %>%
group_by(seito) %>%
summarize(frequence = n(), .groups = "drop")DT::datatable(hr_winner)1996年から2021年総選挙結果から 2021年総選挙データだけを抜き出し「惜敗率」を計算してみる
惜敗率を求める式は次のとおり
\[惜敗率 = \frac{自分の得票数}{当選者の得票数}\]
hr_2021 <- hr %>%
filter(year == 2021)hr が含む変数は次のとおりnames(hr_2021) [1] "year" "pref" "ku" "kun"
[5] "wl" "rank" "nocand" "seito"
[9] "j_name" "gender" "name" "previous"
[13] "age" "exp" "status" "vote"
[17] "voteshare" "eligible" "turnout" "seshu_dummy"
[21] "jiban_seshu" "nojiban_seshu" "exppv"
hr_2021 <- hr_2021 %>%
select(ku, kun, rank, wl, seito, j_name, previous, gender, age, vote)unique(hr_2021$ku) [1] "aichi" "ehime" "ibaraki" "okayama" "okinawa" "iwate"
[7] "gifu" "miyazaki" "miyagi" "kumamoto" "gunma" "hiroshima"
[13] "kagawa" "kochi" "saga" "saitama" "mie" "yamagata"
[19] "yamaguchi" "yamanashi" "shiga" "kagoshima" "akita" "niigata"
[25] "aomori" "shizuoka" "ishikawa" "chiba" "osaka" "oita"
[31] "nagasaki" "nagano" "tottori" "shinane" "tokyo" "tokushima"
[37] "tochigi" "nara" "toyama" "hyogo" "hokkaido" "wakayama"
[43] "kanagawa" "fukui" "fukuoka" "fukushima" "kyoto"
unique(hr_2021$kun) [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
ku と kun を使って district という名前の変数をつくるmiyagi) と kun (6) => miyagi_6df_rank1 <- hr_2021 %>%
mutate(
district = str_c(ku, kun, sep = "_")
) %>%
filter(rank == 1) %>% # ランク1位の候補者だけに絞る
select(district, rank1_vote = vote)df_sekihai <- hr_2021 %>%
mutate(
district = str_c(ku, kun, sep = "_")
) %>%
left_join(df_rank1, by = "district") %>%
arrange(district, rank) %>%
mutate(
sekihai = vote / rank1_vote
)df_sekihai <- df_sekihai %>%
select(district, rank, wl, seito, j_name, previous, gender, age, vote, sekihai)DT::datatable(df_sekihai)Margin(1996-2021)\[惜敗率 = \frac{次点者の票数}{当選者の票数}\]
惜敗率は 0 と 1 の間の値
小選挙区当選者の惜敗率は全員 1
→ 小選挙区当選者間の強さの違いはわからない
当選者を含めた選挙の強さ (Margin)を知りたい場合
→ ひと工夫必要
\[当選者のMargin = \frac{自分の票数}{次点者の票数}\]
当選者の Marginは 1 以上の値
小選挙区の落選者の Margin は「惜敗率」を使う (0〜1)
小選挙区の当選者の Margin は「当選者の Margin」を使う (1以上)
→ 小選挙区の当選者と落選者、両方の選挙の強さを比較できる
hr が含む変数は次のとおり
names(hr) [1] "year" "pref" "ku" "kun"
[5] "wl" "rank" "nocand" "seito"
[9] "j_name" "gender" "name" "previous"
[13] "age" "exp" "status" "vote"
[17] "voteshare" "eligible" "turnout" "seshu_dummy"
[21] "jiban_seshu" "nojiban_seshu" "exppv"
Margin を計算するために必要な変数は次のとおりhr_margin <- hr %>%
select(year, ku, kun, rank, j_name, vote)ku の中身を確認するunique(hr_margin$ku) [1] "aichi" "ehime" "ibaraki" "okayama" "okinawa" "iwate"
[7] "gifu" "miyazaki" "miyagi" "kumamoto" "gunma" "hiroshima"
[13] "kagawa" "kochi" "saga" "saitama" "mie" "yamagata"
[19] "yamaguchi" "yamanashi" "shiga" "kagoshima" "akita" "niigata"
[25] "aomori" "shizuoka" "ishikawa" "chiba" "osaka" "oita"
[31] "nagasaki" "nagano" "tottori" "shimane" "tokyo" "tokushima"
[37] "tochigi" "nara" "toyama" "hyogo" "hokkaido" "wakayama"
[43] "kanagawa" "fukui" "fukuoka" "fukushima" "kyoto" "shinane"
kun の中身を確認するunique(hr_margin$kun) [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
calculate_margin <- function(data) {
dat1 <- data %>%
arrange(rank) %>%
mutate(
rank1_vote = if_else(rank == 1, vote, NA_real_),
rank2_vote = if_else(rank == 2, vote, NA_real_)
) %>%
fill(rank1_vote, rank2_vote, .direction = "downup") %>%
mutate(
divide_vote = if_else(rank == 1, rank2_vote, rank1_vote),
margin = vote / divide_vote
)
return(dat1)
}year と ku と kun を組み合わせて district という名前の変数をつくるyear (1996) + ku (miyagi) + kun (6) => district (1996_miyagi_6)hr_margin <- hr_margin %>%
mutate(
district = str_c(year, ku, kun, sep = "_") # year を忘れずに
) %>%
group_nest(district) %>%
mutate(
margin_vote = map(data, calculate_margin)
) %>%
select(district, margin_vote) %>%
unnest(margin_vote)DT::datatable(hr_margin)hr_margin <- hr_margin %>%
select(year, margin, j_name)abe_ishiba_margin <- hr_margin %>%
filter(j_name == "石破茂" | j_name == "安倍晋三") %>%
select(year, margin, j_name)ggplot(data = abe_ishiba_margin, aes(x = year, y = margin, colour = j_name, linetype = j_name, shape = j_name)) +
geom_point() +
geom_line() +
ggtitle("安倍晋三氏と石破茂氏の Margin : 1996-2021衆院選") +
geom_text(
aes(y = margin + 0.1,
label = round(margin, digits = 1), vjust = 0)
) +
theme(legend.position = c(0.9, 0.1)) +
labs(x = "総選挙年", y = "Margin") vs_abe_ishiba解釈 ・得票率という観点からみると、2009年総選挙までは安倍晋三氏の得票率が高いが、2012年総選挙以降は石破茂氏のが高い
・次点者との差という観点からみると、9回の総選挙中、安倍晋三氏の方が石破茂氏より勝っているのは6回、石破茂氏の方が安倍晋三氏より勝っているのは3回
→ 次点者との差という観点から見た Margin では2014年と2021年総選挙も含め安倍晋三氏の方が強いと言える
margin)得票率
hr_vs <- hr %>%
select(year, voteshare, j_name)ldp_pres_vs <- hr_vs %>%
filter(j_name == "岸田文雄" | j_name == "高市早苗"| j_name == "河野太郎"| j_name == "野田聖子")ggplot(data = ldp_pres_vs, aes(x = year, y = voteshare, colour = j_name, linetype = j_name, shape = j_name)) +
geom_point() +
geom_line() +
ggtitle("2021自民党総裁選立候補者の得票率:1996-2021") +
geom_text(
aes(y = voteshare + 0.1,
label = round(voteshare, digits = 1), vjust = 0)
) +
theme(legend.position = c(0.9, 0.2)) +
labs(x = "総選挙年", y = "得票率(%)")Margin
hr_margin <- hr_margin %>%
select(year, margin, j_name)ldp_pres_margin <- hr_margin %>%
filter(j_name == "岸田文雄" | j_name == "高市早苗"| j_name == "河野太郎"| j_name == "野田聖子") ggplot(data = ldp_pres_margin, aes(x = year, y = margin, colour = j_name, linetype = j_name, shape = j_name)) +
geom_point() +
geom_line() +
ggtitle("2021自民党総裁選立候補者の選挙マージン:1996-2021") +
geom_text(
aes(y = margin + 0.1,
label = round(margin, digits = 1), vjust = 0)
) +
theme(legend.position = c(0.6, 0.8)) +
labs(x = "総選挙年", y = "Margin")