DaKKasu 1
## Loading required package: car## Loading required package: carData## Loading required package: effects## lattice theme set by effectsTheme()
## See ?effectsTheme for details.## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::recode() masks car::recode()
## ✖ purrr::some() masks car::some()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors데이터와 산점도
## Rows: 1,375
## Columns: 2
## $ mheight <dbl> 59.7, 58.2, 60.6, 60.7, 61.8, 55.5, 55.4, 56.8, 57.5, 57.3, 58…
## $ dheight <dbl> 55.1, 56.5, 56.0, 56.8, 56.0, 57.9, 57.1, 57.6, 57.2, 57.1, 57…엄마와 딸의 키가 1375개씩 있는 데이터이다.
vector로 표현하면, \(\mathbf{x},\mathbf{y} \in \mathbb{R}^{1375}\)가 되겠다.
plot_h <- ggplot(Heights, aes(x = mheight, y = dheight)) +
geom_point(alpha = 0.6) +
labs(x = "Mother's ht(inch)",
y = "Daughter's ht(inch)",
caption = "DK. Pearson and A. Lee (1903), On the laws of inheritance in man, Biometrika.") +
theme_ipsum_gs(); plot_h +
labs(title = "Mother's ht vs Daughter's ht Scatterplot")
산점도의 그림으로는 어떤 유의미한 관계가 있어보이는데, 실제로 엄마의 키와 딸의 키 사이에 유의미한 관계가 있는지 검증해보고 싶다.
선형 회귀 모델
df <- Heights
lm_df <- lm(df$dheight ~ df$mheight)
yhat <- predict(lm_df)
df <- df |>
mutate(yhat, draw_segment = if_else(row_number() %in% sample(1:1375, size = 150), TRUE, FALSE))
# segment를 그리기 위한 작업##
## Call:
## lm(formula = df$dheight ~ df$mheight)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.397 -1.529 0.036 1.492 9.053
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 29.91744 1.62247 18.44 <2e-16 ***
## df$mheight 0.54175 0.02596 20.87 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.266 on 1373 degrees of freedom
## Multiple R-squared: 0.2408, Adjusted R-squared: 0.2402
## F-statistic: 435.5 on 1 and 1373 DF, p-value: < 2.2e-16우리가 관심있는 부분은 Intercept : 29.91744 Slope : 0.54175 R-squared : 0.2408 이다.
Normal equation
다음과 같은 모델을 생각해보자. \[y_i = \beta_0 + \beta_1x_i + \varepsilon, \:\: \varepsilon \overset{d}{\sim} \mathbf{N}(0, 1)\]
행렬의 형태로 바라보면 다음과 같다. \[\mathbf{Y} = \mathbf{X}\mathbf{\beta} + \varepsilon, \;\; where \;\mathbf{X} = [\;\mathbf{j}\;\;\; \mathbf{x} \;], \;\; \beta = [\;\beta_0 \;\; \beta_1\;]^t\]
# Solve the normal equation
X <- df$mheight; y <- df$dheight
j <- rep(1, 1375) # 1이 1375번 반복되는 vector
X <- matrix(c(j,X), ncol = 2)
X |> head()## [,1] [,2]
## [1,] 1 59.7
## [2,] 1 58.2
## [3,] 1 60.6
## [4,] 1 60.7
## [5,] 1 61.8
## [6,] 1 55.5## [,1]
## [1,] 29.917437
## [2,] 0.541747## (Intercept) df$mheight
## 29.917437 0.541747Normal equation의 해를 찾는 방법으로 \[\hat{\mathbf{\beta}} = (\mathbf{X}^T\mathbf{X})^{-1}\mathbf{X}^T\mathbf{Y}\] ### 프로그램의 linear model과 Normal equation의 해
## `geom_smooth()` using formula = 'y ~ x'
plot_h + geom_abline(slope = slope_df, intercept = intercept_df,
color = 'red', linewidth = 1) +
labs(title = "abline with Normal equation")
SST와 SSR, SSE의 의미
## SST의 의미
plot_h + geom_smooth(method = 'lm', se = F, linewidth = 1) +
geom_hline(yintercept = mean(Heights$dheight), color = 'green', linewidth = 1) +
geom_segment(data = filter(df, draw_segment), aes(xend = mheight, yend = mean(Heights$dheight)), linetype = 'dashed', color = 'red') +
labs(title = "Total Sum of Squares")## `geom_smooth()` using formula = 'y ~ x'
## SSR의 의미
plot_h + geom_smooth(method = 'lm', se = F, linewidth = 1) +
geom_hline(yintercept = mean(Heights$dheight), color = 'green', linewidth = 1) +
geom_segment(data = filter(df, draw_segment), aes(y = mean(Heights$dheight), yend = yhat), linetype = 'dashed', color = 'purple') +
labs(title = "Sum of Squares due to Regression")## `geom_smooth()` using formula = 'y ~ x'
## SSE의 의미
plot_h + geom_smooth(method = 'lm', se = F, linewidth = 1) +
geom_hline(yintercept = mean(Heights$dheight), color = 'green', linewidth = 1) +
geom_segment(data = filter(df, draw_segment), aes(xend = mheight, yend = yhat), linetype = 'dashed', color = 'red') +
labs(title = "Sum of Squares Residual of Error")## `geom_smooth()` using formula = 'y ~ x'
SST
## [,1]
## [1,] 9288.616\[\begin{aligned} SST =& \lVert \mathbf{Y} - \bar{Y}\mathbf{j} \rVert^2 \newline =& \lVert \mathbf{IY} - \mathbf{JY} \rVert^2 \newline =& \mathbf{Y}^t(\mathbf{I} -\mathbf{J})^t(\mathbf{I} -\mathbf{J})\mathbf{Y} \newline =&\mathbf{Y}^t(\mathbf{I} - \mathbf{J})\mathbf{Y}, \;\; where\,\, \mathbf{J} = \mathbf{j}(\mathbf{j}\,^t\mathbf{j})^{-1}\mathbf{j}\,^t \end{aligned}\]
SSE
## [,1]
## [1,] 7051.957\[\begin{aligned} SSE=& \lVert \mathbf{Y} - \mathbf{X}\hat{\mathbf{\beta}}\rVert^2\newline =& \lVert \mathbf{IY} - \mathbf{HY} \rVert^2\newline =& \mathbf{Y}^t(\mathbf{I} -\mathbf{H})^t(\mathbf{I} -\mathbf{H})\mathbf{Y}\newline =& \mathbf{Y}^t(\mathbf{I} - \mathbf{H})\mathbf{Y} , \;\; where\,\, \mathbf{H} = \mathbf{X}(\mathbf{X}^t\mathbf{X})^{-1}\mathbf{X}^t \end{aligned}\]
SSR
## [,1]
## [1,] 2236.659\[\begin{aligned} SSR=& \lVert \mathbf{X}\hat{\mathbf{\beta}} - \bar{Y}\mathbf{j} \rVert^2\newline =& \lVert \mathbf{HY} - \mathbf{JY} \rVert^2\newline =& \mathbf{Y}^t(\mathbf{H} -\mathbf{J})^t(\mathbf{H} -\mathbf{J})\mathbf{Y} \newline =&\mathbf{Y}^t(\mathbf{H} - \mathbf{J})\mathbf{Y} \end{aligned}\]