期末テスト（回答編）
問題：次の７つの処理を実行し、その結果をRmdファイルからhtmlファイルにknitし、moodleに張り付けなさい。
ただし、処理５についてはMoodleに設定したQuizに回答しなさい。箱ひげ図による男女の成績の比較
English, History, Japanese, Information, Science, Mathematicsの６教科の点数と
合計の点数を男女について比較する次に示す７つの処理を実行しなさい。
７つの処理は各々を別々のchunkとしてコードを記述し、また、コメントとして最初にどの処理かを記述すること処理１
moodleにあるexcelデータ（exam.xlsx）を"data"オブジェクト に読み込み、内容をhead()で確認する処理２
６科目の得点の合計を計算し、これを新たに作るTotal列に追加する。
各々の合計をdataのTotal列に代入する。#合計点数の計算とTotal列への追加処理は次の通り
# apply()関数を使う
# dataオブジェクトの２列目から７列目のデータを行毎(2つ目の引数に1を指定)に合計sumし、totalへ代入する
#以下の４行のコードの通り実行すればよい
total <- apply(data[ ,2:7], 1, sum)
# totalの内容を確認
total
# mutate()関数により新たな列を作り、dataオブジェクトに追加する
data <- data %>% mutate(Total=total) #"Total"は列名をTotalとする指定、またそのTotalに"total"で数値を代入する
# dataの内容を確認する
head(data)
処理３
各々（６科目とTotalの７項目）について箱ひげ図を描画するためのオブジェクトを作成する
#Englishのみを描画する。この時点では他の科目は表示しない。
次に、日本語処理と平均値表示のための処理を、前に作ったオブジェクトに追加する
#そして、Englishのみを描画する。この時点では他の科目は表示しない。処理４
日本語処理と平均値表示を追加した図を１つの図(レイアウト表示)として描画する。
６科目は２列３行に、Totalは４行目にレイアウトする。
７つの図のレイアウトは次の通り。
1, 2
3, 4
5, 6
7, 7散布図による２科目の相関の把握
処理５
７項目の具体的な数値について男女別に「要約関数」により確認する。
例えば次のコードによりdataの男だけを抽出できる。
man <- data %>% subset(Sex=="男")
manに対して要約関数を適用すればよい。
同様に女だけのデータを抽出し要約関数を適用して確認すればよい。
次に、男女の区別なく全体に対して相関係数を「cor()関数」により調べる。
cor()関数の具体的なコードは次の通り。
cor(data[ ,2:8])
この確認内容については、確認結果をMoodleのQuizに入力すること（提出するhtmlファイルの対象ではない）。処理６
前の処理（cor（）関数の結果）で確認した、一番相関の高い２教科を選び、その散布図を描画する処理７
更に前の処理に対し、次のレイヤ処理を追加した図を表示する。
日本語処理 theme_bw(base_family="HiraKakuProN-W3")
回帰直線 geom_smooth(method="lm")
タイトル labs(title="情報と???の相関", subtitle="（相関係数 r=???）")
タイトルの位置と大きさ調整
theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5), text = element_text(size = 20)) （注意）本実行に必要なlibraryは次の通り
library(ggplot2) # ggplot()関数の利用
library(readxl) # excelデータの読込み read_xlsx()関数の利用
library(dplyr) # %>% パイプの利用
library(gridExtra) # レイアウト表示 grid.arrange()関数の利用以上は問題の説明
以下は各処理の実行結果（部分表示）
処理１
library(ggplot2) # ggplot()関数の利用
library(readxl) # excelデータの読込み read_xlsx()関数の利用## Warning: package 'readxl' was built under R version 3.4.4library(dplyr) # %>% パイプの利用## Warning: package 'dplyr' was built under R version 3.4.4##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(gridExtra) # レイアウト表示 grid.arrange()関数の利用##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinedata <- read_xlsx("exam.xlsx")
head(data)## # A tibble: 6 x 7
## Sex English History Japanese Information Science Mathematics
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 男 77 67 61 78 68 61
## 2 女 74 76 74 65 61 57
## 3 女 86 74 82 95 85 80
## 4 男 90 86 89 91 69 68
## 5 女 76 75 61 79 71 69
## 6 男 56 69 61 55 58 43処理２
#合計点数の列への追加
total <- apply(data[ ,2:7], 1, sum)
# dataの２列目から７列目のデータを行毎(1)に合計sumし、totalへ代入する
total## [1] 412 407 502 493 431 342 422 413 400 464 425 409 414 414 391 389 322
## [18] 358 466 406 410 386 401 382 402 345 439 435 342 380 410 386 429 402
## [35] 387 438 390 373 374 311# totalの内容を確認
# mutate()関数により新たな列を作り、dataに追加する
data <- data %>% mutate(Total=total) #"Total"で列名をTotalとする、"total"で数値を代入
head(data)## # A tibble: 6 x 8
## Sex English History Japanese Information Science Mathematics Total
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 男 77 67 61 78 68 61 412
## 2 女 74 76 74 65 61 57 407
## 3 女 86 74 82 95 85 80 502
## 4 男 90 86 89 91 69 68 493
## 5 女 76 75 61 79 71 69 431
## 6 男 56 69 61 55 58 43 342処理３
a <- data %>% ggplot(aes(x=Sex, y=English)) + geom_boxplot()
b <- data %>% ggplot(aes(x=Sex, y=History)) + geom_boxplot()
c <- data %>% ggplot(aes(x=Sex, y=Japanese)) + geom_boxplot()
d <- data %>% ggplot(aes(x=Sex, y=Information)) + geom_boxplot()
e <- data %>% ggplot(aes(x=Sex, y=Science)) + geom_boxplot()
f <- data %>% ggplot(aes(x=Sex, y=Mathematics)) + geom_boxplot()
g <- data %>% ggplot(aes(x=Sex, y=Total)) + geom_boxplot()
#Englishだけ箱ひげ図を描画する
a
#各々の図に次の処理を追加する
#日本語処理 theme_bw(base_family="HiraKakuProN-W3")
#平均値の追加 stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
#y軸表示の範囲を指定して表示を揃える ylim(40, 100) 使っていない
#横２列 grid.arrange(a, b, c, d, e, f, ncol=2) 使っていない
a1 <- a + theme_bw(base_family="HiraKakuProN-W3") + stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
b1 <- b + theme_bw(base_family="HiraKakuProN-W3") + stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
c1 <- c + theme_bw(base_family="HiraKakuProN-W3") + stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
d1 <- d + theme_bw(base_family="HiraKakuProN-W3") + stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
e1 <- e + theme_bw(base_family="HiraKakuProN-W3") + stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
f1 <- f + theme_bw(base_family="HiraKakuProN-W3") + stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
g1 <- g + theme_bw(base_family="HiraKakuProN-W3") + stat_summary(fun.y=mean, geom="point", shape=3, size=4, col="red")
a1
処理４
# 全ての図を１枚にレイアウトする
# Total だけは２列分とする
layout <- rbind(c(1, 2), c(3, 4), c(5, 6), c(7, 7))
grid.arrange(a1, b1, c1, d1, e1, f1, g1, layout_matrix=layout, top="6 subjects and total points")
処理５ （参考のため表示：提出ファイルにはこの部分は必要ない）
head(data) # dataの確認## # A tibble: 6 x 8
## Sex English History Japanese Information Science Mathematics Total
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 男 77 67 61 78 68 61 412
## 2 女 74 76 74 65 61 57 407
## 3 女 86 74 82 95 85 80 502
## 4 男 90 86 89 91 69 68 493
## 5 女 76 75 61 79 71 69 431
## 6 男 56 69 61 55 58 43 342male <- data %>% subset(Sex=="男")
female <- data %>% subset(Sex=="女")
summary(male) # 数値で確認## Sex English History Japanese
## Length:19 Min. :45.00 Min. :57.00 Min. :52.00
## Class :character 1st Qu.:66.00 1st Qu.:66.50 1st Qu.:58.00
## Mode :character Median :68.00 Median :71.00 Median :66.00
## Mean :67.26 Mean :71.68 Mean :68.42
## 3rd Qu.:70.50 3rd Qu.:79.00 3rd Qu.:79.00
## Max. :90.00 Max. :86.00 Max. :89.00
## Information Science Mathematics Total
## Min. :54.00 Min. :45.00 Min. :41.00 Min. :311.0
## 1st Qu.:59.50 1st Qu.:57.50 1st Qu.:46.50 1st Qu.:366.0
## Median :68.00 Median :67.00 Median :51.00 Median :400.0
## Mean :68.32 Mean :64.53 Mean :53.42 Mean :393.6
## 3rd Qu.:75.50 3rd Qu.:69.50 3rd Qu.:60.50 3rd Qu.:411.0
## Max. :91.00 Max. :83.00 Max. :68.00 Max. :493.0summary(female)## Sex English History Japanese
## Length:21 Min. :57.00 Min. :62.00 Min. :60.00
## Class :character 1st Qu.:64.00 1st Qu.:68.00 1st Qu.:68.00
## Mode :character Median :72.00 Median :75.00 Median :73.00
## Mean :70.52 Mean :73.67 Mean :71.76
## 3rd Qu.:76.00 3rd Qu.:79.00 3rd Qu.:76.00
## Max. :86.00 Max. :84.00 Max. :82.00
## Information Science Mathematics Total
## Min. :49 Min. :50.00 Min. :38.00 Min. :345.0
## 1st Qu.:65 1st Qu.:61.00 1st Qu.:46.00 1st Qu.:386.0
## Median :72 Median :66.00 Median :57.00 Median :409.0
## Mean :73 Mean :66.33 Mean :55.33 Mean :410.6
## 3rd Qu.:79 3rd Qu.:72.00 3rd Qu.:64.00 3rd Qu.:425.0
## Max. :95 Max. :85.00 Max. :80.00 Max. :502.0cor(data[ ,2:8]) # 各々の教科の相関係数を表示## English History Japanese Information Science
## English 1.0000000 0.4926505 0.530452462 0.5308303 0.4690630
## History 0.4926505 1.0000000 0.732840764 0.1542325 0.1260787
## Japanese 0.5304525 0.7328408 1.000000000 0.2414032 0.1371395
## Information 0.5308303 0.1542325 0.241403204 1.0000000 0.7771941
## Science 0.4690630 0.1260787 0.137139457 0.7771941 1.0000000
## Mathematics 0.3621577 0.0163803 0.003885084 0.8164998 0.6918550
## Total 0.7819100 0.5340811 0.581654031 0.8604219 0.7762452
## Mathematics Total
## English 0.362157714 0.7819100
## History 0.016380298 0.5340811
## Japanese 0.003885084 0.5816540
## Information 0.816499800 0.8604219
## Science 0.691855030 0.7762452
## Mathematics 1.000000000 0.7164314
## Total 0.716431406 1.0000000# １番相関の高い２つの教科を選ぶ
# 結果は、情報と数学処理６
# x軸とy軸のラベル表示を意図的に消している（Informationとどの科目が一番相関が高いかを隠すため）
# 皆さんの回答では表示させること（特別な処理をしなければ表示される）fig <- data %>% ggplot(aes(x=Mathematics, y=Information)) + geom_point() + theme(axis.title.x = element_blank(), axis.title.y = element_blank())
# 日本語処理 theme_bw(base_family="HiraKakuProN-W3")
# 回帰直線 geom_smooth(method="lm")
# タイトル labs(title="情報と数学の相関")
# タイトルの位置と大きさ調整 theme(plot.title = element_text(hjust = 0.5), text = element_text(size = 20))
# ラベルの消去 theme(axis.title.x = element_blank(), axis.title.y = element_blank())
fig
処理７
## 情報と"???"の???には処理５で確認した教科名を日本語で記述すること
## 相関係数 r=??? の???には、処理５においてcor()関数により調べた両者の相関係数を記述することfig1 <- fig + geom_smooth(method="lm") + labs(title="情報と数学の相関", subtitle="（相関係数 r=0.8164998）") + theme_bw(base_family="HiraKakuProN-W3") + theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5), text = element_text(size = 20)) + theme(axis.title.x = element_blank(), axis.title.y = element_blank())
fig1 