カテゴリ:
hr.icon
ダンベルプロットと検定
https://gyazo.com/e063deacfecfa5118ac406ccce5f3d38
上のグラフのように、ダンベルのような見た目で2つの値を比べたグラフをダンベルプロット(ダンベルチャート)と呼びます。
2つの集団や時点といった標本間で、多数の項目の比較をしたいときに便利です。今回は、標本間の差が統計的に有意な差であるのか検定する方法と合わせて紹介します。よりよい方法や問題点などあれば教えていただければ幸いです。
hr.icon
(1) 比率の差
比率の差をダンベルプロットにし、χ二乗検定を介した残差分析(*2)で、統計的に有意に差があるのかどうか検定する方法を紹介します。
①使用するデータ
使用するデータはベネッセ教育総合研究所の行っている『大学生の学習・生活実態調査報告書(*3)』 の大学生の住まいに関するものです。
https://gyazo.com/6305721c5736f958153b0ae69df46933
公表されているデータでは回答割合しか載っていないのですが、回答数も計算して使います。ただ、今回計算した回答数は単純に四捨五入するとサンプルサイズと合わなくなるのでサンプルサイズと合うように手を加えているので実際の回答数と異なる可能性があることをご了承ください。計算した回答数も合わせて次のようにデータを作成します。
code:住まいのデータの作成
sumai.df <- data.frame(question = c("01_自宅","02_一人暮らし","03_大学の寮","04_大学以外の寮","05_その他"),
A2016 = c(56.4,37.1,3.7,0.8,1.9),
A2021 = c(63.4,31.7,2.9,0.5,1.5),
A2016回答数 = c(2771,1823,183,40,94),
A2021回答数 = c(2615,1307,120,21,62)
)
②シンプルなダンベルプロット
まずは検定など行わずシンプルなダンベルプロットを作成します。Rでダンベルプロットを作成する場合は、ggaltパッケージのgeom_dumbbell()を使っても簡単に作成ができるのですが(*4)、あとあと色分けを2種類したい関係で、geom_dumbbell()を使わない方法で作成します。
基本的な考え方は、ggplotのgeom_point()でダンベルの両端の重しの部分を描画し、geom_line()でダンベルの持ち手部分を描画、geom_linerange()で補助線を引くというものです。
先に必要なパッケージを読み込んでおきます。
code:パッケージの読み込み
# まだインストールしていない場合、まずインストールします。
install.packages("tidyverse")
# パッケージの読み込み
library(tidyverse)
次にsumai.dfのデータを整形します。geom_linerange()で引く補助線用に、2016年回答と2021年回答で割合が低い方=”最低”という変数を作成しておいて、縦型に変換します。また、シンプルなダンベルプロットでは回答数は使わないので最初に除いてしまいます。
code:シンプルなダンベルプロット用のデータの整形
sumai.simple.df <- sumai.df %>%
select(question, A2016, A2021) %>%
# 2021の回答と2016の回答どちらか低い方を最低という変数にします。
mutate(最低 = case_when(A2021 >= A2016 ~ A2016,
TRUE ~ A2021)) %>%
gather(key = year, value = 割合, -question,-最低)
このようなデータができました。
https://gyazo.com/02454fa7f9ef691eb9feb6eace141884
これを使って作図します。
code:シンプルなダンベルプロットの作図
plot.sumai.simple <- sumai.simple.df %>%
# reorderでx軸の項目の順番を逆順にしておきます。
ggplot(aes(x= reorder(question,desc(question)), y = 割合)) +
# ダンベルの持ち手部分を描画
geom_line(aes(group = question), alpha = 0.2,size= 2) +
# どの項目のダンベルなのかわかりやすいように補助線を引きます。
geom_linerange(aes(x = question, ymin =0, ymax = 最低), linetype = "dashed", color = "grey", alpha = 0.8,size= 0.5) +
# ダンベルの重し部分を描画します。調査年で色を変えます。
geom_point(aes(color = year),size=4) +
# 重し部分の色を設定します。凡例に出てくるので凡例の項目名なども設定します。
scale_color_manual(name = "調査年", labels = c("2016年","2021年"),values = c("#1380A1","#FAAB18")) +
# 割合のラベルをつけるのですが、重し部分が左側にある場合は左側に、右側にある場合は右側に表示されるようにします。
geom_text(aes(x = question, y = case_when(割合 > 最低 ~ 割合 +3, TRUE ~ 割合 -3), label = 割合),size= 4)+
# X軸とy軸を反転させます。
coord_flip() +
# タイトルや軸名、キャプションを記載します。
labs(title = "大学生の住まい(2016年調査、2021年調査の比較)",
x = "住まい",
y = "割合(%)",
caption = "ベネッセ教育総合研究所『第4回大学生の学習・生活実態調査 2021年』より作成") +
# 体裁の設定をします。
theme_classic() +
theme(text = element_text(size = 16),
plot.title = element_text(size = 20),
legend.position = "right",
axis.text.y = element_text(hjust =0),
plot.caption = element_text(size=11,hjust =0))
plot.sumai.simple
これで最初に見たダンベルプロットができました。
https://gyazo.com/e063deacfecfa5118ac406ccce5f3d38
このままでもいいのですが、
2016年と2021年に統計的に有意に差があるのかも知りたい。
ぱっと見で増えているのが減っているのかわかるようにしたい。
といった要望もあるかもしれません。そこで、まず検定をしていきます。
③検定
まずχ二乗検定をします。割合ではなく回答数を使います。
code:住まいのデータのχ二乗検定
chisq.resut.sumai<- chisq.test(sumai.df %>%
select(A2016回答数,A2021回答数))
chisq.resut.sumai
結果は以下のとおりで、1%有意水準で2016年と2021年の住まいの回答に有意な差があることがわかります。
https://gyazo.com/c8af0f4ea30bf0a681fb10d366470771
ただし、χ二乗検定ではどの項目の差が有意だったのかわかりません(今回の場合、グラフを見ればなんとなくわかりますが)。そこで残差分析(*5)をします。χ二乗検定をした結果の中に調整済み残差が入っているのでそれを利用します。調整済み残差を見てみると次のようになっています。
code:住まいのデータの調整済み残差
chisq.resut.sumai$stdres
A2016回答数 A2021回答数
調整済み残差からp値を出して、満たす有意水準に応じてアスタリスクを付けます。
code:住まいのデータの残差分析
sumai.zansa.df <- data.frame(
# わかりやすいように質問項目の列を入れておきます
question = sumai.df$question,
# χ二乗検定の調査済み残差を使ってp値を出します。
pnorm(abs(chisq.resut.sumai$stdres),lower.tail=FALSE)*2
) %>%
# 値は同じなのでここではA2016回答数の残差のp値で判定しています。
mutate(有意 = case_when(abs(A2016回答数) <= 0.01 ~ "**",
abs(A2016回答数) <= 0.05 ~ "*",
TRUE ~""))
これで次のようなデータフレームができました。
https://gyazo.com/066c74bd244937314684151a35d98a40
この結果もグラフの中に入れます。
④検定結果も反映したダンベルプロット
②のグラフに、③で求めた検定結果も反映します。また、増減がわかりやすいように差をグラフの中に表示し、増減を色分けしてみます。
まず、データを整形します。
code:検定結果も反映したダンベルプロット用のデータの整形
sumai.hanei.df <- left_join(
sumai.df %>%
select(question,A2016,A2021) %>%
# 差を表示するために差の変数を作っておきます。
mutate(差 = A2021 - A2016) %>%
# 2021の回答と2016の回答どちらか低い方を最低という変数にします。
mutate(最低 = case_when(差 >=0 ~ A2016, TRUE ~ A2021)) %>%
# 差をダンベルの持ち手の真ん中に表示させるため平均を作っておきます。
mutate(平均 = (A2016 + A2021)/2),
# 検定の結果をquestionの変数をkeyにして左結合します。
sumai.zansa.df %>% select(question,有意),
by = "question"
) %>%
# 縦型に変換します。
gather(key = year, value = 割合, -question,-差,-最低,-平均,-有意)
これで次のようなデータフレームができました。
https://gyazo.com/98649c96c15c40e58e0a5c1f588b4c8f
これを使って作図します。ただし、今回はcolorを2種類使います。普通colorは1種類しか設定できないため、ggnewscaleパッケージのnew_scale_colour()を使います。
code:検定結果も反映したダンベルプロットの作図
# まだインストールしていない場合、まずインストールします。
install.packages("ggnewscale)")
# パッケージの読み込み
library(ggnewscale)
# 作図
plot.sumai <- sumai.hanei.df %>%
# reorderでx軸の項目の順番を逆順にしておきます。
ggplot(aes(x= reorder(question,desc(question)), y = 割合,)) +
# ダンベルの持ち手部分を描画
# color = 差 <= 0と設定することで、差の正負で色を変えます。これで2016から2021に増えたのか減ったのかわかりやすくします。
geom_line(aes(group = question,color = 差 <= 0), alpha = 0.3,size= 3) +
# どの項目のダンベルなのかわかりやすいように補助線を引きます。
geom_linerange(aes(x = question, ymin =0, ymax = 最低), linetype = "dashed", color = "grey", alpha = 0.8,size= 0.5) +
# 持ち手部分の色を設定します。凡例に出てくるので凡例の項目名なども設定します。
scale_color_manual(name = "2021の方が", labels = c("多い","少ない"), values = c("#00BFC4","#F8766D")) +
# この先新しく色を設定できるようにnew_scalse_colour()を使います。
new_scale_colour() +
# ダンベルの重し部分を描画します。調査年で色を変えます。
geom_point(aes(color = year),size=4) +
# 重し部分の色を設定します。凡例に出てくるので凡例の項目名なども設定します。
# 今回は2016が基準のように見せるため、2016年の方は灰色にします。
scale_color_manual(name = "調査年", labels = c("2016年","2021年"),values = c("grey","#FAAB18")) +
# ダンベルの持ち手の真ん中に差を表示します。
geom_text(aes(x = question, y = 平均,
label = case_when(差 >= 0 ~ paste0("+",format(round(差,digits=1),nsmall=1),有意),
TRUE ~ paste0(format(round(差,digits=1),nsmall=1),有意))),
size= 3)+
# 割合のラベルをつけるのですが、すべて表示すると混み合うので、2021年の値だけ表示します(データフレームを2021のみにする)。
# 2021年の重し部分が左側にある場合は左側に、右側にある場合は右側に表示されるようにします。
geom_text(data = sumai.hanei.df %>% filter(year == "A2021"),
aes(x = question,
y = case_when(割合 > 最低 ~ 割合 +3, TRUE ~ 割合 -3),
label = 割合),
size= 4)+
# X軸とy軸を反転させます。
coord_flip() +
# タイトルや軸名、キャプションを記載します。
labs(title = "大学生の住まい(2016年調査、2021年調査の比較)",
x = "住まい",
y = "割合(%)",
caption = "割合は2021年度のものだけ表示している。\n図中の+-のついた数値は2016年度の数値からの差を表し、\n残差分析で統計的に有意に差があるとき、1%有意水準を満たす場合は**、5%有意水準を満たす場合は*を付している。\nベネッセ教育総合研究所『第4回大学生の学習・生活実態調査 2021年』より作成") +
# 体裁の設定をします。
theme_classic() +
theme(text = element_text(size = 16),
plot.title = element_text(size = 20),
legend.position = "right",
axis.text.y = element_text(hjust =0),
plot.caption = element_text(size=11,hjust =0))
plot.sumai
これで統計的に有意に差があるかどうか反映し、増減をわかりやすくしたダンベルプロットができました。
https://gyazo.com/53ce44f713da8a3b35fe36ca591e4cb5
hr.icon
(2) 平均値の差
(1)では割合(回答数)の差に関するダンベルプロットを作成し、検定の結果も反映しました。(2)では平均値の差に関するダンベルプロットを作成します。(1)とほとんど同じですが、検定方法が異なります。順番に見ていきます。
①使用するデータ
使用するデータは(1)と同じくベネッセ教育総合研究所の行っている『大学生の学習・生活実態調査報告書』の中から、大学生の自他の関係の意識に関するものです。この2016年調査の結果と2021年調査の結果を比べてみます。
https://gyazo.com/be8f08d81285ee7c096606aa17d6daef
https://gyazo.com/8c0ba56690b704664c4369c8f9846cfe
※“第4回大学生の学習・生活実態調査 2021年”(ベネッセ教育総合研究所)より作成。ただし質問11は2016年度は聞かれていないため除いた。
このデータから、とてもあてはまる=5、まああてはまる=4、どちらともいえない=3、あまりあてはならない=2、あてはまらない=1として平均と分散を計算したものを使います(*6)。
ちなみに計算方法は以下のとおりです。
$ y:年度で、2016か2017
$ i:質問番号で1~19 ただし11は含まれない。
$ j:回答番号で、とてもあてはまる=5, …, あてはまらない = 1.
$ n:サンプルサイズで、$ n_yは$ y年度のサンプルサイズ
$ x:回答数で、$ x^y_{ij}は年度の質問番号$ i 回答$ jの回答数(サンプルサイズ×回答割合)
年度$ y、質問番号$ iの平均値:$ \textrm{mean}_i^y = \frac{1}{n^y} \sum_j j*x_{ij}^y
年度$ y、質問番号$ iの不偏分散:$ σ_{yi}^2=\frac{1}{n^y-1} \sum_j \lbrace x_{ij}^y*(j - \textrm{mean}_i^y )^2 \rbrace
※もちろん元データがあれば平均はmean()、不偏分散はvar()で求められます。
今回はこの計算した結果を使用します。
code:意識に関するデータの作成
ishiki.df <- data.frame(
question = c("01_自分の考え・意見をもっている",
"02_自分のことは自分で判断する",
"03_自分で決めたことを行動にうつせる",
"04_自分の行動に責任をもてる",
"05_他人の気持ちを思いやることができる",
"06_相手の気持ちを察して,適切な対応ができる",
"07_周りの人と協力して物事に取り組むことができる",
"08_周りの人とよい関係を維持することができる",
"09_社会の出来事に関心がある",
"10_日本の政治に関心がある",
"12_自分の健康状態に注意を払っている",
"13_規則正しい生活をする",
"14_自分の洗濯物は自分で選択する",
"15_日頃の自分の食事は自分で作る",
"16_大学の学費を自分で払っている",
"17_家にお金を入れている",
"18_親のことを信頼している",
"19_親は自分のことを信頼している"),
平均2016 = c(3.75,3.84,3.58,3.47,3.69,3.61,3.62,3.59,3.50,3.12,3.45,3.08,3.21,2.86,1.93,1.92,3.89,3.63),
平均2021 = c(3.65,3.75,3.50,3.46,3.73,3.67,3.66,3.63,2.76,3.05,3.43,3.13,3.11,2.91,2.02,2.09,3.83,3.64),
分散2016 = c(2.75,2.41,2.73,2.74,2.60,2.58,2.67,2.75,3.17,3.86,3.34,3.90,6.90,5.57,5.24,4.36,3.16,3.12),
分散2021 = c(2.99,2.69,3.04,2.94,2.90,2.76,2.85,2.89,6.22,3.95,3.48,4.10,6.57,5.51,5.51,4.85,3.36,3.14)
)
②シンプルなダンベルプロット
まず、またシンプルなダンベルプロットを作ってみます。ここでもgeom_linerange()で引く補助線用に、2016年回答と2021年回答で割合が低い方=”最低”という変数を作成しておいて、縦型に変換します。また、シンプルなダンベルプロットでは分散は使わないので最初に除いてしまいます。
code:シンプルなダンベルプロット用のデータの整形
ishiki.simple.df <- ishiki.df %>%
select(question, 平均2016, 平均2021) %>%
rename(A2016 = 平均2016, A2021 = 平均2021) %>%
mutate(最低 = case_when(A2021 >= A2016 ~ A2016,
TRUE ~ A2021)) %>%
gather(key = year, value = 割合, -question,-最低)
このようなデータができました。
https://gyazo.com/fbeacab402a68154c0cfa1bc493274d1
これを使って作図します。
code:シンプルなダンベルプロット用の作図
plot.ishiki.simple <- ishiki.simple.df %>%
# reorderでx軸の項目の順番を逆順にしておきます。
ggplot(aes(x= reorder(question,desc(question)), y = 割合)) +
# ダンベルの持ち手部分を描画
geom_line(aes(group = question), alpha = 0.2,size= 2) +
# どの項目のダンベルなのかわかりやすいように補助線を引きます。
# あとでy軸範囲を1~5に制御するのでyminは0ではなく1にしておきます。
geom_linerange(aes(x = question, ymin =1, ymax = 最低), linetype = "dashed", color = "grey", alpha = 0.8,size= 0.5) +
# ダンベルの重し部分を描画します。調査年で色を変えます。
geom_point(aes(color = year),size=4) +
# 重し部分の色を設定します。凡例に出てくるので凡例の項目名なども設定します。
scale_color_manual(name = "調査年", labels = c("2016年","2021年"),values = c("#1380A1","#FAAB18")) +
# 割合のラベルをつけるのですが、重し部分が左側にある場合は左側に、右側にある場合は右側に表示されるようにします。
geom_text(aes(x = question, y = case_when(割合 > 最低 ~ 割合 +0.2, TRUE ~ 割合 -0.2), label = 割合),size= 4)+
# 平均値は1から5の値しか取らないので、軸を制御します。
ylim(1,5) +
# X軸とy軸を反転させます。
coord_flip() +
# タイトルや軸名、キャプションを記載します。
labs(title = "大学生の意識(2016年調査、2021年調査の比較)",
x = "質問項目",
y = "平均",
caption = "ベネッセ教育総合研究所『第4回大学生の学習・生活実態調査 2021年』より作成") +
theme_classic() +
theme(text = element_text(size = 16),
plot.title = element_text(size = 20),
legend.position = "right",
axis.text.y = element_text(hjust =0),
plot.caption = element_text(size=11,hjust =0))
plot.ishiki.simple
これで次のようなダンベルプロットができました。
https://gyazo.com/0d0f4de88eaf9ebf311be96e7d9558c1
これ以降では(1)と同じように、②で検定をし、③で検定結果も反映したダンベルプロットを作図してみます。
③検定
(1)では回答数(比率)の差の検定をしたのでχ二乗検定を介して残差分析をしました。(2)は平均値に差があるか検定をするので、t検定をします。2016年のサンプルと2021年のサンプルは別々の対象者になるので、対応がない場合の2標本t検定(*7)をします。さらに、2標本の母分散が等しい(等分散)ことを仮定しない場合には、Welchのt検定をする必要があります(*8) (等分散かどうか確認せず、最初から等分散かどうか考慮する必要のないWelchのt検定を行うのが一般的なようです)。
Welchのt検定の自由度は複雑な計算方法になっているので(*7)のwebsiteを参照してください。
Rではt.test()でvar =Fと設定すれば、等分散を仮定しないt検定をすることができますが、ここでは質問項目1から19まで一気にt検定したいので、計算をします。
code:t検定
t.test.result.ishiki <- ishiki.df %>%
mutate(nsize2016 = 4948, nsize2021 = 4124) %>%
mutate(t.value = (平均2016 - 平均2021)/sqrt(分散2016/nsize2016 +分散2021/nsize2021)) %>%
mutate(deg.f = (分散2016/nsize2016 + 分散2021/nsize2021)^2/((分散2016/nsize2016)^2/(nsize2016-1) + (分散2021/nsize2021)^2/(nsize2021-1))) %>%
mutate(p.value = 2*pt(abs(t.value),deg.f,lower.tail=F)) %>%
mutate(有意 = case_when(p.value <= 0.01 ~ "**",
p.value <= 0.05 ~ "*",
TRUE ~ ""))
このようなデータフレームができました。
https://gyazo.com/2b095f228348f9699543622c7fdd6c7b
(なお、元データがある場合はlapply()やmap()を使うとt.test()で一気に計算できるので最後に紹介します。)
④検定結果も反映したダンベルプロット
検定結果のデータフレームを作図用に整形します。
code:検定結果も反映したダンベルプロット用のデータの整形
t.test.result.ishiki.g <- t.test.result.ishiki %>%
select(question,平均2016,平均2021,有意) %>%
rename(A2016 = 平均2016, A2021 = 平均2021) %>%
# 差を表示するために差の変数を作っておきます。
mutate(差 = A2021 - A2016) %>%
# 2021の回答と2016の回答どちらか低い方を最低という変数にします。
mutate(最低 = case_when(差 >=0 ~ A2016,
TRUE ~ A2021)) %>%
# 差をダンベルの持ち手の真ん中に表示させるため平均を作っておきます。
mutate(平均 = (A2016 + A2021)/2) %>%
# 縦型に変換します。
gather(key = year, value = avarage,-question,-平均,-差,-最低,-有意)
このようなデータフレームができました。これを作図に使用します。
https://gyazo.com/9d4e5a0b0b666366852eeea29be486ff
code:検定結果も反映したダンベルプロットの作図]
# 作図
plot.ishiki <- t.test.result.ishiki.g %>%
# reorderでx軸の項目の順番を逆順にしておきます。
ggplot(aes(x= reorder(question,desc(question)), y = avarage)) +
# ダンベルの持ち手部分を描画
# color = 差 <= 0と設定することで、差の正負で色を変えます。これで2016から2021に増えたのか減ったのかわかりやすくします。
geom_line(aes(group = question,color = 差 <= 0), alpha = 0.3,size= 3) +
# どの項目のダンベルなのかわかりやすいように補助線を引きます。
# あとでy軸範囲を1~5に制御するのでyminは0ではなく1にしておきます。
geom_linerange(aes(x = question, ymin =1, ymax = 最低), linetype = "dashed", color = "grey", alpha = 0.3,size= 0.5) +
# 持ち手部分の色を設定します。凡例に出てくるので凡例の項目名なども設定します。
scale_color_manual(name = "2021の方が", labels = c("多い","少ない"), values = c("#00BFC4","#F8766D")) +
# この先新しく色を設定できるようにnew_scalse_colour()を使います。
new_scale_colour() +
# ダンベルの重し部分を描画します。調査年で色を変えます。
geom_point(aes(color = year),size=4) +
# 重し部分の色を設定します。凡例に出てくるので凡例の項目名なども設定します。
# 今回は2016が基準のように見せるため、2016年の方は灰色にします。
scale_color_manual(name = "年度", labels = c("AY2016","AY2021"),values = c("grey","#FAAB18")) +
# ダンベルの持ち手の真ん中に差を表示します。
geom_text(aes(x = question, y = 平均,
label = case_when(差 >= 0 ~ paste0("+",format(round(差,digits=1),nsmall=1),有意),
TRUE ~ paste0(format(round(差,digits=1),nsmall=1),有意))),
size= 3)+
# 割合のラベルをつけるのですが、すべて表示すると混み合うので、2021年の値だけ表示します(データフレームを2021のみにする)。
# 2021年の重し部分が左側にある場合は左側に、右側にある場合は右側に表示されるようにします。
geom_text(data = t.test.result.ishiki.g %>% filter(year == "A2021"),
aes(x = question,
y = case_when(avarage > 最低 ~ avarage + 0.2, TRUE ~ avarage -0.2),
label = avarage),
size= 4)+
# X軸とy軸を反転させます。
coord_flip() +
# 1~5の値しかとらないため軸の範囲を制御します。
ylim(1,5) +
# タイトルや軸名、キャプションを記載します。
labs(title = "大学生の意識(2016年調査、2021年調査の比較)",
subtitile ="サブタイトル",
x = "質問項目",
y = "平均",
caption = "値は2021年度のものだけ表示している。\n図中の+-のついた数値は2016年度の数値からの差を表し、\n統計的に有意に差があるとき、1%有意水準を満たす場合は**、5%有意水準を満たす場合は*を付している。\nベネッセ教育総合研究所『第4回大学生の学習・生活実態調査 2021年』より作成") +
# 体裁の設定をします。
theme_classic() +
theme(text = element_text(size = 16),
plot.title = element_text(size = 20),
legend.position = "right",
axis.text.y = element_text(hjust =0),
plot.caption = element_text(size=11,hjust =0))
plot.ishiki
これで統計的に有意に差があるかどうか反映し、増減をわかりやすくしたダンベルプロットができました。
https://gyazo.com/f39d4d1d2d126a3efe81f170f1ef78f6
hr.icon
(3) まとめ
今回は、ダンベルプロットの作図方法と、検定結果を反映した作図方法について紹介しました。
ggaltパッケージのgeom_dumbbell()を使えば簡単に作図できるのですが、執筆時点では、
・色分けを複数行いにくいこと
・凡例を操作しにくいこと
から、少しアレンジしにくいので、geom_dumbbell()を使わない方法を紹介しました。
なお、(2)③の最後に触れた元データがある場合にt.test()を一気に行う方法は以下のとおりです。
SampleデータはQ01からQ03の質問(1~5で回答)を2020年に10人、2021年に9人に回答してもらった次のような形をしたデータとします。
https://gyazo.com/25958b7ba1a29dd5479225554c50ec7a
code:sampleデータの作成
sample.df <- data.frame(
year = c(rep("AY2020",30),rep("AY2021",27)),
question = c(rep("Q01",10),rep("Q02",10),rep("Q03",10),
rep("Q01",9),rep("Q02",9),rep("Q03",9)),
answer = c(5,4,3,4,5,3,4,5,3,3,
3,3,2,4,1,3,5,3,2,3,
1,5,2,4,3,3,2,4,2,2,
5,5,4,3,2,3,2,3,3,
3,3,4,2,1,2,2,1,2,
3,4,5,4,3,4,4,2,3)
)
Lapply()やmap2()を使って、Q1からQ3の回答の平均値に年度間で有意に差があるか、一気にt.test()を行います。
code:t.test
result.df <- data.frame(
# まずQ01,Q02,Q03という値をとるquestionという変数を持ったデータフレームを作ります。
question = paste0("Q",formatC(rep(1:3),width = 2,flag = 0))
) %>%
# まずlist2020はlistを要素に持つ列です。sample.dataを2020年に絞って、さらにquestion列のQXXで絞った回答のリストを作ります。
# lapplyで要素を引数にした計算ができます。Lapply(引数, function(x) 関数の記載)と書きます。
mutate(list2020 = lapply(question, function(x) sample.df %>%
filter(year == "AY2020") %>%
filter(question == x) %>%
select(answer) %>%
# pull()でリストにします。
pull()),
# 2021年度についても同様に作ります。
list2021 = lapply(question, function(x) sample.df %>%
filter(year == "AY2021") %>%
filter(question == x) %>%
select(answer) %>%
pull())
) %>%
# 平均や分散はt.testには必要ないですが参考に作っておきます。
# lapplyで要素を引数にした計算ができます。
mutate(mean2020 = lapply(list2020, function(x) mean(x)),
mean2021 = lapply(list2021, function(x) mean(x)),
var2020 = lapply(list2020, function(x) var(x)),
var2021 = lapply(list2021, function(x) var(x)),
# t.testをします。map2で2要素を引数にした計算ができます。
# lapplyと似ていますが、function(x)の代わりに”~”が入って、第一引数が.x、第二引数が.yになります。
t.test = map2(list2020,list2021, ~ t.test(.x,.y, var =F))) %>%
# t.testの中からp.valueを引っ張ってきます。[]と囲いが一つだけリストで返ってくるので[[]]と2重に囲んで数値を引っ張ってきます。
mutate(p.value = lapply(t.test, function(x) x"p.value"))
作成したresult.dfはこのような形をしています。
https://gyazo.com/10dfd9762f92c0edf90b0f0a59695d4c
質問数が多くてもこの方法で一気に各質問について年度間の平均値に差があるか検定できます。
hr.icon
注
(*1) この内容は私個人の見解であり、所属組織の見解ではありません。
(*6) リッカート尺度は順序尺度なのに平均値を取っていいのか問題については、” リッカート式尺度は何を測っていて、なぜ尺度平均値を使うのか”『Sunny Side up!』(関西学院大学社会学部社会心理学研究室 清水裕士)< https://norimune.net/3650 >がわかりやすい。 ※当コラムの文責及び著作権は、すべて投稿者に帰属します。