Rで何かをしたり、読書をするブログ

政府統計の総合窓口のデータや、OECDやUCIやのデータを使って、Rの練習をしています。ときどき、読書記録も載せています。

国民生活に関する世論調査のデータの分析3 - 現在の生活が「満足」の割合を inferパッケージのワークフローで検定する

www.crosshyou.info

の続きです。前回、前々回は去年と比べた生活の向上感をみました。今回は現在の生活の満足度をみてみます。

令和7年の調査では満足は50.2%(2729人中)で、令和6年は52.0%(1831人中)でした。

1.8ポイントの低下です。果たしてこの1.8ポイントの低下は統計的に有意な差があるのかどうかを確認します。今回は inferパッケージのワークフローでやってみます。

https://infer.netlify.app/articles/observed_stat_examples#two-categorical-variables-diff-in-proportions

こちらのサイトを参考にします。

inferパッケージを読み込みます。

inferパッケージはデータフレームを操作するので、データフレームを用意する必要がありますそのために、両年の「満足」「不満」の人数を計算します。今回は無回答は無視します。

これらの数値からデータフレームを作成します。

ちゃんと出来高どうか確認します。

正しく作成されました。

ここからは、inferパッケージのワークフローです。

まず、比率の差を計算して保存します。

比率の差は0.0201です。PDFファイルの数値を使った差は、50.2 - 52.0 = 1.8パーセンテージポイント、つまり0.018です。値が違うのは「無回答」を削除しているのと、四捨五入の関係でしょうね。

次に、ブートストラップ法でこの差をランダムに何回も計算します。

今回は5000回計算しました。95%信頼区間を求めます。

信頼区間が0を含んでいますので、令和6年と令和7年で現在の生活が「満足」の人の割合について、統計的に有意な差は無いということが確認できました。

最後にブートストラップ法で算出した5000回の値のヒストグラムを描きます。

赤い垂線が0の位置の垂線です。

今回は以上です。

はじめから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# inferパッケージの読み込み
library(infer)
#
# 令和7年の「満足」の人数
(r7manzoku <- round(2729 * 0.502))
#
# 令和7年の「不満」の人数
(r7fuman <- round(2729 * 0.496))
#
# 令和6年の「満足」の人数
(r6manzoku <- round(1831 * 0.520))
#
# 令和6年の「不満」の人数
(r6fuman <- round(1831 * 0.474))
#
# infer用のデータフレームを作成する
genzai <- tibble(
  year = c(rep("令和7年", (r7manzoku + r7fuman)),
           rep("令和6年", (r6manzoku + r6fuman))),
  ishiki = c(
    rep("満足", r7manzoku), rep("不満", r7fuman),
    rep("満足", r6manzoku), rep("不満", r6fuman))
  )
genzai
#
# データフレームの確認
genzai |> 
  count(year, ishiki)
#
# 比率の差を計算して保存
d_hat <- genzai |> 
  specify(ishiki ~ year, success = "満足") |> 
  calculate(stat = "diff in props", order = c("令和7年", "令和6年"))
d_hat
#
# ブートストラップ法
set.seed(143)
boot_dist <- genzai |> 
  specify(ishiki ~ year, success = "満足") |> 
  generate(reps = 5000, type = "bootstrap") |> 
  calculate(stat = "diff in props", order = c("令和7年", "令和6年"))
#
# 95%信頼区間
percentile_ci <- get_ci(boot_dist)
percentile_ci
#
# ブートストラップ法の結果のヒストグラム
boot_dist |> visualize() +
  shade_confidence_interval(endpoints = percentile_ci) +
  geom_vline(xintercept = 0, color = "red") +
  theme_minimal()
#

 

(冒頭の画像は、Bing Image Creator で生成しました。プロンプトは Close up of wild red rose flowers, background is beautiful green field under the blue sky and a few white clouds, photo です。