```{r setup, echo=FALSE}
knitr::opts_chunk$set(echo = TRUE,
                      message = FALSE,
                      warning = FALSE)
```

# 3.1 英国におけるEU国民投票

---

## 2016年 Brexit国民投票

* 2016年、英国(UK)でEU離脱の是非を問う国民投票が実施された（Brexit）。
* 英国選挙調査(BES)は、有権者の意識を調査するために大規模な社会調査を実施。
* **目標**: 母集団（全有権者）の離脱支持率を推定し、支持者の特徴（学歴、年齢など）を明らかにする。

# 3.2 社会調査研究

---

## 標本と母集団

* **母集団** (Population): 調査対象となる集団全体。観察数を $N$ で表す。
* **標本** (Sample): 母集団から選ばれた個人の部分集合. 観察数を $n$ で表す。
* **代表的な標本** (Representative sample): 母集団の特徴を正確に反映している標本。
* **無作為抽出** (Random sampling): 母集団から無作為に標本を選ぶことで、平均的に母集団を代表することを保証する。

---

## 潜在的な問題点

1. **抽出枠の不備**: 母集団のリスト（抽出枠）が不完全。
2. **全項目無回答**: 調査参加の拒否。
3. **一部項目無回答**: 特定の質問への回答拒否。
4. **誤った申告**: 社会的に望ましい回答をするなどの虚偽報告。

# 3.3 Brexitへの支持の測定

---

## BES データの読み込み (1)

* 有権者の意識調査データをRに読み込みます。

\scriptsize
```{r}
# 1. ローカルに保存したBESデータの読み込み（推奨）
bes <- read.csv("BES.csv")

# （参考）URLから直接読み込むことも可能
# bes <- read.csv("https://ayumu-tanaka.github.io/QSS/DSS_Data/BES.csv")
```
\normalsize

---

## データの確認 (2)

\scriptsize
```{r}
# 1. データの最初の数行を表示
head(bes)

# 2. 標本サイズの確認
dim(bes)
```
\normalsize

---

## 度数表と比率表

* `table()` で各カテゴリの回答数をカウントする。
* `prop.table()` で比率（割合）に変換する。

```{r}
# 回答の度数表
table(bes$vote)

# 回答の比率表
prop.table(table(bes$vote))
```

# 3.4 Brexitを支持したのは誰？

---

## 欠損データの処理 (1)

* Rでは欠損値を `NA` で表す。

```{r}
# 欠損値を含む教育水準の確認
table(bes$education, exclude = NULL)
```

---

## 欠損データの処理 (2)

* `mean()` などの関数では、`na.rm = TRUE` を指定してNAを除外する必要がある。
* `na.omit()` は、NAを含む行をすべて削除する。

```{r}
# NAを除外して平均を計算
mean(bes$leave, na.rm = TRUE)

# NAを含む行を削除した新しいデータフレーム作成
bes1 <- na.omit(bes)
```

---

## 二元度数表

* 2つの変数の関係を「クロス集計表」で確認する。

```{r}
# 離脱支持(leave)と教育水準(education)の二元度数表
table(bes1$leave, bes1$education)
```

---

## 二元比率表

* 行ごとの比率を確認する。

\footnotesize

```{r}
# 行ごとの比率 (margin = 1)
prop.table(table(bes1$leave, bes1$education), margin = 1)
```

\normalsize

---

## ヒストグラム（度数と密度）

* `hist()` で数値変数の分布を視覚化する。
* `freq = FALSE` で密度ヒストグラム（面積の合計が1）を作成できる。

```{r, fig.height=3.5, out.height="40%", fig.align="center"}
# 年齢のヒストグラム（離脱支持者のみ）
hist(bes1$age[bes1$leave == 1], 
     main = "Supporters Age", xlab = "Age")
```

---

## 記述統計量

* 分布の中心（平均値、中央値）とばらつき（標準偏差、分散）を計算する。

```{r}
# 離脱支持者の平均年齢
mean(bes1$age[bes1$leave == 1])

# 離脱支持者の年齢の中央値
median(bes1$age[bes1$leave == 1])

# 標準偏差
sd(bes1$age[bes1$leave == 1])
```

# 3.5 教育と離脱派票との関係

---

## UK_districts データの読み込み (1)

* 地区レベルのデータを読み込み、欠損値を除外します。

\scriptsize
```{r}
# 1. ローカルに保存したデータの読み込み（推奨）
dis <- read.csv("UK_districts.csv")

# （参考）URLから直接読み込むことも可能
# dis <- read.csv("https://ayumu-tanaka.github.io/QSS/DSS_Data/UK_districts.csv")

# 2. NAを除外
dis1 <- na.omit(dis)
```
\normalsize

---

## データの構造確認 (2)

\scriptsize
```{r}
# 最初の数行を表示
head(dis1)
```
\normalsize

---

## 散布図

* `plot()` で2つの数値変数の関係をプロットする。
* `abline()` で平均値を示す直線などを追加できる。

\footnotesize
```{r, fig.height=3.5, out.height="40%", fig.align="center"}
plot(dis1$high_education, dis1$leave, 
     xlab = "High Education (%)", 
     ylab = "Leave Vote (%)")
abline(v = mean(dis1$high_education), lty = "dashed")
abline(h = mean(dis1$leave), lty = "dashed")
```

\normalsize

---

## 相関

* `cor()` で2つの変数の間の線形関係の強さと方向を数値化する（-1から1の間）。

```{r}
# 高学歴率と離脱派得票率の相関
cor(dis1$high_education, dis1$leave)
```

* **解釈**: 強い負の相関がある。教育水準が高い地区ほど、離脱派の得票率が低い傾向にある。

# 3.6 まとめ

---

## 第3章のまとめ

* **測定**: 母集団を代表する標本を用いて、関心のある数量を推定する。
* **無作為抽出**: 推論の妥当性を高めるための基本的な手法。
* **データの要約と視覚化**:
    * 度数表、比率表、クロス表。
    * ヒストグラム、散布図。
    * 平均、中央値、標準偏差、相関係数。
* **Rの操作**: `table()`, `prop.table()`, `na.omit()`, `hist()`, `plot()`, `cor()` を学んだ。
