朝日新聞に、大阪大学三浦研究室と朝日新聞社の共同調査の記事が載っていました。
これは選挙に対する有権者の意識の変化を記録することを目的とした調査だそうです。
この調査、なんと生データが公開されています。
分析結果のレポートが公開されることは珍しくないですが、ローデータが公開されるのは非常に珍しいと思います。
公開の目的として以下のように書かれています。
本サイトは，本調査のデータを，実施主体である私たちだけではなく，多くの方々に役立てていただくために，広く公開し，主として学術研究に用いていただくことを目的として開設しました．
利用条件を守る必要がありますが、研究材料として、また社会学、社会調査、社会心理学、マーケティングリサーチの教材としても非常に有益だと思います。
この記事ではこのデータをR言語で扱う事例を紹介します。
Pythonや他のツールで同様のことをやりたい場合はChatGPTやGeminiに翻訳させるのがいいと思います！
記事の後半で「高市首相への感情温度」と「陰謀論的な意見への賛成度」「政府への信頼度」「メディアへの信頼度」の関係を表すグラフが出てくるのですが、これがちょっと分かりにくいので、自分なりに描き直してみます。
「高市首相への感情温度」は11月の調査、「陰謀論的な意見への賛成度」「政府への信頼度」「メディアへの信頼度」は4月と5月の調査で聴取されています。
まずはRにデータを取り込みます。
Google Drive上に各調査回の
- ローデータ(2025*SurveyDatFull.csv, UTF-8)
- 変数リスト(2025*VarList.csv, Shift-JIS)
- 調査票(2025*QualtricsSurvey.pdf)
が置かれています。
読み込みたいのはローデータです。
調査票と変数リストもデータの内容を理解するために確認しておいてください。
このローデータをRに取り込むには三つの方法があります。
- 必要なファイルをダウンロードして読み込む。
- googledriveパッケージを利用して読み込む。
- ダウンロードリンクから読み込む。
今回はダウンロードリンクから直接読み込もうと思います。
そのためには各ファイルのファイルIDが必要になります。
ファイルIDは各ファイルの共有リンクから確認できます。
共有リンクのURLが以下だった場合、
https://drive.google.com/file/d/1UuEH736mlllPs_vR720k3M8J7javrZgE/view?usp=drive_link
d/ と /view の間の 1UuEH736mlllPs_vR720k3M8J7javrZgE がファイルIDになります。
今回は2025年の4月、5月、11月の調査結果を使いたいので、それぞれのローデータのファイルIDを確認し、それを使ってRに取り込みます。
まずは使いたいパッケージのインストールと呼び出しをしておきます。
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
conflicted, # 関数名の衝突を警告
tidyverse, # モダンなデータ操作
summarytools, # データのサマリー
GGally, # 相関行列の可視化
polycor # 順序尺度の相関
)
次に調べておいた4月、5月、11月のファイルIDをlistにまとめます。
# ファイルIDをリストにまとめる
file_ids <- list(
file_id_202504 = "1nVeJByEtHNAzhVyqmbqet873jKfNHs6p",
file_id_202505fresh = "1dFVjBCoSAHRN4cemSkn39SviYaXvBZ0B",
file_id_202511 = "1UuEH736mlllPs_vR720k3M8J7javrZgE"
)
そしてダウンロードリンクからデータを読み込みます。
# 3つのファイルをいっぺんに取得し、listに格納
raw_data <- file_ids |>
map(\(x) read_csv(sprintf("https://docs.google.com/uc?id=%s&export=download", x)))
4月、5月の調査から以下の変数を取り出します。
- trust3（政府への信頼度）
- trust9（マスコミへの信頼度）
- conspiracy（陰謀論的心性）
陰謀論的心性は心理尺度になっていて5問の11件法の合計点を使います。
陰謀論的心性についてはこの辺りの論文を参照するのが良さそうです。
そして11月の調査から
- feelthermo_PM_6（高市早苗首相に対する感情温度）
を取り出します。
この2つのデータを対象者のIDであるPSIDで紐づけます。
# 4月調査の結果から必要な情報を抽出
df202504 <- raw_data |>
pluck("file_id_202504") |>
dplyr::select(PSID, starts_with("conspiracy"), trust3, trust9) |>
mutate(conspiracy = rowSums(across(starts_with("conspiracy"))), .keep = "unused")
# 5月調査の結果から必要な情報を抽出
df202505fresh <- raw_data |>
pluck("file_id_202505fresh") |>
dplyr::select(PSID, starts_with("conspiracy"), trust3, trust9) |>
mutate(conspiracy = rowSums(across(starts_with("conspiracy"))), .keep = "unused")
# 4月と5月をがっちゃんこ
conspiracy_and_trust <- bind_rows(df202504, df202505fresh, .id = "survey")
# 11月調査の結果から必要な情報を抽出
df202511 <- raw_data |>
pluck("file_id_202511") |>
dplyr::select(PSID, feelthermo_PM_6)
# 11月の調査結果に対して4月と5月の調査結果を内部結合
df <- df202511 |>
inner_join(conspiracy_and_trust, by = join_by(PSID))
これで前処理が完了です。
サンプルサイズは n = 1140 です。
まずは軽くEDAしておきましょう。
まずデータの中身を確認。
df |>
glimpse()
# Rows: 1,140
# Columns: 6
$ PSID <chr> "cf778d56-edd4-6d18-09f9-a749b13605f2", "0f78bce1-f800-2304-570f-63133093f13d", …
# $ feelthermo_PM_6 <dbl> 9, 10, 7, 7, 5, 9, 5, 3, 6, 8, 8, 10, 9, 0, 10, 10, 8, 5, 3, 6, 9, 6, 7, 5, 4, 5…
# $ survey <chr> "2", "1", "1", "1", "1", "1", "1", "2", "2", "1", "1", "1", "1", "2", "1", "1", …
# $ trust3 <dbl> 2, 4, 1, 4, 1, 2, 2, 2, 2, 4, 3, 1, 2, 1, 2, 4, 3, 1, 3, 3, 4, 4, 2, 2, 2, 2, 2,…
# $ trust9 <dbl> 4, 2, 2, 4, 1, 3, 2, 2, 2, 2, 3, 1, 3, 1, 2, 2, 3, 2, 3, 3, 1, 4, 2, 2, 3, 1, 3,…
# $ conspiracy <dbl> 29, 30, 36, 25, 39, 37, 29, 32, 21, 18, 28, 29, 32, 25, 37, 24, 22, 26, 9, 26, 2…
概要を確認。
df |>
select(!PSID) |>
dfSummary() |>
summarytools::view()
相関関係を可視化します。
# 相関可視化
df |>
dplyr::select(!c(survey, PSID)) |>
ggpairs()
うーん、信頼度の設問は5件法なのでシンプルな散布図では分かりにくいですね。
信頼度は5件法の順序尺度なので、念のためポリコリック相関係数、ポリシリアル相関係数も確認しておきましょう。
df |>
dplyr::select(!c(survey, PSID)) |>
mutate(
feelthermo_PM_6 = as.factor(feelthermo_PM_6),
trust3 = as.factor(trust3),
trust9 = as.factor(trust9)
) |>
as.data.frame() |>
hetcor(ML = TRUE, parallel = TRUE)
# Maximum-Likelihood Estimates
#
# Correlations/Type of Correlation:
# feelthermo_PM_6 trust3 trust9 conspiracy
# feelthermo_PM_6 1 Polychoric Polychoric Polyserial
# trust3 0.1779 1 Polychoric Polyserial
# trust9 -0.1372 0.4876 1 Polyserial
# conspiracy 0.003605 -0.3439 -0.199 1
#
# Standard Errors:
# feelthermo_PM_6 trust3 trust9
# feelthermo_PM_6
# trust3 0.03151
# trust9 0.03188 0.02636
# conspiracy 0.03033 0.02727 0.03033
#
# n = 1140
#
# P-values for Tests of Bivariate Normality:
# feelthermo_PM_6 trust3 trust9
# feelthermo_PM_6
# trust3 8.375e-08
# trust9 0.001038 2.204e-08
# conspiracy 1.131e-28 1.295e-07 9.939e-07
結果として、普通の相関係数とそんなに変わらないですね。
さて、ここからが本番です。
「高市早苗首相に対する感情温度」と「政府への信頼」の関係を可視化します。
モザイクプロットや残差ヒートマップなどの方法もありますが、ここではバブルチャートにしてみます。
df |>
count(feelthermo_PM_6, trust3) |>
ggplot(aes(x = feelthermo_PM_6, y = trust3)) +
geom_point(aes(size = n, color = n)) +
geom_smooth(aes(weight = n), method = lm, formula = y ~ x) +
labs(
title = "高市首相への好感度と政府への信頼",
subtitle = "相関係数: 0.175、ポリコリック相関: 0.178",
x = "高市首相への感情温度（反感←→好意）",
y = "政府への信頼度"
)
うーん、「ごく弱い正の相関」と言ったところでしょうか。nが大きいので統計的には有意でしょうが、
「ほぼ無相関」と解釈したほうがいいかもしれません。
次に「高市早苗首相に対する感情温度」と「マスコミへの信頼」の関係を可視化します。
df |>
count(feelthermo_PM_6, trust9) |>
ggplot(aes(x = feelthermo_PM_6, y = trust9)) +
geom_point(aes(size = n, color = n)) +
geom_smooth(aes(weight = n), method = lm, formula = y ~ x) +
labs(
title = "高市首相への好感度とマスコミへの信頼",
subtitle = "相関係数: -0.111、ポリコリック相関: -0.137",
x = "高市首相への感情温度（反感←→好感）",
y = "マスコミへの信頼度"
)
こちらも「ごく弱い負の相関」ですかね。こちらもnが大きいので統計的には有意でしょうが、
「ほぼ無相関」と解釈したほうがいいかもしれません。
そして「高市早苗首相に対する感情温度」と「陰謀論的な意見への賛成度」の関係を可視化します。
この「陰謀論的な意見への賛成度」は11件法5問の合計値なので連続変数として扱って、バイオリンプロットにしてみます。
df |>
mutate(feelthermo_PM_6 = as.factor(feelthermo_PM_6)) |>
ggplot(aes(x = feelthermo_PM_6, y = conspiracy)) +
geom_violin(fill = "green") +
geom_boxplot(width = 0.3) +
labs(
title = "高市首相への好感度と陰謀論的な意見への賛成度",
subtitle = "相関係数: -0.008、ポリシリアル相関: 0.004",
x = "高市首相への感情温度（反感←→好感）",
y = "陰謀論的な意見への賛成度"
)
相関係数で見れば全くの無相関。
ただ、感情温度の真ん中付近は「陰謀論的な意見への賛成度」が低く、両端では高くなる傾向があるようにも見えます。
こんな具合で、Rを使えば意外と手軽にこのデータの分析ができます。
調査票を読み込んで理解するのはちょっと大変ですが、とても貴重なデータなので興味のある方はぜひ分析に挑戦してみてください。
特に同じ対象者に継続的に調査を行っているのが大きな特徴ですので、時系列の分析は面白そうです。
Enjoy!