---
title: "Logistic Regression"
subtitle: "FMB819: R을 이용한 데이터분석"
author: "고려대학교 경영대학 정지웅"
format: 
  revealjs:
    theme: simple
    transition: fade
    transition-speed: fast
    scrollable: true
    chalkboard: true
    slide-number: true
revealjs-plugins:
  - revealjs-text-resizer
---

```{r setup, include=FALSE, warning=FALSE, message=FALSE}
options(htmltools.dir.version = FALSE)
knitr::opts_chunk$set(
  message = FALSE,
  warning = FALSE,
  dev = "svg",
  cache = TRUE,
  fig.align = "center",
  comment = "##"
)

library("tidyverse")

if (requireNamespace("kableExtra", quietly = TRUE)) library("kableExtra")

if (requireNamespace("countdown", quietly = TRUE)) {
  library(countdown)
  countdown(
    color_border              = "#d90502",
    color_text                = "black",
    color_running_background  = "#d90502",
    color_running_text        = "white",
    color_finished_background = "white",
    color_finished_text       = "#d90502",
    color_finished_border     = "#d90502"
  )
} else {
  countdown <- function(minutes = 0, top = 0, ...) paste0("[Timer: ", minutes, " min]")
}

if (!requireNamespace("ISLR2", quietly = TRUE)) install.packages("ISLR2")
library(ISLR2)
data(Default)
```

## Today's Agenda

-   ***로지스틱 회귀(Logistic Regression)*** 의 필요성과 직관적 이해

-   **오즈(Odds)**, **오즈비(OR)**, **한계 효과(Marginal Effect)**: 계수 해석 방법

-   실증 분석: 신용카드 채무 불이행(Default) 예측

-   **예측 확률** 계산 및 **모형 적합도** 평가

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

## 왜 로지스틱 회귀인가?

-   지금까지는 연속형 종속변수 $y$를 다루었음: 수익률, 매출, 가격 등

-   현실에서는 **Yes/No 이진 결과**에 관심을 갖는 경우가 많음:

    -   대출 채무 불이행 여부 (**default** vs. **non-default**)
    -   고객 이탈 여부 (**이탈** vs. **유지**)
    -   M&A 성사 여부 (**성공** vs. **실패**)

-   $y_i \in \{0, 1\}$ 인 경우, OLS를 그대로 쓰면 문제가 생김 → 왜?

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

## 분석 예제: 신용카드 채무 불이행

-   `ISLR2` 패키지의 `Default` 데이터셋: 10,000명의 신용카드 고객

    | 변수      | 설명                            |
    |-----------|---------------------------------|
    | `default` | 채무 불이행 여부 (`Yes` / `No`) |
    | `student` | 학생 여부 (`Yes` / `No`)        |
    | `balance` | 평균 신용카드 잔액 (달러)       |
    | `income`  | 연간 소득 (달러)                |

-   **핵심 질문**: 신용카드 잔액(`balance`)으로 채무 불이행을 예측할 수 있는가?

```{r, echo=TRUE}
data(Default)
Default |> count(default)
```

-   채무 불이행자(`Yes`)는 전체의 약 **3.3%** — 대부분은 정상 고객

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

## 채무 불이행자의 분포

::::: columns
::: {.column width="50%"}
```{r, echo=FALSE, fig.height=6}
Default |>
  ggplot(aes(x = balance, y = income, color = default)) +
  geom_point(alpha = 0.4, size = 1.2) +
  scale_color_manual(values = c("No" = "gray70", "Yes" = "#d90502")) +
  labs(title = "Who defaults?",
       x = "Balance ($)", y = "Income ($)", color = "Default") +
  theme_bw(base_size = 16) +
  theme(legend.position = "top")
```
:::

::: {.column width="50%"}
```{r, echo=FALSE, fig.height=6}
Default |>
  ggplot(aes(x = default, y = balance, fill = default)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_manual(values = c("No" = "gray70", "Yes" = "#d90502")) +
  labs(title = "Balance by Default status",
       x = "Default", y = "Balance ($)") +
  theme_bw(base_size = 16) +
  theme(legend.position = "none")
```
:::
:::::

-   채무 불이행자는 **잔액이 높은** 경향이 있음 → `balance`가 유용한 예측변수일 것

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

## OLS를 그대로 쓰면? (선형 확률 모형)

```{r, echo=FALSE, fig.height=4.5, fig.width=10}
df <- Default |> mutate(default_num = as.integer(default == "Yes"))

p1 <- ggplot(df, aes(x = balance, y = default_num)) +
  geom_point(alpha = 0.08, color = "#d90502", size = 1.5) +
  geom_smooth(method = "lm", se = FALSE, color = "steelblue", linewidth = 1.2) +
  geom_hline(yintercept = c(0, 1), linetype = "dashed", color = "gray40") +
  annotate("text", x = 2700, y = -0.08, label = "Prob < 0!",
           color = "#d90502", size = 4, fontface = "bold") +
  labs(x = "Balance ($)", y = "Default (0 = No, 1 = Yes)",
       title = "OLS: predictions can fall outside [0, 1]") +
  theme_bw(base_size = 14)

p2 <- ggplot(df, aes(x = balance, y = default_num)) +
  geom_point(alpha = 0.08, color = "#d90502", size = 1.5) +
  geom_smooth(method = "glm", method.args = list(family = "binomial"),
              se = FALSE, color = "steelblue", linewidth = 1.2) +
  geom_hline(yintercept = c(0, 1), linetype = "dashed", color = "gray40") +
  labs(x = "Balance ($)", y = "Pr(Default = Yes)",
       title = "Logistic: always between (0, 1)") +
  theme_bw(base_size = 14)

library(patchwork)
p1 + p2
```

-   **OLS 문제**: 잔액이 매우 낮으면 **확률이 음수**로 예측됨
-   **해결책**: 어떤 $x$ 값에서도 항상 $(0,1)$ 사이 값을 출력하는 함수 필요

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

## 로지스틱 함수: S자 곡선

임의의 실수 $z$를 항상 $(0, 1)$ 사이로 압축하는 함수:

$$\sigma(z) = \frac{e^z}{1 + e^z}$$

```{r, echo=FALSE, fig.height=4, fig.width=10}
tibble(z = seq(-6, 6, length.out = 300)) |>
  mutate(sigma = 1 / (1 + exp(-z))) |>
  ggplot(aes(x = z, y = sigma)) +
  geom_line(color = "#d90502", linewidth = 1.5) +
  geom_hline(yintercept = c(0, 1), linetype = "dashed", color = "gray50") +
  geom_hline(yintercept = 0.5, linetype = "dotted", color = "steelblue") +
  geom_vline(xintercept = 0, linetype = "dotted", color = "steelblue") +
  annotate("text", x = 4, y = 0.55, label = "z = 0 → σ = 0.5", 
           color = "steelblue", size = 4) +
  annotate("text", x = 4.5, y = 0.92, label = "z → +∞ → σ → 1", 
           color = "gray40", size = 3.5) +
  annotate("text", x = 4.5, y = 0.08, label = "z → -∞ → σ → 0", 
           color = "gray40", size = 3.5) +
  labs(x = "z (Linear Predictor)", y = "σ(z)", title = "Logistic (Sigmoid) Function") +
  scale_y_continuous(breaks = c(0, 0.25, 0.5, 0.75, 1)) +
  theme_bw(base_size = 14)
```

**직관**: 선형 예측자 $z = b_0 + b_1 x$가 아무리 크거나 작아도,  
로지스틱 함수를 거치면 **반드시 0과 1 사이**로 나옴

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

## 로지스틱 회귀 모형

선형 예측자 $z_i = b_0 + b_1 x_i$를 로지스틱 함수에 통과:

$$\Pr(\text{default}_i = 1 \mid \text{balance}_i) = \frac{e^{b_0 + b_1 \cdot \text{balance}_i}}{1 + e^{b_0 + b_1 \cdot \text{balance}_i}}$$

```{r, echo=FALSE, fig.height=3.5, fig.width=10}
df <- Default |> mutate(default_num = as.integer(default == "Yes"))

ggplot(df, aes(x = balance, y = default_num)) +
  geom_point(alpha = 0.08, color = "#d90502", size = 1.5) +
  geom_smooth(method = "glm", method.args = list(family = "binomial"),
              se = TRUE, color = "steelblue", linewidth = 1.2) +
  labs(x = "Balance ($)", y = "Pr(Default = Yes)",
       title = "Logistic Regression: S-curve fits the data well") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme_bw(base_size = 14)
```

-   잔액이 낮으면 불이행 확률 ≈ 0%, 높으면 ≈ 100%
-   중간 구간에서 확률이 **S자 형태**로 가파르게 증가

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

## 오즈(Odds)

**오즈(Odds)**: 사건이 일어날 확률 vs. 일어나지 않을 확률의 비율

$$\text{Odds} = \frac{p}{1-p}$$

| 확률 $p$ | 오즈 | 직관적 표현 |
|:--------:|:----:|:------------|
| 0.10 | 0.11 | 9번 중 1번 성공 |
| 0.50 | 1.00 | 반반 |
| 0.75 | 3.00 | 3:1 (이길 가능성이 질 가능성의 3배) |
| 0.90 | 9.00 | 9:1 |

-   **역변환**: 오즈 → 확률: $\quad p = \dfrac{\text{Odds}}{1 + \text{Odds}}$

-   예: 오즈 = 3 → $p = \frac{3}{4} = 0.75$

. . .

**왜 오즈를 쓰는가?** 확률은 0\~1로 제한되지만,  
오즈는 0\~∞ → 로그 오즈는 -∞\~+∞ → **선형 모형에 적합**

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

## 로그 오즈와 로지스틱 회귀의 연결

$$\underbrace{p}_{\text{확률 }(0,1)} \xrightarrow{\div(1-p)} \underbrace{\frac{p}{1-p}}_{\text{오즈 }(0,\infty)} \xrightarrow{\log} \underbrace{\log\frac{p}{1-p}}_{\text{로그오즈 }(-\infty,+\infty)}$$

로지스틱 회귀는 **로그 오즈**를 선형 함수로 모형화:

$$\log\left(\frac{p_i}{1-p_i}\right) = b_0 + b_1 x_i$$

양변을 $p_i$에 대해 풀면 → 로지스틱 함수가 자연스럽게 등장:

$$p_i = \frac{e^{b_0 + b_1 x_i}}{1 + e^{b_0 + b_1 x_i}}$$

> 즉, 로지스틱 회귀 = "**로그 오즈를 $x$로 예측하는 선형 모형**"

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

## R에서 로지스틱 회귀: `glm()`

```{r, echo=TRUE, eval=FALSE}
# lm() 대신 glm()을 사용, family = binomial 지정
glm(종속변수 ~ 독립변수, data = 데이터, family = binomial)
```

-   `family = binomial`: 종속변수가 이진형임을 지정 → 자동으로 **logit 링크** 사용

```{r, echo=TRUE}
logit_fit <- glm(default ~ balance, data = Default, family = binomial)
broom::tidy(logit_fit)
```

**계수 읽기:**

-   `(Intercept)` = $b_0 = -10.65$: balance = 0일 때 로그오즈
-   `balance` = $b_1 = 0.0055$: balance가 $1 증가할 때 로그오즈 변화

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

## 계수 해석 방법 1: 로그오즈

> $b_1 = 0.0055$: balance가 **\$1 증가**할 때, 채무불이행 **로그오즈가 0.0055 증가**

-   $b_1 > 0$ → balance ↑ 이면 불이행 확률 ↑ (방향 파악)
-   로그오즈는 직관적이지 않음 → **오즈비**로 변환하면 더 이해하기 쉬움

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

## 계수 해석 방법 2: 오즈비 (OR)

**오즈비(OR)**: $x$가 1단위 증가할 때 오즈의 **배율 변화**

$$\text{OR} = e^{b_1}$$

**왜 $e^{b_1}$인가?**

$$\log\text{Odds}(x+1) - \log\text{Odds}(x) = b_1 \quad\Rightarrow\quad \frac{\text{Odds}(x+1)}{\text{Odds}(x)} = e^{b_1}$$

```{r, echo=TRUE}
exp(coef(logit_fit))          # OR
exp(confint(logit_fit))       # 95% CI for OR
```

**해석**: $\text{OR} = e^{0.0055} \approx 1.0055$  
→ balance \$1 증가 시 채무불이행 오즈가 **0.55% 증가**  
→ balance **\$1,000** 증가 시: $e^{0.0055 \times 1000} \approx 241$ → 오즈가 **241배** 증가

> ⚠️ OR은 **오즈의 배율**이지, **확률의 변화**가 아님

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

## 계수 해석 방법 3: 한계 효과 (Marginal Effect)

**한계 효과(Marginal Effect)**: $x$가 1단위 증가할 때 **확률의 변화량** ($\Delta p$)

$$\frac{\partial p}{\partial x} = b_1 \cdot p(1-p)$$

-   OLS의 계수 해석과 가장 유사
-   $p(1-p)$가 곱해지므로 → **기준 확률($p_0$)에 따라 값이 달라짐**

**두 가지 방법:**

| 방법 | 설명 | 언제 사용 |
|:-----|:-----|:---------|
| **AME** (Average Marginal Effect) | 모든 관측치에서 ME 계산 후 평균 | 전체 평균 효과를 보고 싶을 때 |
| **MEM** (Marginal Effect at Mean) | 평균값($\bar{x}$)에서 ME 계산 | 대표적인 고객에서의 효과 |

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

## 한계 효과: R로 계산하기

**방법 1: `margins` 패키지 (AME)**

```{r, echo=TRUE}
if (!requireNamespace("margins", quietly = TRUE)) install.packages("margins")
library(margins)

# Average Marginal Effect
ame <- margins(logit_fit)
summary(ame)
```

→ balance \$1 증가 시 채무불이행 확률이 평균적으로 약 **0.012%p 증가**

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

## 한계 효과: R로 계산하기 (계속)

**방법 2: 직접 계산 (수식 이용)**

$$\text{ME} = b_1 \times \hat{p} \times (1 - \hat{p})$$

```{r, echo=TRUE}
b1    <- coef(logit_fit)["balance"]

# MEM: 평균 잔액에서의 한계 효과
p_mean <- predict(logit_fit,
                  newdata = data.frame(balance = mean(Default$balance)),
                  type = "response")
ME_mean <- b1 * p_mean * (1 - p_mean)
cat("MEM:", round(ME_mean * 100, 4), "%p per $1 increase in balance\n")

# AME: 각 관측치에서 계산 후 평균
p_all <- predict(logit_fit, type = "response")
ME_all <- b1 * p_all * (1 - p_all)
cat("AME:", round(mean(ME_all) * 100, 4), "%p per $1 increase in balance\n")
```

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

## 한계 효과: 기준 확률에 따라 달라진다

```{r, echo=FALSE, fig.height=4.5, fig.width=10}
b1_val <- coef(logit_fit)["balance"]
tibble(p0 = seq(0.001, 0.999, by = 0.001)) |>
  mutate(ME = b1_val * p0 * (1 - p0)) |>
  ggplot(aes(x = p0, y = ME * 100)) +
  geom_line(color = "#d90502", linewidth = 1.5) +
  geom_vline(xintercept = mean(predict(logit_fit, type = "response")),
             linetype = "dashed", color = "steelblue") +
  annotate("text",
           x = mean(predict(logit_fit, type = "response")) + 0.05,
           y = 0.08,
           label = paste0("Sample avg p\n= ",
                          round(mean(predict(logit_fit, type="response"))*100, 1), "%"),
           color = "steelblue", size = 3.8, hjust = 0) +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(x = "Baseline probability p0",
       y = "Marginal Effect (%p per $1)",
       title = "Marginal Effect of balance: varies with baseline probability",
       subtitle = "ME is largest when p0 = 50%, smallest near 0% or 100%") +
  theme_bw(base_size = 14)
```

-   ME는 $p_0 = 0.5$에서 최대, 양 극단에서 0에 수렴
-   표본 평균 불이행률(≈3.3%)에서 ME가 매우 작음 → **AME가 작게 나오는 이유**

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

## 세 가지 해석 방법 비교

| 방법 | 계산 | 해석 | 특징 |
|:-----|:-----|:-----|:-----|
| **로그오즈** | $b_1$ | balance $1 증가 → 로그오즈 0.0055 증가 | 직관적이지 않음 |
| **오즈비(OR)** | $e^{b_1}$ | balance $1 증가 → 오즈 1.0055배 | 배율로 표현, 기준 확률 불필요 |
| **한계 효과(ME)** | $b_1 \cdot p(1-p)$ | balance $1 증가 → 확률 0.012%p 증가 | OLS와 유사, 기준 확률 필요 |


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

## 추정 결과 해석: 3단계 적용

```{r, echo=FALSE}
logit_fit <- glm(default ~ balance, data = Default, family = binomial)
coef_df <- broom::tidy(logit_fit)
knitr::kable(coef_df, digits = 5) |>
  kableExtra::kable_styling(bootstrap_options = "striped", font_size = 18)
```

**`balance` 계수 ($\hat{b}_1 \approx 0.00550$) 3단계 해석:**

**Step 1 — 방향**: $b_1 > 0$ → balance 증가 → 채무불이행 확률 **증가**

**Step 2 — 오즈비**: $\text{OR} = e^{0.00550} \approx 1.0055$ → \$1 증가마다 오즈 **0.55% 증가**

**Step 3 — 한계 효과 (AME)**: `margins(logit_fit)` → balance \$1 증가 시 확률 약 **0.012%p 증가**  
($1,000 증가 시 → 약 **+12%p**, 단 기준 확률에 따라 달라짐)

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

## 예측 확률 계산

-   `predict(..., type = "response")`: 확률 스케일로 예측

```{r, echo=TRUE}
# balance = $1,000 vs $2,000
predict(logit_fit,
        newdata = data.frame(balance = c(1000, 2000)),
        type = "response")
```

-   **잔액이 두 배**라고 확률이 두 배가 되지 않음 → **비선형**

```{r, echo=FALSE, fig.height=3.5, fig.width=10}
pred_df <- tibble(balance = seq(0, 3000, by = 10)) |>
  mutate(prob = predict(logit_fit, newdata = pick(everything()), type = "response"))

ggplot(pred_df, aes(x = balance, y = prob)) +
  geom_line(color = "#d90502", linewidth = 1.5) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray40") +
  geom_vline(xintercept = c(1000, 2000), linetype = "dotted", color = "steelblue") +
  annotate("text", x = 1000, y = 0.55, label = "$1,000\n≈5%", color="steelblue", size=3.5) +
  annotate("text", x = 2000, y = 0.65, label = "$2,000\n≈59%", color="steelblue", size=3.5) +
  labs(x = "Balance ($)", y = "Pr(Default = Yes)") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme_bw(base_size = 14)
```

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

## Task 1 {background-color="#ffebf0"}

`r countdown(minutes = 8, top = "20px", right = "10px", font_size = "0.8em")`

아래 코드를 순서대로 실행하며 결과를 확인해보자.

**Step 1.** OLS와 로지스틱 회귀를 각각 추정:

```{r, echo=TRUE, eval=FALSE}
df <- Default |> mutate(default_num = as.integer(default == "Yes"))
ols_fit   <- lm(default_num ~ balance, data = df)
logit_fit <- glm(default ~ balance, data = Default, family = binomial)
```

**Step 2.** balance = \$500과 \$2,500에서 두 모형의 예측값을 비교:

```{r, echo=TRUE, eval=FALSE}
predict(ols_fit,   newdata = data.frame(balance = c(500, 2500)))
predict(logit_fit, newdata = data.frame(balance = c(500, 2500)), type = "response")
```

→ OLS 예측값이 이상한 이유는? 어떤 값이 나오는가?

**Step 3.** `student` 변수만으로 로지스틱 회귀 추정 후 오즈비 계산:

```{r, echo=TRUE, eval=FALSE}
logit_s <- glm(default ~ student, data = Default, family = binomial)
broom::tidy(logit_s)       # 계수 확인
exp(coef(logit_s))         # 오즈비: 학생이면 오즈가 몇 배?
```

→ 학생이면 채무불이행 오즈가 몇 배 높은가? 계수의 부호는 무엇을 의미하는가?

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

## 다중 로지스틱 회귀

여러 독립변수를 동시에 포함:

$$\log\left(\frac{p_i}{1-p_i}\right) = b_0 + b_1 \cdot \text{balance}_i + b_2 \cdot \text{income}_i + b_3 \cdot \text{student}_i$$

```{r, echo=TRUE}
logit_multi <- glm(default ~ balance + income + student,
                   data = Default, family = binomial)
broom::tidy(logit_multi) |>
  mutate(OR = exp(estimate)) |>
  select(term, estimate, OR, p.value)
```

-   각 계수: **다른 변수들을 통제한 후** 해당 변수의 로그오즈 변화

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

## 다중 회귀: 교란변수(OVB) 사례

::::: columns
::: {.column width="50%"}
**단변수 회귀 (student만)**

```{r, echo=FALSE}
logit_s <- glm(default ~ student, data = Default, family = binomial)
broom::tidy(logit_s) |>
  select(term, estimate, p.value) |>
  knitr::kable(digits = 4) |>
  kableExtra::kable_styling(font_size = 18)
```

$b_\text{student} > 0$ → 학생 = 불이행 확률 **높음** ❓
:::

::: {.column width="50%"}
**다중 회귀 (balance, income, student)**

```{r, echo=FALSE}
broom::tidy(logit_multi) |>
  select(term, estimate, p.value) |>
  knitr::kable(digits = 4) |>
  kableExtra::kable_styling(font_size = 18)
```

$b_\text{student} < 0$ → 학생 = 불이행 확률 **낮음** ✅
:::
:::::

**왜 방향이 바뀌었는가?**  
학생은 잔액(`balance`)이 높은 경향 → 단변수 회귀에서 `balance` 효과가 `student`에 섞임  
→ `balance`를 통제하면 진짜 `student` 효과가 드러남

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

## 모형 적합도 ①: 혼동 행렬

```{r, echo=TRUE}
pred_prob  <- predict(logit_multi, type = "response")
pred_class <- ifelse(pred_prob > 0.5, "Yes", "No")
cm <- table(Predicted = pred_class, Actual = Default$default)
cm
```

```{r, echo=FALSE, fig.height=3, fig.width=8}
cm_df <- as.data.frame(cm)
ggplot(cm_df, aes(x = Actual, y = Predicted, fill = Freq)) +
  geom_tile(color = "white", linewidth = 1.5) +
  geom_text(aes(label = Freq), size = 8, fontface = "bold") +
  scale_fill_gradient(low = "white", high = "#d90502") +
  labs(title = "Confusion Matrix (threshold = 0.5)") +
  theme_bw(base_size = 14) +
  theme(legend.position = "none")
```

| 지표 | 계산 | 의미 |
|:-----|:-----|:-----|
| **정확도(Accuracy)** | (TP+TN) / 전체 | 전체 중 올바르게 분류된 비율 |
| **민감도(Sensitivity)** | TP / 실제 Yes | 실제 불이행자 중 잡아낸 비율 |
| **특이도(Specificity)** | TN / 실제 No | 정상 고객을 정상으로 분류한 비율 |

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

## 모형 적합도 ②: Pseudo $R^2$

**우도(Likelihood)**: "이 모형이 맞다면, 관측된 데이터가 나올 확률"

-   10명 중 3명이 불이행 → 그 3명에게 높은 확률, 7명에게 낮은 확률 예측할수록 우도 ↑
-   로그 우도(log-likelihood)는 항상 **음수**, 0에 가까울수록 좋음

**McFadden's Pseudo $R^2$**:

$$R^2_{\text{McFadden}} = 1 - \frac{\log L(\hat{M})}{\log L(M_0)}$$

| 상황 | $\log L(M_0)$ | $\log L(\hat{M})$ | 비율 | $R^2$ |
|:-----|:-------------:|:-----------------:|:----:|:-----:|
| 개선 없음 | -100 | -100 | 1.00 | **0** |
| 절반 개선 | -100 | -50 | 0.50 | **0.5** |
| 완벽한 모형 | -100 | ≈ 0 | ≈ 0 | **≈ 1** |

```{r, echo=TRUE}
logit_null <- glm(default ~ 1, data = Default, family = binomial)
1 - logLik(logit_multi) / logLik(logit_null)
```

통상 **0.2 ~ 0.4이면 양호**

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

## Task 2 {background-color="#ffebf0"}

`r countdown(minutes = 10, top = "20px", right = "10px", font_size = "0.8em")`

`logit_multi` (balance + income + student 모형)를 사용하자.

**Step 1.** 오즈비와 95% CI 계산:

```{r, echo=TRUE, eval=FALSE}
exp(coef(logit_multi))       # 오즈비
exp(confint(logit_multi))    # 95% CI
```

→ `balance` OR을 해석하시오. OR = 1보다 크면 어떤 의미인가?

**Step 2.** 다음 두 고객의 채무불이행 확률을 예측:

```{r, echo=TRUE, eval=FALSE}
new_data <- data.frame(
  student = c("Yes", "No"),
  balance = c(1500, 1500),
  income  = c(40000, 40000)
)
predict(logit_multi, newdata = new_data, type = "response")
```

→ 학생과 비학생의 확률 차이는? 그 차이의 방향이 Task 1의 단변수 결과와 다른 이유는?

**Step 3.** AME 계산:

```{r, echo=TRUE, eval=FALSE}
library(margins)
summary(margins(logit_multi))
```

→ `balance`의 AME를 해석하시오. OR 해석과 어떻게 다른가?

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

## 임계값(Threshold)의 선택

로지스틱 회귀는 확률을 예측함. **Yes/No로 분류**하려면 기준선(threshold)이 필요.

**threshold를 바꾸면:**

| threshold | 결과 | Trade-off |
|:---------:|:-----|:---------|
| **낮게** (예: 0.1) | 조금만 의심스러워도 Yes | 불이행자를 많이 잡지만, 정상 고객도 많이 오분류 |
| **높게** (예: 0.9) | 거의 확실할 때만 Yes | 정상 고객 보호, 하지만 실제 불이행자를 많이 놓침 |

→ **민감도** ↑ 이면 **특이도** ↓ (항상 trade-off)

**실무 판단**: 어떤 오류가 더 비용이 큰가?

-   불이행자를 놓치는 것 (False Negative) vs. 정상 고객을 의심하는 것 (False Positive)
-   신용카드사 → False Negative 비용이 큼 → **threshold를 낮게** 설정

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

## ROC 곡선

Threshold 하나를 고르면 민감도와 특이도가 하나씩 결정됨.  
ROC 곡선은 **모든 threshold에서의 (민감도, 특이도) 쌍**을 한 번에 시각화한 것.

**이상적인 분류기의 두 가지 목표:**

| 목표 | 의미 | 그래프 방향 |
|:-----|:-----|:----------:|
| 민감도 = 1 | 실제 불이행자를 **하나도 놓치지 않음** | y축 = 1 (위) |
| 1-특이도 = 0 | 정상 고객을 **하나도 오분류하지 않음** | x축 = 0 (왼쪽) |

→ 두 목표를 동시에 달성하는 점 = **(0, 1) 왼쪽 위 꼭짓점**  
→ 곡선이 왼쪽 위에 가까울수록 **모든 threshold에서 성능이 좋은** 모형

. . .

**세 가지 극단적 상황:**

| 상황 | ROC 위치 | AUC |
|:-----|:--------:|:---:|
| 완벽한 모형 | 왼쪽 위 꼭짓점 (0, 1)을 지남 | **1.0** |
| 동전 던지기 | 대각선 (점선) 위에 위치 | **0.5** |
| 최악의 모형 | 오른쪽 아래 (대각선 아래) | **< 0.5** |

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

## ROC 곡선: threshold 이동의 효과

**threshold를 낮추면** (예: 0.9 → 0.1):

- 더 많은 고객을 Yes로 분류 → 민감도 ↑ (default를 더 많이 잡음)
- 동시에 정상 고객도 더 많이 오분류 → 1-특이도 ↑ (x축 오른쪽으로 이동)

```{r, echo=FALSE, fig.height=4.5, fig.width=11}
library(pROC)
roc_obj <- roc(Default$default, predict(logit_multi, type = "response"), quiet = TRUE)

coords_df <- coords(roc_obj, x = c(0.05, 0.2, 0.5),
                    input = "threshold",
                    ret = c("threshold", "sensitivity", "specificity")) |>
  as.data.frame() |>
  mutate(fpr = 1 - specificity)

ggroc(roc_obj, legacy.axes = TRUE, color = "#d90502", linewidth = 1.3) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray50") +
  geom_point(data = coords_df, aes(x = fpr, y = sensitivity),
             size = 4, color = "steelblue") +
  geom_text(data = coords_df,
            aes(x = fpr, y = sensitivity,
                label = paste0("t = ", round(threshold, 2),
                               "\nSens = ", round(sensitivity, 2),
                               "\n1-Spec = ", round(fpr, 2))),
            size = 3.2, color = "steelblue", vjust = -0.4, hjust = 0.5) +
  annotate("point", x = 0, y = 0, size = 5, color = "gray40") +
  annotate("text",  x = 0.05, y = 0.05,
           label = "t = 1\n(predict No always)", size = 3, color = "gray40", hjust = 0) +
  annotate("point", x = 1, y = 1, size = 5, color = "darkgreen") +
  annotate("text",  x = 0.95, y = 0.95,
           label = "t = 0\n(predict Yes always)", size = 3, color = "darkgreen", hjust = 1) +
  annotate("text", x = 0.65, y = 0.35,
           label = paste0("AUC = ", round(auc(roc_obj), 3)),
           size = 5, color = "steelblue") +
  scale_x_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2)) +
  scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2)) +
  labs(title = "ROC Curve: moving the threshold traces the curve",
       x = "1 - Specificity (False Positive Rate, 0 → 1)",
       y = "Sensitivity (True Positive Rate, 0 → 1)") +
  theme_bw(base_size = 13)
```

- **t = 1** (왼쪽 아래): 모두 No → 불이행자를 하나도 못 잡음 (Sens = 0)
- **t = 0** (오른쪽 위): 모두 Yes → 불이행자를 다 잡지만 정상 고객도 다 오분류 (1-Spec = 1) 
- **threshold를 낮출수록** 점이 오른쪽 위 방향으로 이동

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

## AUC

**AUC가 의미하는 것**: 모형이 두 사람을 올바르게 **순위 매기는** 능력

> 불이행자 1명과 정상 고객 1명을 무작위로 뽑았을 때,  
> 모형이 불이행자에게 **더 높은 확률을 부여할 확률**

. . .

**예시:**

| 상황 | 불이행자 예측 확률 | 정상 고객 예측 확률 | 올바른 순위? |
|:----:|:-----------------:|:-------------------:|:------------:|
| ✅ 좋은 예측 | 0.82 | 0.05 | Yes |
| ✅ 좋은 예측 | 0.45 | 0.12 | Yes |
| ❌ 나쁜 예측 | 0.18 | 0.67 | No |

. . .

이런 쌍을 **여러번 반복**해서 올바른 순위를 매긴 비율 = **AUC**

| AUC | 해석 | 비유 |
|:---:|:-----|:-----|
| **1.0** | 항상 올바르게 순위 매김 | 완벽한 신용 심사관 |
| **0.95** | 95%의 쌍에서 올바르게 순위 매김 | 매우 우수 |
| **0.70** | 70%의 쌍에서 올바르게 순위 매김 | 양호 |
| **0.50** | 50% — 동전 던지기와 동일 | 쓸모없는 모형 |

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

## AUC: 예시

모형이 각 고객에게 채무불이행 예측 확률을 부여함

```{r, echo=FALSE}
set.seed(42)
example_df <- data.frame(
  Customer = c("A (Defaulter)", "B (Defaulter)", "C (Normal)", "D (Normal)"),
  Predicted_Prob = c(0.82, 0.45, 0.12, 0.05),
  Actual = c("Yes", "Yes", "No", "No")
)
knitr::kable(example_df, col.names = c("Customer", "Predicted Prob", "Actual Default"),
             align = "lcc") |>
  kableExtra::kable_styling(font_size = 22) |>
  kableExtra::row_spec(1:2, background = "#fff0f0") |>
  kableExtra::row_spec(3:4, background = "#f0f0ff")
```

**AUC 계산**: 불이행자(A, B) vs. 정상 고객(C, D) 가능한 쌍 4개를 비교

| 비교 쌍 | 불이행자 확률 | 정상 고객 확률 | 올바른 순위? |
|:-------:|:------------:|:--------------:|:------------:|
| A vs. C | 0.82 | 0.12 | ✅ Yes |
| A vs. D | 0.82 | 0.05 | ✅ Yes |
| B vs. C | 0.45 | 0.12 | ✅ Yes |
| B vs. D | 0.45 | 0.05 | ✅ Yes |

**AUC = 4/4 = 1.0** → 이 예시에서 완벽한 순위 부여

. . .

> AUC = 0.95 → 임의의 (불이행자, 정상 고객) 쌍 100개 중  
> **95개**에서 불이행자에게 더 높은 확률을 부여함

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

## AUC: ROC 곡선의 넓이

```{r, echo=FALSE, fig.height=4.5, fig.width=11}
library(pROC)
roc_obj <- roc(Default$default, predict(logit_multi, type = "response"), quiet = TRUE)

roc_df <- data.frame(
  fpr = 1 - roc_obj$specificities,
  tpr = roc_obj$sensitivities
)

# Random classifier line data
diag_df <- data.frame(fpr = c(0, 1), tpr = c(0, 1))

ggplot(roc_df, aes(x = fpr, y = tpr)) +
  # AUC shading: above diagonal = model gain over random
  geom_ribbon(aes(ymin = fpr, ymax = tpr), fill = "#d90502", alpha = 0.2) +
  geom_ribbon(aes(ymin = 0, ymax = fpr), fill = "gray70", alpha = 0.2) +
  geom_line(color = "#d90502", linewidth = 1.3) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray50", linewidth = 1) +
  # Annotations
  annotate("text", x = 0.25, y = 0.65,
           label = paste0("Model gain\n(AUC - 0.5 = ",
                          round(auc(roc_obj) - 0.5, 3), ")"),
           size = 4, color = "#d90502", fontface = "bold") +
  annotate("text", x = 0.65, y = 0.25,
           label = "Random classifier\n(AUC = 0.5)",
           size = 4, color = "gray50") +
  annotate("text", x = 0.98, y = 0.08,
           label = paste0("Total AUC\n= ", round(auc(roc_obj), 3)),
           size = 4.5, color = "steelblue", hjust = 1, fontface = "bold") +
  # Perfect classifier point
  annotate("point", x = 0, y = 1, size = 4, color = "darkgreen") +
  annotate("text",  x = 0.02, y = 0.97,
           label = "Perfect\nclassifier", size = 3.2, color = "darkgreen", hjust = 0) +
  scale_x_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2)) +
  scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2)) +
  labs(title = paste0("AUC = ", round(auc(roc_obj), 3),
                      ": red curve area / total box area"),
       x = "1 - Specificity: False Positive Rate (0 → 1)",
       y = "Sensitivity: True Positive Rate (0 → 1)") +
  theme_bw(base_size = 13)
```

- **빨간 음영** (곡선 위, 대각선 위): 무작위 분류 대비 **모형의 추가 성능**
- **회색 음영** (대각선 아래): 동전 던지기도 얻을 수 있는 영역 (AUC = 0.5)
- 전체 AUC = 빨간 + 회색 음영 합계

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

## Task 3 {background-color="#ffebf0"}

`r countdown(minutes = 12, top = "20px", right = "10px", font_size = "0.8em")`

모형을 훈련/테스트 세트로 나눠 실제 예측 성능을 평가해보자.

**Step 1.** 7:3으로 분리 후 훈련 세트로 모형 추정:

```{r, echo=TRUE, eval=FALSE}
set.seed(42)
train_idx   <- sample(1:nrow(Default), size = 0.7 * nrow(Default))
train_df    <- Default[train_idx, ]
test_df     <- Default[-train_idx, ]

logit_train <- glm(default ~ balance + income + student,
                   data = train_df, family = binomial)
```

**Step 2.** 테스트 세트에서 혼동 행렬 계산:

```{r, echo=TRUE, eval=FALSE}
pred_test   <- predict(logit_train, newdata = test_df, type = "response")
pred_class  <- ifelse(pred_test > 0.5, "Yes", "No")
table(Predicted = pred_class, Actual = test_df$default)
```

→ 테스트 세트의 정확도(Accuracy)를 계산하시오. 훈련 세트와 크게 다른가?

**Step 3 (Optional).** ROC와 AUC 계산:

```{r, echo=TRUE, eval=FALSE}
library(pROC)
roc_test <- roc(test_df$default, pred_test, quiet = TRUE)
plot(roc_test, col = "#d90502", lwd = 2,
     main = paste("Test AUC =", round(auc(roc_test), 3)))
```

→ AUC가 0.5에 가까우면 어떤 의미인가?

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

## OLS vs. 로지스틱 회귀: 정리

| 구분 | OLS | 로지스틱 회귀 |
|:-----|:---:|:-------------:|
| 종속변수 | 연속형 | 이진형 (0/1) |
| 추정 방법 | 최소제곱법 | 최대우도법 (MLE) |
| 예측값 범위 | $(-\infty, +\infty)$ | $(0, 1)$ |
| 계수 직접 해석 | $y$의 변화량 | 로그오즈의 변화량 |
| 확률 변화 해석 | 계수 그대로 | 한계 효과(ME) 별도 계산 필요 |
| 적합도 지표 | $R^2$ | Pseudo $R^2$, AUC |
| R 함수 | `lm()` | `glm(..., family = binomial)` |

. . .

> **핵심 메시지**: 로지스틱 회귀 계수는 **로그오즈의 변화**를 의미함.  
> 확률 변화를 알고 싶으면 → **한계 효과(AME)** 를 계산할 것.

# THE END!
