大学入試センターから令和7年度試験の問題作成の方向性,試作問題等が令和4年11月に公開されています。
情報Ⅰでは問題4がデータサイエンス分野からの出題で、すでに解説を掲載されているサイトもあります。高校情報科・情報処理技術者試験対策の突破口ドットコム様でも詳しく説明されており、とても参考になります。
問題を見ての感想は、
総務省の総合学習向け課題では「47都道府県31品目の食料品消費傾向」を題材にしていますが、試作問題では「社会生活基本調査・生活時間編」が題材となっています。前述のサイト様では、エクセルでダウンロード・整理したデータが公開されています。
ここでは、Rも使用しながら問題の内容を見ていきます。
スマホ使用時間1時間未満のエクセルシートを読み込み、データを数値化します。
元のエクセルデータでは、データのない県(欠測値)は”…“となっています。
また、データがある県でも、一部の項目が結束のものは”-”
となっています。
項目名は
“01_睡眠”=x_1 | “02_身の回りの用事”=x_2 | “03_食事”=x_3 |
“04_通勤通学”=x_4 | “06_学業”=x_6 | “15_趣味娯”=x_15 |
など簡略化します。
library(readxl)
data1 <- read_excel("data/r7_joho_4.xlsx", sheet = "1時間未満",na = "...")
colnames(data1)<- c("地域区分" ,"x_1","x_2","x_3","x_4","x_6","x_15")
str(data1)
## tibble [47 × 7] (S3: tbl_df/tbl/data.frame)
## $ 地域区分: chr [1:47] "01_北海道" "02_青森県" "03_岩手県" "04_宮城県" ...
## $ x_1 : num [1:47] 439 411 442 425 447 NA NA 407 433 411 ...
## $ x_2 : num [1:47] 74 74 61 56 73 NA NA 61 76 77 ...
## $ x_3 : num [1:47] 79 73 87 114 85 NA NA 80 113 108 ...
## $ x_4 : num [1:47] 60 98 98 41 42 NA NA 79 50 79 ...
## $ x_6 : num [1:47] 465 480 539 400 501 NA NA 552 445 418 ...
## $ x_15 : chr [1:47] "8" "13" "8" "-" ...
47都道府県で、欠測のところはNA(no answer)となっています。
x_15のデータをnumeric型に直しておきます。
data1$x_15<-as.numeric(data1$x_15)
## Warning: 強制変換により NA が生成されました
head(data1)
地域区分 | x_1 | x_2 | x_3 | x_4 | x_6 | x_15 |
---|---|---|---|---|---|---|
01_北海道 | 439 | 74 | 79 | 60 | 465 | 8 |
02_青森県 | 411 | 74 | 73 | 98 | 480 | 13 |
03_岩手県 | 442 | 61 | 87 | 98 | 539 | 8 |
04_宮城県 | 425 | 56 | 114 | 41 | 400 | NA |
05_秋田県 | 447 | 73 | 85 | 42 | 501 | 8 |
06_山形県 | NA | NA | NA | NA | NA | NA |
スマホ使用時間3時間以上6時間未満のエクセルシートを読み込み、データを数値化します。
data2 <- read_excel("data/r7_joho_4.xlsx", sheet = "3時間以上6時間未満",na = "...")
colnames(data2)<- c("地域区分" ,"x_1","x_2","x_3","x_4","x_6","x_15")
head(data2)
地域区分 | x_1 | x_2 | x_3 | x_4 | x_6 | x_15 |
---|---|---|---|---|---|---|
01_北海道 | 436 | 74 | 88 | 63 | 411 | 64 |
02_青森県 | 461 | 57 | 83 | 55 | 269 | 44 |
03_岩手県 | 442 | 70 | 76 | 54 | 366 | 63 |
04_宮城県 | 426 | 64 | 86 | 89 | 285 | 44 |
05_秋田県 | 430 | 68 | 76 | 96 | 340 | 41 |
06_山形県 | 426 | 69 | 67 | 64 | 509 | 54 |
str(data2)
## tibble [47 × 7] (S3: tbl_df/tbl/data.frame)
## $ 地域区分: chr [1:47] "01_北海道" "02_青森県" "03_岩手県" "04_宮城県" ...
## $ x_1 : num [1:47] 436 461 442 426 430 426 422 443 386 427 ...
## $ x_2 : num [1:47] 74 57 70 64 68 69 51 80 120 76 ...
## $ x_3 : num [1:47] 88 83 76 86 76 67 77 81 79 60 ...
## $ x_4 : num [1:47] 63 55 54 89 96 64 55 82 77 65 ...
## $ x_6 : num [1:47] 411 269 366 285 340 509 379 423 504 442 ...
## $ x_15 : num [1:47] 64 44 63 44 41 54 53 63 33 69 ...
47都道府県のデータになっています。
A、B 各データを箱ヒゲ図で表示します。
par(mfrow = c(1, 1))
par(family = "HiraKakuProN-W3")
boxplot(data1[,-1],main="A:スマホ1時間以内")
boxplot(data2[,-1],main="B:スマホ3〜6時間")
hikaku3 <- data.frame(data1$x_3,data2$x_3)
par(mfrow = c(1, 1))
boxplot(hikaku3,names = c("A","B"))
食事の時間x_3 は、差があるようには見えません。
発展
統計学では2群の差は「t検定」によって 判断します。
#等分散を仮定したTwo Sample t-test
t.test(data1$x_3,data2$x_3,var.equal = TRUE)
##
## Two Sample t-test
##
## data: data1$x_3 and data2$x_3
## t = 2.3067, df = 86, p-value = 0.02347
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.7254683 9.7737532
## sample estimates:
## mean of x mean of y
## 86.12195 80.87234
#等分散を仮定しないWelch Two Sample t-test
t.test(data1$x_3,data2$x_3,var.equal = FALSE)
##
## Welch Two Sample t-test
##
## data: data1$x_3 and data2$x_3
## t = 2.2929, df = 81.878, p-value = 0.02442
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.695027 9.804195
## sample estimates:
## mean of x mean of y
## 86.12195 80.87234
等分散を仮定した「Two Sample t-test」でも、等分散を仮定しない「Welch
Two Sample t-test」でも、
P値は0.024ほどで、差がないという仮説は棄却されます。
(t検定の詳しい説明は別の機会に譲ります)
当サイトではt検定については、
<高校情報Ⅰの統計解析>の3_統計的推測 「2.2.4
フライドポテトの重量」に説明があります。
#回帰分析
plot(data2$x_6,data2$x_15)
res <- lm(x_15 ~ x_6, data = data2)
abline(res, lwd=2)
summary(res)
##
## Call:
## lm(formula = x_15 ~ x_6, data = data2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -45.115 -12.648 -0.053 9.075 64.320
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 85.90432 21.96141 3.912 0.000307 ***
## x_6 -0.06244 0.05563 -1.122 0.267677
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 22.45 on 45 degrees of freedom
## Multiple R-squared: 0.02723, Adjusted R-squared: 0.005612
## F-statistic: 1.26 on 1 and 45 DF, p-value: 0.2677
回帰係数は有意でないので、学業と趣味には関係は認められないようです。決定係数も低くなっています。
hikaku4 <- data.frame(data1$x_4,data2$x_4)
par(mfrow = c(1, 1))
boxplot(hikaku4)
t.test(data1$x_4,data2$x_4,var.equal = TRUE)
##
## Two Sample t-test
##
## data: data1$x_4 and data2$x_4
## t = -0.29763, df = 86, p-value = 0.7667
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -8.914582 6.592838
## sample estimates:
## mean of x mean of y
## 72.07317 73.23404
t.test(data1$x_4,data2$x_4,var.equal = FALSE)
##
## Welch Two Sample t-test
##
## data: data1$x_4 and data2$x_4
## t = -0.29695, df = 83.545, p-value = 0.7672
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -8.935663 6.613919
## sample estimates:
## mean of x mean of y
## 72.07317 73.23404
P値は0.7を超えており、差があるという仮説は棄却されません。
つまり、差は認められません。
箱ヒゲ図の読み取りの問題です。
rでの分析はできません。上記サイト様を参照ください。
data3 <- read_excel("data/r7_joho_4.xlsx", sheet = "図3生活行動時間の差",na = "...")
colnames(data3)<- c("地域区分" ,"x_1","x_6")
head(data3)
地域区分 | x_1 | x_6 |
---|---|---|
01_北海道 | 3 | 54 |
02_青森県 | -50 | 211 |
03_岩手県 | 0 | 173 |
04_宮城県 | -1 | 115 |
05_秋田県 | 17 | 161 |
06_山形県 | NA | NA |
str(data3)
## tibble [47 × 3] (S3: tbl_df/tbl/data.frame)
## $ 地域区分: chr [1:47] "01_北海道" "02_青森県" "03_岩手県" "04_宮城県" ...
## $ x_1 : num [1:47] 3 -50 0 -1 17 NA NA -36 47 -16 ...
## $ x_6 : num [1:47] 54 211 173 115 161 NA NA 129 -59 -24 ...
hikaku <- data.frame(data3$x_1,data3$x_6)
par(mfrow = c(1, 1))
par(family = "HiraKakuProN-W3")
boxplot(hikaku,names = c("睡眠","学業"))
選択肢A,Bは選択文から Aが正しいと判断されます。
選択肢C,D,Eは、学業が差の開きが大きいので、Cが正しいと判断されます。
グループAについて、x_6(学業)とx_1(睡眠)を散布図で示し、各軸の周辺分布を箱ヒゲ図で示したものです。
library(ggplot2)
library(ggExtra)
#data("iris")
#class(iris)
#head(iris)
g <- ggplot(data1, aes(x = x_6, y = x_1))
g <- g + geom_point()
ggMarginal(
g,
type = "boxplot",
margins = "both",
size = 5
)
## Warning: Removed 6 rows containing missing values (`geom_point()`).
## Warning: Continuous x aesthetic
## ℹ did you forget `aes(group = ...)`?
## Continuous x aesthetic
## ℹ did you forget `aes(group = ...)`?
負の相関を読み取ることができます。回帰分析を分析を適応します。
#回帰分析
plot(data2$x_6,data2$x_1)
res <- lm(x_1 ~ x_6, data = data1)
abline(res, lwd=2)
summary(res)
##
## Call:
## lm(formula = x_1 ~ x_6, data = data1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -74.946 -16.494 2.547 17.820 58.861
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 491.1655 27.4081 17.920 <2e-16 ***
## x_6 -0.1364 0.0547 -2.494 0.017 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 27.26 on 39 degrees of freedom
## ( 6 個の観測値が欠損のため削除されました )
## Multiple R-squared: 0.1376, Adjusted R-squared: 0.1155
## F-statistic: 6.221 on 1 and 39 DF, p-value: 0.01697
回帰直線は \(x_1=491.1655-0.1364x_6\)
傾き0を帰無仮説としたP値は0.017。有意水準5%で有意で、相関が認められます。
相関係数を求めるには、欠測値をna.omitで除去して計算します。
data1 <- na.omit(data1)#欠測値の除去
sd(data1$x_1)#x_1の標準偏差
## [1] 29.19383
sd(data1$x_6)#x_6の標準偏差
## [1] 79.39166
cor(data1$x_1,data1$x_6)#相関係数
## [1] -0.3972399
相関係数は -0.3972399。 弱い負の相関が認められます。
負の相関を説明している選択肢は②です。
回帰結果(res)を関数plotに代入すると、次の4つのグラフが得られます。
回帰分析の残差などを視覚的に考察することができます。
par(mfrow = c(2, 2))
plot(res)
回帰分析がうまくいっているかどうかは、残差が0を中心に正負バランスのよい値になっているかが重要です。
本問で取り上げられているのは最初の図で、横軸に推定値(fitted
values)、縦軸に残差(residual)をとります。
残差=実測値ー予測値
であり、残差が大きすぎるものは外れ値であり、慎重な対応が求められます。
1番目のグラフを取り出して表示します。
plot(res, which=1)
データ番号12,27,44のデータは残差が大きく、外れ値の候補となります。
問題指示の通り、標準偏差の2倍を以上を外れ値とすると、x_1の標準偏差は29.19383ですから、58以上離れたデータを外れ値とすることになります。
従って、データ番号12,27が外れ値と判断でき、外れ値は2個になります。
回帰によるP県の座標は(420,380)ですが、回帰直線からの予測値は430と読み取れるので、問題の表では①の点に相当し、外れ値ではないと判断できます。
回帰分析の流れが掴めていないと、何をやっているか分からず難しく感じられます。
回帰の理論的証明はさておき、実際のデータでrなどを用いて回帰分析を体験し、結果を解釈する練習が求められます。