Summer loss exercise

作者

日本大学経済学部教育心理学研究室

公開

2026年9月22日

library(googlesheets4)
library(dplyr)
library(psych)

1 Summer loss

現在の米国の学校暦は,9か月の通学期間と3か月の夏季休業からなる。この形が成立したのは20世紀初頭である。それ以前,農村部の学校は播種から収穫までの労働力を確保するために年5〜6か月しか開かれず,一方で都市部の学校は年11〜12か月制で運営されていた。学年別に標準化されたカリキュラムが導入されると,児童が学校で過ごす時間も標準化する圧力が生じ,両者の折衷として9か月制が規範となった。当時,米国人の85%が農業に従事していたが,今日その割合は約3%にすぎない。それにもかかわらず,学校暦は変わっていない。1980年代以降,この暦を見直す議論が再燃し,年間の授業日数そのものを増やす案と,日数は変えずに休みを分散させる通年制(year-round schooling)とが提起された。いずれの案の推進者も,3か月という長い中断が指導のリズムを断ち切って忘却を招き,秋には旧課程の復習に相当の時間を費やさざるをえないと主張した。さらに,この中断の影響は子どもによって一様ではないという懸念も示された。すなわち,家庭の社会経済的地位が高い児童は夏のあいだも学校外で学習の機会を得られる一方,そうでない児童はその機会に乏しく,結果として秋の時点の学力差が拡大するのではないか,というものである。

1.1 Cooper et al. (1996)

この研究は,夏季休業が学力に及ぼす影響を検討したメタ分析である。13研究,66研究サンプル,総対象者数47994人を対象とし,夏休みの前後の学力検査得点の平均値差を標準偏差を単位として比較した。

夏季休業の効果を正確に推定するには,終業日と始業日に検査を実施すればよい。しかし,そのように実施された研究は存在しない。実際には,春と秋の検査の間に,終業前と始業後の授業日が入り込む。Figure 1 は,この状況を仮想的に示したものである。破線は実際の変化であり,夏季休業中に得点が低下している。ところが春の検査を終業の3週間前に,秋の検査を始業の3週間後に実施すると,2時点を結ぶ線は上昇し,見かけ上は夏季休業をはさんで学力が伸びたように観測される。測定区間に含まれる授業日が多いほど,このずれは大きくなる。実際,メタ分析の対象となった標本の春秋間隔は平均131日であり,少なくとも5週分の授業日を含むと推定される。したがって,以下に示す結果は,夏季休業の影響を過小に見積もった値と考えられる。

Figure 1 春から秋への測定区間と,夏季休業をはさんだ学力の変化(仮想例)(Cooper et al. (1996) より作図)

Figure 2 に,重み付き効果量 \(d\) を示す。負の値は,秋の得点が春の得点を下回ることを意味する。全体では \(d = -.13\) であり,秋の得点は春より0.13標準偏差低い。ただし,この値は教科によって大きく異なる。数学(\(d = -.18\))と読解・言語(\(d = -.15\))はいずれも低下するが,下位領域まで下げると差は大きい。とりわけ計算(\(d = -.32\))と綴り(\(d = -.41\))で損失が突出する一方,数学の応用(\(d = +.17\))や語彙(\(d = +.12\))はむしろ上昇している。家庭の所得水準による違いは読解に現れる。中所得層が \(d = +.06\) とわずかに上昇するのに対し,低所得層は \(d = -.21\) と低下する。すなわち,夏季休業をはさんで両者の差は拡大する。

Figure 2 夏季休業をはさんだ学力検査得点の変化,重み付き効果量 \(d\)(Cooper et al. (1996) より作図)

Figure 3 に,読解の相対的な学力について,学年別の効果量 \(d\) を示す。1年生と2年生は \(d = +.04\) とわずかに上昇し,3年生ではほぼ変化がない(\(d = -.02\))。4年生以降は一貫して低下し,その程度は学年が上がるにつれて大きくなる。8年生では \(d = -.21\) に達する。4年生以降の値はいずれも統計的に有意である。すなわち,夏季休業の影響は年少の児童ほど小さく,学年が進むほど大きくなる。

Figure 3 学年別にみた,夏季休業をはさんだ読解の変化,重み付き効果量 \(d\)(Cooper et al. (1996) より作図)

2 データの分析

2.1 データの読み込み

gs4_deauth()   # 認証をスキップ。これがないとレンダリング時に止まる
data.s <- read_sheet("https://docs.google.com/spreadsheets/d/1rduoSDr4yy8Fk_DD04HPS0zSO3Tq1SmCn3TSO5wwGtA/edit?usp=sharing")
data.p <- read_sheet("https://docs.google.com/spreadsheets/d/1rTYDR8EjCwVAxPsn1NS1z8Pqtz1L3c2J0PBiBraD3UE/edit?usp=sharing")
data.c <- read_sheet("https://docs.google.com/spreadsheets/d/1pK1iyA3qNI2obdajp36b1165g9TZWPaF2zEpnA3CyNk/edit?usp=sharing")

2.2 データの結合

data.s$route <- "s"
data.p$route <- "p"
data.c$route <- "c"

data.spc <- dplyr::bind_rows(data.s, data.p, data.c)
write.csv(data.spc, "data_spc.csv")

2.3 変数の置き換え

2.3.1 現状の変数名の表示

names(data.spc)
 [1] "タイムスタンプ"                                                                                                                                                                                                                                                     
 [2] "学年と学部を教えてください。"                                                                                                                                                                                                                                       
 [3] "夏休み期間(2025年8月1日〜2025年9月22日)について、1日あたり平均してどのくらい勉強しましたか。最も近いものを1つ選んでください。\nここでの「勉強」とは、大学の授業・課題、ゼミでの研究や課題、資格取得のための学習、予備校・講座の受講など、すべての学習を含みます。"
 [4] "夏休み期間(2025年8月1日〜2025年9月22日)にゼミ合宿に行きましたか。あてはまるものを選んでください。"                                                                                                                                                                
 [5] "勉強と遊びの,どちらにあてた時間が多かったですか。もっともあてはまるものを選んでください。"                                                                                                                                                                         
 [6] "夏休み期間(2025年8月1日〜2025年9月22日)について、1日あたり平均してどのくらいアルバイトをしましたか。最も近いものを1つ選んでください。(業務内容は問いません)"                                                                                                    
 [7] "夏休み期間(2025年8月1日〜2025年9月22日)について、旅行や帰省をしましたか。もっともあてはまるものを1つ選んでください。"                                                                                                                                             
 [8] "夏休み期間 (2025年8月1日〜2025年9月22日)  の旅行や帰省の合計日数を教えてください。最も当てはまるものを選んでください。"                                                                                                                                           
 [9] "夏休み期間(2025年8月1日〜2025年9月22日)について、1日あたり平均してどのくらい娯楽や趣味に時間を当てましたか。最も近いものを1つ選んでください。"                                                                                                                    
[10] "2025年度前期のGPAを教えてください。(半角数字 小数点2ケタまで)"                                                                                                                                                                                                   
[11] "2025年度後期のGPAを教えてください。(半角数字 小数点2ケタまで)"                                                                                                                                                                                                   
[12] "route"                                                                                                                                                                                                                                                              

2.3.2 変数名の置き換え

library(dplyr)

data.spc <- data.spc %>%
  rename_with(~ c("timestamp", "grade", "benkyo", "labcamp", "lc.b.p",
                  "parttime", "trip", "trip.days", "hobby",
                  "gpa.fs", "gpa.ss", "route"))

2.3.3 変数の置き換え

[2] 学年と学部を教えてください。

data.spc <- data.spc %>%
  mutate(grade = case_match(grade,
                            "経済学部2年" ~ 2,
                            "経済学部3年" ~ 3,
                            .default = NA_real_))

[3] 夏休み期間(2025年8月1日〜2025年9月22日)について、1日あたり平均してどのくらい勉強しましたか。最も近いものを1つ選んでください。ここでの「勉強」とは、大学の授業・課題、ゼミでの研究や課題、資格取得のための学習、予備校・講座の受講など、すべての学習を含みます。

data.spc <- data.spc %>%
  mutate(benkyo = case_match(benkyo,
                             "0時間(ほとんどしなかった)" ~ 0,
                             "1時間未満"          ~ 0.5,
                             "1時間以上2時間未満" ~ 1.5,
                             "2時間以上3時間未満" ~ 2.5,
                             "3時間以上4時間未満" ~ 3.5,
                             "4時間以上5時間未満" ~ 4.5,
                             "5時間以上6時間未満" ~ 5.5,
                             "6時間以上7時間未満" ~ 6.5,
                             "7時間以上8時間未満" ~ 7.5,
                             "8時間以上"          ~ 8.5,
                             .default = NA_real_))

[4] 夏休み期間(2025年8月1日〜2025年9月22日)にゼミ合宿に行きましたか。あてはまるものを選んでください。

data.spc <- data.spc %>%
  mutate(labcamp = case_match(labcamp,
                              "1泊2日で行った"     ~ 1,
                              "2泊3日で行った"     ~ 2,
                              "3泊4日以上で行った" ~ 3,
                              "行っていない・ゼミに入っていない" ~ 0,
                              .default = NA_real_),
         labcamp.d = if_else(labcamp > 0, 1, 0)) # ゼミ合宿に行ったかどうかの変数

[5] ゼミ合宿では,勉強と遊びの,どちらにあてた時間が多かったですか。もっともあてはまるものを選んでください。

data.spc <- data.spc %>%
  mutate(lc.b.p = case_match(lc.b.p,
                             "勉強にあてた時間の方が多い"         ~ 1,
                             "勉強と遊びの割合はどちらもほぼ同じ" ~ 2,
                             "遊びにあてた時間の方が多い"         ~ 3,
                             .default = NA_real_))

[6] 夏休み期間(2025年8月1日〜2025年9月22日)について、1日あたり平均してどのくらいアルバイトをしましたか。最も近いものを1つ選んでください。(業務内容は問いません)

data.spc <- data.spc %>%
  mutate(parttime = case_match(parttime,
                               "0時間(ほとんどしなかった)" ~ 0,
                               "1時間未満"          ~ 0.5,
                               "1時間以上2時間未満" ~ 1.5,
                               "2時間以上3時間未満" ~ 2.5,
                               "3時間以上4時間未満" ~ 3.5,
                               "4時間以上5時間未満" ~ 4.5,
                               "5時間以上6時間未満" ~ 5.5,
                               "6時間以上7時間未満" ~ 6.5,
                               "7時間以上8時間未満" ~ 7.5,
                               "8時間以上"          ~ 8.5,
                               .default = NA_real_))

[7] 夏休み期間(2025年8月1日〜2025年9月22日)について、旅行や帰省をしましたか。もっともあてはまるものを1つ選んでください。

data.spc <- data.spc %>%
  mutate(trip = case_match(trip,
                           "した"             ~ 1,
                           "していない(0日)" ~ 0,
                           .default = NA_real_))

[8] 夏休み期間 (2025年8月1日〜2025年9月22日)の旅行や帰省の合計日数を教えてください。最も当てはまるものを選んでください。

data.spc <- data.spc %>%
  mutate(trip.days = case_match(trip.days,
                                "1日~3日"   ~ 2,
                                "4日~6日"   ~ 5,
                                "7日~9日"   ~ 8,
                                "10日~12日" ~ 11,
                                "13日~15日" ~ 14,
                                "16日以上"  ~ 17,
                                .default = NA_real_),
         trip.days = if_else(trip == 0, 0, trip.days))

[9] 夏休み期間(2025年8月1日〜2025年9月22日)について、1日あたり平均してどのくらい娯楽や趣味に時間を当てましたか。最も近いものを1つ選んでください。

data.spc <- data.spc %>%
  mutate(hobby = case_match(hobby,
                            "0時間(ほとんどしなかった)" ~ 0,
                            "1時間未満"          ~ 0.5,
                            "1時間以上2時間未満" ~ 1.5,
                            "2時間以上3時間未満" ~ 2.5,
                            "3時間以上4時間未満" ~ 3.5,
                            "4時間以上5時間未満" ~ 4.5,
                            "5時間以上6時間未満" ~ 5.5,
                            "6時間以上7時間未満" ~ 6.5,
                            "7時間以上8時間未満" ~ 7.5,
                            "8時間以上"          ~ 8.5,
                            .default = NA_real_))

[10] 2025年度前期のGPAを教えてください。(半角数字 小数点2ケタまで)

  • ここは数値のまま扱う

[11] 2025年度後期のGPAを教えてください。(半角数字 小数点2ケタまで)

  • ここは数値のまま扱う

2.3.4 変数置き換えの確認

describe(data.spc)
          vars  n mean   sd median trimmed  mad min   max range  skew kurtosis
timestamp    1 61  NaN   NA     NA     NaN   NA Inf  -Inf  -Inf    NA       NA
grade        2 52 2.69 0.47   3.00    2.74 0.00   2  3.00  1.00 -0.81    -1.37
benkyo       3 61 1.12 1.69   0.50    0.74 0.74   0  8.50  8.50  2.33     5.93
labcamp      4 61 0.70 1.07   0.00    0.51 0.00   0  3.00  3.00  1.08    -0.44
lc.b.p       5 21 2.38 0.80   3.00    2.47 0.00   1  3.00  2.00 -0.73    -1.14
parttime     6 61 4.07 2.51   4.50    4.06 2.97   0  8.50  8.50 -0.15    -0.96
trip         7 61 0.82 0.39   1.00    0.90 0.00   0  1.00  1.00 -1.62     0.64
trip.days    8 61 6.51 5.05   5.00    6.02 4.45   0 17.00 17.00  0.61    -0.40
hobby        9 61 5.36 2.56   5.50    5.46 4.45   0  8.50  8.50 -0.06    -1.39
gpa.fs      10 61 2.25 0.93   2.30    2.32 0.89   0  4.50  4.50 -0.60     0.41
gpa.ss      11 61 2.26 0.87   2.43    2.34 0.73   0  3.75  3.75 -0.89     0.43
route*      12 61 2.41 0.76   3.00    2.51 0.00   1  3.00  2.00 -0.82    -0.84
labcamp.d   13 61 0.34 0.48   0.00    0.31 0.00   0  1.00  1.00  0.64    -1.62
            se
timestamp   NA
grade     0.06
benkyo    0.22
labcamp   0.14
lc.b.p    0.18
parttime  0.32
trip      0.05
trip.days 0.65
hobby     0.33
gpa.fs    0.12
gpa.ss    0.11
route*    0.10
labcamp.d 0.06

2.3.5 対象外データの除去

経済学部の2, 3年生以外は除去

data.23 <- data.spc %>% dplyr::filter(grade %in% c(2, 3))
write.csv(data.23, "data_23.csv")

GPAが 0 は除外

data.23 <- data.23 %>% filter(gpa.fs != 0, gpa.ss != 0)

外れ値を除外

# 勉強,アルバイト,趣味の合計時間を算出する
data.23 <- data.23 %>%
  mutate(total = benkyo + parttime + hobby)
# 合計が16時間を超えるデータを除外する
data.23 <- data.23 %>% filter(total <= 16)

2.4 モデルの分析

2.4.1 3年生に限定する

data.3 <- data.23 %>% dplyr::filter(grade == 3)
write.csv(data.3, "data_3.csv")

2.4.2 データの状況を見る

2.4.2.1 スパゲッティプロット

n <- nrow(data.3)

# 枠だけ作る(type = "n" で何も描かない)
plot(NULL, xlim = c(0.8, 2.2), ylim = range(c(data.3$gpa.fs, data.3$gpa.ss)),
     xaxt = "n", xlab = "", ylab = "GPA", bty = "l")
axis(1, at = c(1, 2), labels = c("前期", "後期"))

# 個人ごとの線
for (i in seq_len(n)) {
  lines(c(1, 2), c(data.3$gpa.fs[i], data.3$gpa.ss[i]),
        col = rgb(0, 0, 0, 0.3))
  points(c(1, 2), c(data.3$gpa.fs[i], data.3$gpa.ss[i]),
         pch = 16, cex = 0.6, col = rgb(0, 0, 0, 0.3))
}

# 平均の線を重ねる
m <- c(mean(data.3$gpa.fs), mean(data.3$gpa.ss))
lines(c(1, 2), m, lwd = 2.5)
points(c(1, 2), m, pch = 16, cex = 1.4)

2.4.2.2 前期GPA,後期GPA,GPAの差分との相関

GPAの差分の変数を作る

data.3$gpa.diff <- data.3$gpa.ss - data.3$gpa.fs
2.4.2.2.1 1日あたり学習時間
# 相関係数(欠測があればペアワイズで除外)
r.fs   <- cor(data.3$benkyo, data.3$gpa.fs,   use = "complete.obs")
r.ss   <- cor(data.3$benkyo, data.3$gpa.ss,   use = "complete.obs")
r.diff <- cor(data.3$benkyo, data.3$gpa.diff, use = "complete.obs")

# 1行3列
par(mfrow = c(1, 3), mar = c(4.5, 4.5, 3, 1))

plot(data.3$benkyo, data.3$gpa.fs,
     xlab = "勉強時間(時間/日)", ylab = "前期GPA",
     main = sprintf("r = %.2f", r.fs),
     pch = 16, col = rgb(0, 0, 0, 0.6), bty = "l")
abline(lm(gpa.fs ~ benkyo, data = data.3), lwd = 2)

plot(data.3$benkyo, data.3$gpa.ss,
     xlab = "勉強時間(時間/日)", ylab = "後期GPA",
     main = sprintf("r = %.2f", r.ss),
     pch = 16, col = rgb(0, 0, 0, 0.6), bty = "l")
abline(lm(gpa.ss ~ benkyo, data = data.3), lwd = 2)

plot(data.3$benkyo, data.3$gpa.diff,
     xlab = "勉強時間(時間/日)", ylab = "GPAの差分(後期−前期)",
     main = sprintf("r = %.2f", r.diff),
     pch = 16, col = rgb(0, 0, 0, 0.6), bty = "l")
abline(lm(gpa.diff ~ benkyo, data = data.3), lwd = 2)

#abline(h = 0, lty = 3)   # 変化なしの基準線

par(mfrow = c(1, 1))
2.4.2.2.2 同じような処理をするので関数にまとめる
plot3 <- function(x, xlab, data = data.3) {
  v <- data[[x]]
  ys   <- c("gpa.fs", "gpa.ss", "gpa.diff")
  ylab <- c("前期GPA", "後期GPA", "GPAの差分(後期−前期)")
  par(mfrow = c(1, 3), mar = c(4.5, 4.5, 3, 1))
  for (i in seq_along(ys)) {
    y <- data[[ys[i]]]
    r <- cor(v, y, use = "complete.obs")
    plot(v, y, xlab = xlab, ylab = ylab[i],
         main = sprintf("r = %.2f (n = %d)", r, sum(complete.cases(v, y))),
         pch = 16, col = rgb(0, 0, 0, 0.6), bty = "l")
    abline(lm(y ~ v), lwd = 2)
  }
  par(mfrow = c(1, 1))
}
2.4.2.2.3 1日あたりアルバイト時間
plot3("parttime", "アルバイト時間(時間/日)")

2.4.2.2.4 1日あたり趣味娯楽時間
plot3("hobby", "趣味・娯楽時間(時間/日)")

2.4.2.2.5 旅行
2.4.2.2.5.1 旅行の有無
g   <- factor(data.3$trip, levels = c(0, 1), labels = c("なし", "あり"))
ys   <- c("gpa.fs", "gpa.ss", "gpa.diff")
ylab <- c("前期GPA", "後期GPA", "GPAの差分(後期−前期)")

par(mfrow = c(1, 3), mar = c(4.5, 4.5, 3, 1))
for (i in seq_along(ys)) {
  y  <- data.3[[ys[i]]]
  tt <- t.test(y ~ g)
  boxplot(y ~ g, xlab = "旅行・帰省", ylab = ylab[i],
          main = sprintf("t = %.2f, p = %.3f", tt$statistic, tt$p.value),
          bty = "l")
  points(jitter(as.numeric(g), 0.6), y, pch = 16, cex = 0.7,
         col = rgb(0, 0, 0, 0.4))
}

par(mfrow = c(1, 1))
#table(g)
2.4.2.2.5.2 旅行なしを含めた相関
plot3("trip.days", "旅行・帰省日数(日)")

2.4.2.2.5.3 旅行なしを除いた相関
plot3("trip.days", "旅行・帰省日数(日)", data = subset(data.3, trip == 1))

2.4.2.2.6 ゼミ合宿
2.4.2.2.6.1 行った or 行っていない
g    <- factor(data.3$labcamp.d, levels = c(0, 1), labels = c("なし", "あり"))
ys   <- c("gpa.fs", "gpa.ss", "gpa.diff")
ylab <- c("前期GPA", "後期GPA", "GPAの差分(後期−前期)")

par(mfrow = c(1, 3), mar = c(4.5, 4.5, 3, 1))
for (i in seq_along(ys)) {
  y  <- data.3[[ys[i]]]
  tt <- t.test(y ~ g)
  boxplot(y ~ g, xlab = "ゼミ合宿", ylab = ylab[i],
          main = sprintf("t = %.2f, p = %.3f", tt$statistic, tt$p.value),
          bty = "l")
  points(jitter(as.numeric(g), 0.6), y, pch = 16, cex = 0.7,
         col = rgb(0, 0, 0, 0.4))
}

par(mfrow = c(1, 1))
2.4.2.2.6.2 宿泊数
g <- factor(data.3$labcamp, levels = 0:3,
            labels = c("行かず", "1泊", "2泊", "3泊+"))

par(mfrow = c(1, 3), mar = c(4.5, 4.5, 3, 1))
for (i in seq_along(ys)) {
  y  <- data.3[[ys[i]]]
  av <- summary(aov(y ~ g))[[1]]
  boxplot(y ~ g, xlab = "ゼミ合宿の宿泊数", ylab = ylab[i],
          main = sprintf("F = %.2f, p = %.3f", av[["F value"]][1], av[["Pr(>F)"]][1]),
          bty = "l")
  points(jitter(as.numeric(g), 0.6), y, pch = 16, cex = 0.7,
         col = rgb(0, 0, 0, 0.4))
}

par(mfrow = c(1, 1))
2.4.2.2.6.3 ゼミ合宿での勉強と遊びの割合
d <- subset(data.3, !is.na(lc.b.p))
g <- factor(d$lc.b.p, levels = 1:3,
            labels = c("勉強寄り", "同程度", "遊び寄り"))

ys   <- c("gpa.fs", "gpa.ss", "gpa.diff")
ylab <- c("前期GPA", "後期GPA", "GPAの差分(後期−前期)")

par(mfrow = c(1, 3), mar = c(4.5, 4.5, 3, 1))
for (i in seq_along(ys)) {
  y  <- d[[ys[i]]]
  av <- summary(aov(y ~ g))[[1]]
  boxplot(y ~ g, xlab = "合宿での時間配分", ylab = ylab[i],
          main = sprintf("F = %.2f, p = %.3f, n = %d",
                         av[["F value"]][1], av[["Pr(>F)"]][1], length(y)),
          bty = "l")
  points(jitter(as.numeric(g), 0.6), y, pch = 16, cex = 0.7,
         col = rgb(0, 0, 0, 0.4))
}

par(mfrow = c(1, 1))

2.4.3 前期GPAだけで後期GPAを予測

fit0 <- lm(gpa.ss ~ gpa.fs, data = data.3)
summary(fit0)

Call:
lm(formula = gpa.ss ~ gpa.fs, data = data.3)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.70767 -0.15663  0.01847  0.15440  0.77847 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.81113    0.23610   3.436   0.0017 ** 
gpa.fs       0.70816    0.09491   7.462 2.09e-08 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.321 on 31 degrees of freedom
Multiple R-squared:  0.6423,    Adjusted R-squared:  0.6308 
F-statistic: 55.67 on 1 and 31 DF,  p-value: 2.092e-08

2.4.3.1 散布図と回帰直線

plot(data.3$gpa.fs, data.3$gpa.ss,
     xlab = "前期GPA", ylab = "後期GPA",
     xlim = c(1, 4), ylim = c(1, 4),
     pch = 16, col = rgb(0, 0, 0, 0.6), bty = "l")

abline(fit0, lwd = 2)

xs <- seq(1, 4, length.out = 100)
pr <- predict(fit0, newdata = data.frame(gpa.fs = xs), interval = "confidence")
lines(xs, pr[, "lwr"], lty = 3)
lines(xs, pr[, "upr"], lty = 3)

2.4.3.2 回帰分析をする

data.3 <- data.3 %>%
  mutate(labcamp.d = if_else(labcamp > 0, 1, 0),
         lc.b.p.c  = lc.b.p - 2)   # 1,2,3 → -1,0,1

fit1 <- lm(gpa.ss ~ gpa.fs + benkyo + labcamp.d + parttime + trip + hobby,
           data = data.3)
summary(fit1)

Call:
lm(formula = gpa.ss ~ gpa.fs + benkyo + labcamp.d + parttime + 
    trip + hobby, data = data.3)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.65884 -0.15534  0.05907  0.17933  0.56348 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.57181    0.39690   1.441    0.162    
gpa.fs       0.69876    0.10582   6.603 5.29e-07 ***
benkyo       0.06064    0.07306   0.830    0.414    
labcamp.d    0.14707    0.11725   1.254    0.221    
parttime     0.03041    0.02899   1.049    0.304    
trip        -0.11319    0.21018  -0.539    0.595    
hobby        0.02073    0.02533   0.819    0.420    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.3278 on 26 degrees of freedom
Multiple R-squared:  0.6872,    Adjusted R-squared:  0.6151 
F-statistic: 9.522 on 6 and 26 DF,  p-value: 1.45e-05

2.4.4 ゼミ合宿モデルにする

data.3 <- data.3 %>%
  mutate(g3 = case_when(labcamp.d == 0 ~ "行かず",
                        lc.b.p == 3    ~ "遊び寄り",
                        TRUE           ~ "勉強・半々"))
fit2 <- lm(gpa.ss ~ gpa.fs + g3, data = data.3)
summary(fit2)

Call:
lm(formula = gpa.ss ~ gpa.fs + g3, data = data.3)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.64591 -0.13906  0.00126  0.21282  0.72630 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.87516    0.29102   3.007   0.0054 ** 
gpa.fs       0.72194    0.10015   7.208 6.17e-08 ***
g3行かず    -0.16894    0.15486  -1.091   0.2843    
g3遊び寄り  -0.04633    0.16933  -0.274   0.7863    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.3232 on 29 degrees of freedom
Multiple R-squared:  0.6609,    Adjusted R-squared:  0.6258 
F-statistic: 18.84 on 3 and 29 DF,  p-value: 5.647e-07

2.4.5 ぼーっと過ごすモデル

fit3 <- lm(gpa.ss ~ gpa.fs + total, data = data.23)
summary(fit3)

Call:
lm(formula = gpa.ss ~ gpa.fs + total, data = data.23)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.91341 -0.22601  0.07326  0.20609  0.84558 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 0.449641   0.276727   1.625    0.111    
gpa.fs      0.797116   0.082073   9.712 1.63e-12 ***
total       0.004964   0.018905   0.263    0.794    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.377 on 44 degrees of freedom
Multiple R-squared:  0.6823,    Adjusted R-squared:  0.6679 
F-statistic: 47.26 on 2 and 44 DF,  p-value: 1.105e-11

3 引用文献

Cooper, H., Nye, B., Charlton, K., Lindsay, J., & Greathouse, S. (1996). The Effects of Summer Vacation on Achievement Test Scores: A Narrative and Meta-Analytic Review. Review of Educational Research, 66(3), 227–268. https://doi.org/10.3102/00346543066003227.