tidyverseのパッケージを使うことを宣言し、すべてのリストを削除してから始める。
超能力など、子どもたちの非合理志向の考え方の傾向を調査する。
調査期間は1994年度~2003年度です。
当時スプーン曲げなど非合理的志向をあおるようなテレビ番組が多く見られました。
子どもたちがその影響を強く受けていることを知り、
その大きさを具体的に知りたいと思いに高校生に行ったアンケートを紹介する。
『超能力を科学する』安斎育郎(かもがわ出版)に紹介されている子どもを守る会が行ったアンケートが紹介されていたので、
それと同じ質問を使ってアンケートをすることにしました。
そこには『子どものしあわせ』1988年11月臨時増刊号にはそのアンケート調査結果が紹介されていました。
21世紀に入っても旧統一教会の問題がクローズアップされています。
ここでは改めてRを使って解析することに挑戦し始めました。
このレポートに取り組む中で私と同じころに大学生を対象とした調査を
綿密な計画の下でアンケートをされている方を知りました。
「大学生の非合理志向について」原田唯司(静岡大学教育学部)
Japanese association of educational psychology 人格 L 3038
このようなことに関心のある方はご連絡してください。
まだこのデータを詳しく解析したいので、
協力していただけるとありがたいと思います。
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0 ✔ purrr 1.0.0
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.2.1 ✔ stringr 1.4.1
## ✔ readr 2.1.3 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
rm(list = ls())
chounouryoku <- read_csv("./chounouryoku_DATA/chounouryoku_data_kaiseki_2 .csv")
## Rows: 57 Columns: 48
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): kurasu
## dbl (47): seireki, gakunen, Q_1_a, Q_1_i, Q_1_u, Q_1_e, Q_1_kei, Q_2_a, Q_2_...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# 超能力アンケートのデータを読み込む 以下はプログラムの働きを練習
# attach(chounouryoku) # attach()は混乱のもとになるから使わないようにする
# colnames(chounouryoku)#列名を調べる
# print(chounouryoku[,1:18],n=20)# 20行まで
# class(chounouryoku)
# dim(chounouryoku)
# head(chounouryoku)
# summary(chounouryoku)
# mean(chounouryoku$Q_1_a)
# mean(chounouryoku$Q_1_i)
# mean(chounouryoku$Q_1_u)
# mean(chounouryoku$Q_1_e)
# mean(chounouryoku$Q_1_kei)
# sd(chounouryoku$Q_1_a)
# sd(chounouryoku$Q_1_i)
# sd(chounouryoku$Q_1_u)
# sd(chounouryoku$Q_1_e)
# sd(chounouryoku$Q_1_kei)
# seireki
# chounouryoku[order(seireki,gakunen,kurasu),]
# edit(chounouryoku)
# mean(chounouryoku$Q_1_kei)
# chounouryoku$Q_1_kei
# Q_1_a
『Wondderful R Rで楽しむ統計』奥村晴彦著 共立出版 p.161
data1 <- matrix(c(4,5,6,3,2,1,4,3,6,6), byrow=TRUE, nrow=2)#
行数=2 “Tips” p.273;/n
rownames(data1) <- c(“従来型”,“ICT利用”)# “Tips” p.272
colnames(data1) <- c(“最悪”,“悪い”,“普通”,“良い”,“最高”)# “Tips”
p.273
ratio = data1 / rowSums(data1) * 100 # “Tips” p.209 cf.colSum()
barplot(t(ratio[2:1,]), horiz = TRUE, las = 1, xlab = “%”)#
t()は転置行列
t= ratio[1,]# グラフの表示(最悪、悪、普通、良い、最高)
mtext(colnames(data1),at=cumsum(t)-t/2) # cumsum() 累積和
# 関数 apply() “Tips” p.209
# (x <- matrix(1:8,ncol=4))
# apply(x,2,sum) # 各列の総和
# data1
data2 <- matrix(c(chounouryoku$seireki,chounouryoku$gakunen,chounouryoku$kurasu,
chounouryoku$Q_1_a,chounouryoku$Q_1_i,chounouryoku$Q_1_u,chounouryoku$Q_1_e,
chounouryoku$Q_2_a,chounouryoku$Q_2_i,chounouryoku$Q_2_u,chounouryoku$Q_2_e,
chounouryoku$Q_3_a,chounouryoku$Q_3_i,chounouryoku$Q_3_u,chounouryoku$Q_3_e,
chounouryoku$Q_4_a,chounouryoku$Q_4_i,chounouryoku$Q_4_u,chounouryoku$Q_4_e,
chounouryoku$Q_5_a,chounouryoku$Q_5_i,chounouryoku$Q_5_u,chounouryoku$Q_5_e,
chounouryoku$Q_6_a,chounouryoku$Q_6_i,chounouryoku$Q_6_u,chounouryoku$Q_6_e,
chounouryoku$Q_7_a,chounouryoku$Q_7_i,chounouryoku$Q_7_u,chounouryoku$Q_7_e,
chounouryoku$Q_8_a,chounouryoku$Q_8_i,chounouryoku$Q_8_u,chounouryoku$Q_8_e,
chounouryoku$Q_9_a,chounouryoku$Q_9_i,chounouryoku$Q_9_u,chounouryoku$Q_9_e)
,byrow=TRUE,ncol=57, nrow = 39)
#` data2
#` head(data2)
#` data3 <- t(data2)
調査結果のうちから年度及び学年を指定してデータを読み込む。
各項目の集計をする。
data4 <- chounouryoku %>% filter(seireki==1998,gakunen==2)
q1a_kei <- sum(data4$Q_1_a);q1i_kei <- sum(data4$Q_1_i);
q1u_kei <- sum(data4$Q_1_u);q1e_kei <- sum(data4$Q_1_e);
q2a_kei <- sum(data4$Q_2_a);q2i_kei <- sum(data4$Q_2_i);
q2u_kei <- sum(data4$Q_2_u);q2e_kei <- sum(data4$Q_2_e);
q3a_kei <- sum(data4$Q_3_a);q3i_kei <- sum(data4$Q_3_i);
q3u_kei <- sum(data4$Q_3_u);q3e_kei <- sum(data4$Q_3_e);
q4a_kei <- sum(data4$Q_4_a);q4i_kei <- sum(data4$Q_4_i);
q4u_kei <- sum(data4$Q_4_u);q4e_kei <- sum(data4$Q_4_e);
q5a_kei <- sum(data4$Q_5_a);q5i_kei <- sum(data4$Q_5_i);
q5u_kei <- sum(data4$Q_5_u);q5e_kei <- sum(data4$Q_5_e);
q6a_kei <- sum(data4$Q_6_a);q6i_kei <- sum(data4$Q_6_i);
q6u_kei <- sum(data4$Q_6_u);q6e_kei <- sum(data4$Q_6_e);
q7a_kei <- sum(data4$Q_7_a);q7i_kei <- sum(data4$Q_7_i);
q7u_kei <- sum(data4$Q_7_u);q7e_kei <- sum(data4$Q_7_e);
q8a_kei <- sum(data4$Q_8_a,na.rm=TRUE);q8i_kei <- sum(data4$Q_8_i,na.rm=TRUE);
q8u_kei <- sum(data4$Q_8_u,na.rm=TRUE);q8e_kei <- sum(data4$Q_8_e,na.rm=TRUE);
q9a_kei <- sum(data4$Q_9_a,na.rm=TRUE);q9i_kei <- sum(data4$Q_9_i,na.rm=TRUE);
q9u_kei <- sum(data4$Q_9_u,na.rm=TRUE);q9e_kei <- sum(data4$Q_9_e,na.rm=TRUE)
# 1994年の2学年のデータを抽出し集計
# sum(Q_8_a,na.rm=TRUE)# NAが存在するデータを無視して集計するときには引数としてこれを書いておくこと
head(data4)
## # A tibble: 3 × 48
## seireki gakunen kurasu Q_1_a Q_1_i Q_1_u Q_1_e Q_1_kei Q_2_a Q_2_i Q_2_u Q_2_e
## <dbl> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1998 2 c 6 23 7 1 37 0 24 8 3
## 2 1998 2 d 0 23 11 2 36 0 18 15 3
## 3 1998 2 f 2 16 3 6 27 2 17 5 8
## # … with 36 more variables: Q_2_kei <dbl>, Q_3_a <dbl>, Q_3_i <dbl>,
## # Q_3_u <dbl>, Q_3_e <dbl>, Q_3_kei <dbl>, Q_4_a <dbl>, Q_4_i <dbl>,
## # Q_4_u <dbl>, Q_4_e <dbl>, Q_4_kei <dbl>, Q_5_a <dbl>, Q_5_i <dbl>,
## # Q_5_u <dbl>, Q_5_e <dbl>, Q_5_kei <dbl>, Q_6_a <dbl>, Q_6_i <dbl>,
## # Q_6_u <dbl>, Q_6_e <dbl>, Q_6_kei <dbl>, Q_7_a <dbl>, Q_7_i <dbl>,
## # Q_7_u <dbl>, Q_7_e <dbl>, Q_7_kei <dbl>, Q_8_a <dbl>, Q_8_i <dbl>,
## # Q_8_u <dbl>, Q_8_e <dbl>, Q_8_kei <dbl>, Q_9_a <dbl>, Q_9_i <dbl>, …
quest_1998_2 <- matrix(c(q1a_kei,q1i_kei,q1u_kei,q1e_kei,q2a_kei,q2i_kei,q2u_kei,q2e_kei,
q3a_kei,q3i_kei,q3u_kei,q3e_kei,q4a_kei,q4i_kei,q4u_kei,q4e_kei,
q5a_kei,q5i_kei,q5u_kei,q5e_kei,q6a_kei,q6i_kei,q6u_kei,q6e_kei,
q7a_kei,q7i_kei,q7u_kei,q7e_kei,q8a_kei,q8i_kei,q8u_kei,q8e_kei,
q9a_kei,q9i_kei,q9u_kei,q9e_kei),byrow=TRUE,nrow=9,ncol=4)
# edit(quest_1998_2)
# quest_1998_2
data5 <- t(quest_1998_2)
head(data5)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 8 2 1 4 2 1 9 6 1
## [2,] 62 59 47 44 18 30 44 44 39
## [3,] 21 28 44 31 60 64 41 32 38
## [4,] 9 14 8 19 19 0 0 7 13
ratio1 = data5[1,]/ colSums(data5)*100 # 1行目の計算
ratio2 = data5[2,]/ colSums(data5)*100 # 2行目の計算
ratio3 = data5[3,]/ colSums(data5)*100 # 3行目の計算
ratio4 = data5[4,]/ colSums(data5)*100 # 4行目の計算
ratio10 = data5[1,]/ colSums(data5)*100 # 全体の計算まではできた
ratio = matrix(c(ratio1,
ratio2,
ratio3,
ratio4),
byrow=TRUE,
nrow = 4,
ncol = 9) # byrow=TRUE, nrow = 4,ncol = 9 (集計を9行4列の表にする)
# edit(ratio)
write.table(ratio,
"./result/chounouryoku_ratio_1998_2_tbl.csv",
sep=",",
quote=FALSE,
append=FALSE,
row.names=FALSE)
chounouryoku_ratio_1998_2_tbl <- read_csv("./result/chounouryoku_ratio_1998_2_tbl.csv")
## Rows: 4 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (9): V1, V2, V3, V4, V5, V6, V7, V8, V9
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# 超能力アンケートの集計データを読み込む
# edit(chounouryoku_ratio_1998_2_tbl)
# barplot(t(ratio[,1:2]),horiz = TRUE, las = 1,xlab = "%")# t()は転置行列
# barplot(t(ratio[,1]),horiz = TRUE, las = 1,xlab = "%",ylab = "意識")# 棒グラフを描く
barplot(ratio[,1:9],
horiz = TRUE,
las = 1,
main="1998年度2学年\nある あるかも ない 分からない",
xlab = "%",
ylab = "幽霊 たたり 超能力 魂 運命 おまじない 占い UFO 願い")
# 棒グラフを描く これがよいpaste("exist ","maybe exist ","do not ","do'nt know",sep="")
t= ratio[1,]
mtext(rownames(data5),
side=3,
adj=1,
at=cumsum(t)-t-t/2) # cumsum() 累積和 ここはまだできない
png("figure/barplot_chounouryoku_1998_2.png",width=800,height = 500)
barplot(ratio[,1:9],
horiz = TRUE,
las = 1,
main="1998年度2学年\nある あるかも ない 分からない",
xlab = "%",
ylab = "幽霊 たたり 超能力 魂 運命 おまじない 占い UFO 願い")
# 棒グラフを描く これがよいpaste("exist ","maybe exist ","do not ","do'nt know",sep="")
t= ratio[1,]
mtext(rownames(data5),side=3,adj=1,at=cumsum(t)-t-t/2) # cumsum() 累積和 ここはまだできない
dev.off()
## png
## 2
mtext(colnames(data1),at=cumsum(t)-t/2) # cumsum() 累積和
工事中
過去に行った調査から幽霊に関する意識がどのように変化しているかを取り出してみたいと思います。
data6 <- chounouryoku %>%
select(seireki,gakunen,Q_1_a,Q_1_i,Q_1_u,Q_1_e) edit(data6) data7 <-
data6 %>% filter(seireki==1994,gakunen==1)
# filter(data4\(seireki=="1994",data4\)gakunen==“1”)
edit(data7)
data6 <- chounouryoku %>% select(seireki,gakunen,Q_1_a,Q_1_i,Q_1_u,Q_1_e)
# edit(data6) データを確かめる
data7 <- data6 %>% filter(seireki>=1994,gakunen==3)
# edit(data7) データを確かめる
q1a_kei <- sum(data7$Q_1_a);
q1i_kei <- sum(data7$Q_1_i);
q1u_kei <- sum(data7$Q_1_u);
q1e_kei <- sum(data7$Q_1_e);
# q2a_kei <- sum(data7$Q_2_a);
# q2i_kei <- sum(data7$Q_2_i);
# q2u_kei <- sum(data7$Q_2_u);
# q2e_kei <- sum(data7$Q_2_e);
# q3a_kei <- sum(data7$Q_3_a);
# q3i_kei <- sum(data7$Q_3_i);
# q3u_kei <- sum(data7$Q_3_u);
# q3e_kei <- sum(data7$Q_3_e);
# q4a_kei <- sum(data7$Q_4_a);
# q4i_kei <- sum(data7$Q_4_i);
# q4u_kei <- sum(data7$Q_4_u);
# q4e_kei <- sum(data7$Q_4_e);
# q5a_kei <- sum(data7$Q_5_a);
# q5i_kei <- sum(data7$Q_5_i);
# q5u_kei <- sum(data7$Q_5_u);
# q5e_kei <- sum(data7$Q_5_e);
# q6a_kei <- sum(data7$Q_6_a);
# q6i_kei <- sum(data7$Q_6_i);
# q6u_kei <- sum(data7$Q_6_u);
# q6e_kei <- sum(data7$Q_6_e);
# q7a_kei <- sum(data7$Q_7_a);
# q7i_kei <- sum(data7$Q_7_i);
# q7u_kei <- sum(data7$Q_7_u);
# q7e_kei <- sum(data7$Q_7_e);
# q8a_kei <- sum(data7$Q_8_a,na.rm=TRUE);
# q8i_kei <- sum(data7$Q_8_i,na.rm=TRUE);
# q8u_kei <- sum(data7$Q_8_u,na.rm=TRUE);
# q8e_kei <- sum(data7$Q_8_e,na.rm=TRUE);
# q9a_kei <- sum(data7$Q_9_a,na.rm=TRUE);
# q9i_kei <- sum(data7$Q_9_i,na.rm=TRUE);
# q9u_kei <- sum(data7$Q_9_u,na.rm=TRUE);
# q9e_kei <- sum(data7$Q_9_e,na.rm=TRUE)
1994年の3学年のデータを抽出し集計
sum(Q_8_a,na.rm=TRUE)#
NAが存在するデータを無視して集計するときには引数としてこれを書いておくこと
head(data7)
## # A tibble: 6 × 6
## seireki gakunen Q_1_a Q_1_i Q_1_u Q_1_e
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1994 3 13 28 0 0
## 2 1994 3 5 26 2 2
## 3 1997 3 2 22 4 3
## 4 1997 3 5 15 7 1
## 5 1997 3 10 20 0 0
## 6 1998 3 4 22 4 4
quest_1994_3 <- matrix(c(q1a_kei,q1i_kei,q1u_kei,q1e_kei),byrow=TRUE,nrow=9,ncol=4)
# q2a_kei,q2i_kei,q2u_kei,q2e_kei,
# q3a_kei,q3i_kei,q3u_kei,q3e_kei,
# q4a_kei,q4i_kei,q4u_kei,q4e_kei,
# q5a_kei,q5i_kei,q5u_kei,q5e_kei,
# q6a_kei,q6i_kei,q6u_kei,q6e_kei,
# q7a_kei,q7i_kei,q7u_kei,q7e_kei,
# q8a_kei,q8i_kei,q8u_kei,q8e_kei,
# q9a_kei,q9i_kei,q9u_kei,q9e_kei),
# byrow=TRUE,nrow=9,ncol=4)
# edit(quest_1994_3)
# quest_1994_3
data8 <- t(quest_1994_3)
head(data8)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 114 114 114 114 114 114 114 114 114
## [2,] 466 466 466 466 466 466 466 466 466
## [3,] 97 97 97 97 97 97 97 97 97
## [4,] 43 43 43 43 43 43 43 43 43
barplot(ratio[1:4 ,1:3],
horiz = TRUE,
las = 1,
main = "幽霊",
xlab = "%",
ylab = "1994 1995")
2年度以上の幽霊のデータのグラフを並べるのにはどのようにすればいいのでしょうか。 まだわかりません。分かる方は是非教えてください。
barplot(ratio[1:4 ,1:4],
horiz = TRUE,
las = 1,
main = "幽霊2",
xlab = "%",
ylab = "1994 1995")
最近新しく問題視されてきたたたりについてはどうでしょうか。
魂に対する見方の変化も調べてみたいと思います。
大人の方たちのこれら非合理志向の考え方はどんな状況なのかも知りたいですね。
このような意識について調べ、社会としてどのように対処していけばいいのでしょうか。
非合理志向が社会の発展には必要というような意見も見られるが、
私がここで非合理志向と呼んでいることは何と呼べばいいのでしょうか。
幽霊やたたりの考え方が社会を発展させるとはとても思えません。
みなさんもこのようなアンケートをできる方は現在での意識調査を行って、
私の意識調査の結果と比べていただきたいと思います。
rownames(data7)<-colnames(chounouryoku) colnames(t(data7)) # 超能力の列名をt(data7)の列名とする edit(t(data7))
data8 <- t(data7) %>% pivot_longer(t(data7), cols =
c(“Q_1_a”,“Q_1_i”,“Q_1_u”,“Q_1_e”),c(“Q_2_a”,“Q_2_i”,“Q_2_u”,“Q_2_e”),
c(“Q_3_a”,“Q_3_i”,“Q_3_u”,“Q_3_e”),c(“Q_4_a”,“Q_4_i”,“Q_4_u”,“Q_4_e”),
c(“Q_5_a”,“Q_5_i”,“Q_5_u”,“Q_5_e”),c(“Q_6_a”,“Q_6_i”,“Q_6_u”,“Q_6_e”),
c(“Q_7_a”,“Q_7_i”,“Q_7_u”,“Q_7_e”),c(“Q_8_a”,“Q_8_i”,“Q_8_u”,“Q_8_e”),
c(“Q_9_a”,“Q_9_i”,“Q_9_u”,“Q_9_e”),
names_to = c(“quest_a”,“quest_i”,“quest_u”,“quest_e”),
values_to = c(“ninzu_a”,“ninzu_i”,“ninzu_u”,“ninzu_e”)
)
この上下どちらのpivot_longer()のコードが成功しない
data8 <- t(data7) %>% pivot_longer(t(data7),
cols =
matrix(c(“Q_1_a”,“Q_1_i”,“Q_1_u”,“Q_1_e”),
c(“Q_2_a”,“Q_2_i”,“Q_2_u”,“Q_2_e”),
c(“Q_3_a”,“Q_3_i”,“Q_3_u”,“Q_3_e”),
c(“Q_4_a”,“Q_4_i”,“Q_4_u”,“Q_4_e”),
c(“Q_5_a”,“Q_5_i”,“Q_5_u”,“Q_5_e”),
c(“Q_6_a”,“Q_6_i”,“Q_6_”u”,Q_6_e”),
c(“Q_7_a”,“Q_7_i”,“Q_7_u”,“Q_7_e”),
c(“Q_8_a”,“Q_8_i”,“Q_8_u”,“Q_8_e”),
c(“Q_9_a”,“Q_9_i”,“Q_9_u”,“Q_9_e”),
byrow = TRUE, nrow = 4,ncol = 9 ),
names_to = c(“quest_a”,“quest_i”,“quest_u”,“quest_e”),
values_to = c(“ninzu_a”,“ninzu_i”,“ninzu_u”,“ninzu_e”)
)
pivot_longer()が成功しない!
yuurei_q <- select(chounouryoku,seireki:Q_1_e) write_csv(yuurei_q,“./yuurei_q/yuurei_q.csv”) edit(yuurei_q)
tatari_q <- select(chounouryoku,seireki:kurasu,Q_2_a:Q_2_e) write_csv(tatari_q,“./tatari_q/tatari_q.csv”)
chounouryoku_q <- select(chounouryoku,seireki:kurasu,Q_3_a:Q_3_e) write_csv(chounouryoku_q,“./chounouryoku_q/chounouryoku_q.csv”)
tamashii_q <- select(chounouryoku,seireki:kurasu,Q_4_a:Q_4_e) write_csv(tamashii_q,“./tamashii_q/tamashii_q.csv”)
unmei_q <- select(chounouryoku,seireki:kurasu,Q_5_a:Q_5_e) write_csv(unmei_q,“./unmei_q/unmei_q_q.csv”)
majinai_q <- select(chounouryoku,seireki:kurasu,Q_6_a:Q_6_e) write_csv(majinai_q,“./majinai_q/majinai_q.csv”)
uranai_q <- select(chounouryoku,seireki:kurasu,Q_7_a:Q_7_e) write_csv(uranai_q,“./uranai_q/uranai_q.csv”)
ufo_q <- select(chounouryoku,seireki:kurasu,Q_8_a:Q_8_e) write_csv(ufo_q,“./ufo_q/ufo_q.csv”)
negai_q <- select(chounouryoku,seireki:kurasu,Q_9_a:Q_9_e) write_csv(negai_q,“./negai_q/negai_q.csv”)
以下はコードの練習
colnames(data5)
chounouryoku %>% group_by(-gakunen)
chounouryoku
#’data2 %>% arrange(seireki) %>% print(data2)
str(data2)
# ratio = data5 / rowSums(data5)*100
barplot(t(ratio[2:1,5]),horiz = TRUE, las = 1,xlab = “%”)
# t= ratio[1,]
mtext(colnames(data5),at=cumsum(t)-t/2)