```{r global_options, include=FALSE}
knitr::opts_chunk$set(eval = TRUE, results = FALSE, fig.show = "hide", message = FALSE)
```

## 教授の評価


多くの大学のコースでは、コースとインストラクターを匿名で評価する機会を学生に与えることで締めくくられます。
しかし、これらの学生評価をコースの質と教育効果の指標として使用することには、これらの測定値がインストラクターの身体的魅力など、教育に関係のない特性の影響を反映する可能性があるため、しばしば批判されます。
HamermeshとParkerによる「教室の美しさ：インストラクターの美貌と想定される教育生産性」というタイトルの記事は、見栄えの良い教師が高い教育評価を受けることを発見しました。

ここでは、肯定的な教授の評価に何が影響するかを学ぶために、この研究のデータを分析します。

## はじめに

### パッケージの読み込み


このラボでは、**tidyverse** スイートのパッケージを使用してデータを探索および視覚化します。
また、一度に多くの変数を視覚化するために**GGally**パッケージを使用し、回帰出力を整理するために**broom**パッケージを使用します。
データはOpenIntroリソースのコンパニオンパッケージ**openintro**で見つけることができます。

パッケージを読み込みましょう。

```{r load-packages, message=FALSE}
library(tidyverse)
library(openintro)
library(GGally)
library(broom)
```


**GGally**パッケージを使用するのは初めてです。
このラボの後半で、このパッケージの`ggpairs()`関数を使用します。

### 再現可能なラボレポートの作成


新しいラボレポートを作成するには、RStudioで「New File」->「R Markdown...」に移動し、「From Template」を選択してから、テンプレートのリストから「Lab Report for OpenIntro Statistics Labs」を選択します。

### データ


このデータは、テキサス大学オースティン校の多数の教授に対する学期末の学生評価から収集されました。
さらに、6人の学生が教授の身体的魅力の評価を行いました。
その結果、各行が異なるコースを含み、列がコースと教授に関する変数を表すデータフレームが得られました。
これは`evals`と呼ばれます。

```{r}
glimpse(evals)
```


21種類の異なる変数に関する観測値があり、そのうちいくつかはカテゴリカル変数で、いくつかは数値変数です。
各変数の意味は、ヘルプファイルを表示することで確認できます。

```{r help-evals}
?evals
```

## データ探索

1.  これは観察研究ですか、それとも実験ですか？
    論文で提起された元の研究課題は、美しさがコース評価の違いに直接つながるかどうかです。
    研究デザインを考慮すると、この質問をそのままの形で答えることは可能ですか？
    可能でない場合、質問を言い換えてください。

2.  `score`の分布を記述してください。
    分布は歪んでいますか？
    それは学生がコースをどのように評価するかについて何を示唆していますか？
    これは予想通りでしたか？
    なぜそう思いますか？

3.  `score`を除外し、他の2つの変数を選択し、適切な視覚化を使用してそれらの相互関係を記述してください。

## 単純線形回帰


この研究が示唆する基本的な現象は、見栄えの良い教師の方が好意的に評価されるということです。
これが当てはまるかどうかを確認するために散布図を作成してみましょう。

```{r scatter-score-bty_avg}
ggplot(data = evals, aes(x = bty_avg, y = score)) +
  geom_point()
```


トレンドについて結論を出す前に、データフレーム内の観測数と散布図上の点の概数を比較してください。
何かおかしいことはありますか？

4.  散布図を再プロットしてください。ただし、今回はレイヤーとして`geom_jitter`を使用してください。最初の散布図はどのような点で誤解を招くものでしたか？

```{r scatter-score-bty_avg-jitter}
ggplot(data = evals, aes(x = bty_avg, y = score)) +
  geom_jitter()
```

5.  プロットの明らかな傾向が自然な変動以上のものかどうかを見てみましょう。平均的な美しさの評価によって平均的な教授のスコアを予測する`m_bty`という線形モデルを適合させてください。線形モデルの式を記述し、傾きを解釈してください。平均的な美しさのスコアは統計的に有意な予測因子ですか？それは実用的に有意な予測因子であるように見えますか？


以下のコードを使用して、適合したモデルの線をプロットに追加してください。

```{r scatter-score-bty_avg-line-se}
ggplot(data = evals, aes(x = bty_avg, y = score)) +
  geom_jitter() +
  geom_smooth(method = "lm")
```


青い線はモデルです。
線の周りの陰影のある灰色領域は、予測で期待される変動性を示しています。
これをオフにするには、`se = FALSE`を使用します。

```{r scatter-score-bty_avg-line}
ggplot(data = evals, aes(x = bty_avg, y = score)) +
  geom_jitter() +
  geom_smooth(method = "lm", se = FALSE)
```

6.  残差プロットを使用して、最小二乗回帰の条件が妥当であるかどうかを評価してください。
    それぞれのプロットとコメントを提供してください（これらの作成方法については単純回帰ラボを参照してください）。

## 重回帰分析


データセットには、教授の美しさのスコアに関するいくつかの変数が含まれています。教授の身体的魅力を評価するように依頼された6人の学生からの個別の評価と、これらの6つのスコアの平均です。
これらのスコアの1つと平均的な美しさのスコアとの関係を見てみましょう。

```{r bty-rel}
ggplot(data = evals, aes(x = bty_f1lower, y = bty_avg)) +
  geom_point()

evals |>
  summarise(cor(bty_avg, bty_f1lower))
```


予想通り、関係は非常に強いです。結局のところ、平均スコアは個々のスコアを使用して計算されます。
実際、以下のコマンドを使用して、すべての美しさの変数（13列目から19列目）間の関係を見ることができます。

```{r bty-rels}
evals |>
  select(contains("bty")) |>
  ggpairs()
```


これらの変数は共線性（相関）があり、これらの変数を複数モデルに追加してもモデルに大きな価値は追加されません。
このアプリケーションでは、これらの高度に相関する予測変数を使用する場合、平均的な美しさのスコアをこれらの変数の単一の代表として使用することは合理的です。

教授の性別を考慮した後も、美しさが教授のスコアの有意な予測因子であるかどうかを確認するために、性別項をモデルに追加できます。

```{r scatter-score-bty_avg_pic-color}
m_bty_gen <- lm(score ~ bty_avg + gender, data = evals)
tidy(m_bty_gen)
```

7.  p値とパラメータ推定値は、回帰の条件が妥当である場合にのみ信頼できます。
    診断プロットを使用して、このモデルの条件が妥当であることを確認してください。

8.  `bty_avg`は依然として`score`の有意な予測因子ですか？
    モデルに`gender`を追加したことで、`bty_avg`のパラメータ推定値は変化しましたか？


`gender`の推定値が`gendermale`になっていることに注目してください。
カテゴリカル変数を導入するたびにこの名前の変更が見られます。
その理由は、Rが`gender`を`male`と`female`の値から、女性教授の場合は0、男性教授の場合は1を取る`gendermale`というインジケーター変数に再コード化するためです。
（このような変数は「ダミー」変数と呼ばれることがよくあります。）

その結果、女性教授の場合、パラメータ推定値はゼロで乗算され、単純回帰でおなじみの切片と傾きの形式が残ります。

$$
  \begin{aligned}
\widehat{score} &= \hat{\beta}_0 + \hat{\beta}_1 \times bty\_avg + \hat{\beta}_2 \times (0) \\
&= \hat{\beta}_0 + \hat{\beta}_1 \times bty\_avg
\end{aligned}
$$

9.  男性教授に対応する線の式は何ですか？（*ヒント：*男性教授の場合、パラメータ推定値は1で乗算されます。）同じ美しさの評価を受けた2人の教授について、どちらの性別がより高いコース評価スコアを得る傾向がありますか？


インジケーター変数を`genderfemale`ではなく`gendermale`と呼ぶ決定に深い意味はありません。
Rは単にアルファベット順で最初に来るカテゴリを0としてコード化するだけです。
（カテゴリカル変数の参照レベル、つまり0としてコード化されるレベルは、`relevel()`関数を使用して変更できます。
詳細については`?relevel`を使用してください。）

10. `gender`を削除し、`rank`を追加した`m_bty_rank`という新しいモデルを作成してください。Rは2つ以上のレベルを持つカテゴリカル変数をどのように処理すると思われますか？`rank`変数には`teaching`、`tenure track`、`tenured`の3つのレベルがあることに注意してください。


重回帰における係数の解釈は、単純回帰とはわずかに異なります。
`bty_avg`の推定値は、*他のすべての変数を一定に保ちながら*、美しさの評価が1点高い教授のグループがどれだけ高いスコアを期待されるかを示しています。
この場合、これは、`bty_avg`スコアが1点異なる同じランクの教授のみを考慮することに相当します。

## 最良モデルの探索


ランク、性別、民族性、学位を取得した大学の言語、年齢、評価を記入した学生の割合、クラスサイズ、コースレベル、教授の数、単位数、および平均的な美しさの評価に基づいて教授のスコアを予測する完全なモデルから始めます。

11. このモデルで最も高いp値を持つと予想される変数はどれですか？なぜですか？
    *ヒント：*教授のスコアと関連がないと予想される変数はどれかを考えてください。


モデルを実行しましょう...

```{r m_full, tidy = FALSE}
m_full <- lm(score ~ rank + gender + ethnicity + language + age + cls_perc_eval
             + cls_students + cls_level + cls_profs + cls_credits + bty_avg, data = evals)
tidy(m_full)
```

12. 前の演習でのあなたの疑念を確認してください。
    回答にはモデルの出力を含めてください。

13. 民族性変数に関連する係数を解釈してください。

14. 一度に1つの変数を削除し、調整済み$R^2$を見てください。
    どの変数を削除すると調整済み$R^2$が最も増加しますか？
    最も高いp値を持つ変数を削除して、モデルを再適合させてください。
    この変数を削除したことで、他の説明変数の係数と有意性は変化しましたか？
    （重回帰を興味深いものにしていることの1つは、係数推定値がモデルに含まれる他の変数に依存することです。）そうでない場合、これは削除された変数が他の説明変数と共線性があったかどうかについて何を述べていますか？

15. 後退選択法と調整済み$R^2$を選択基準として使用して、最良のモデルを決定してください。
    回答にすべての手順を示す必要はなく、最終モデルの出力のみで構いません。
    また、最終的に決定したモデルに基づいてスコアを予測するための線形モデルを記述してください。

16. 診断プロットを使用して、このモデルの条件が妥当であることを確認してください。

17. 元の論文では、テキサス大学オースティン校の教授のサンプルを取り、彼らが教えてきたすべてのコースを含めることによってこれらのデータがどのように収集されたかを説明しています。
    各行がコースを表すことを考慮すると、この新しい情報が線形回帰のいずれかの条件に影響を与える可能性がありますか？

18. 最終モデルに基づいて、テキサス大学オースティン校の教授とコースの特徴で、高い評価スコアと関連付けられるものを記述してください。

19. あなたの結論を一般的に（どの大学の教授にも）適用することに抵抗はありませんか？
    なぜですか？

## 参考文献

------------------------------------------------------------------------

<a rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/">![Creative Commons License](https://i.creativecommons.org/l/by-sa/4.0/88x31.png){style="border-width:0"}</a><br />この作品は、<a rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/">クリエイティブ・コモンズ 表示 - 継承 4.0 国際ライセンス</a>の下で提供されています。
