library(tidyverse)
compute_panel_lm <- function(data, scales, drop_x = FALSE, formula = y ~ . ){
data %>%
remove_missing() ->
data
data %>%
select(-PANEL) ->
lmdata
if(drop_x){
lmdata %>%
select(-x) ->
lmdata
}
lm <- lm(data = lmdata, y ~ .)
data$yend = data$y
data$y = lm$fitted.values
data$xend = data$x
data$residuals <- lm$residuals
data
}
palmerpenguins::penguins %>%
remove_missing() %>%
select(y = flipper_length_mm,
x = bill_depth_mm,
pred1 = sex) %>%
mutate(PANEL = 1) %>%
compute_panel_lm()
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## # A tibble: 333 × 7
## y x pred1 PANEL yend xend residuals
## <dbl> <dbl> <fct> <dbl> <int> <dbl> <dbl>
## 1 200. 18.7 male 1 181 18.7 -19.0
## 2 192. 17.4 female 1 186 17.4 -5.94
## 3 189. 18 female 1 195 18 6.39
## 4 181. 19.3 female 1 193 19.3 11.6
## 5 189. 20.6 male 1 190 20.6 0.560
## 6 190. 17.8 female 1 181 17.8 -8.72
## 7 195. 19.6 male 1 195 19.6 -0.00157
## 8 191. 17.6 female 1 182 17.6 -8.83
## 9 186. 21.2 male 1 191 21.2 4.90
## 10 187. 21.1 male 1 198 21.1 11.3
## # ℹ 323 more rows
StatLm <- ggproto("StatLm",
Stat,
compute_panel = compute_panel_lm)
palmerpenguins::penguins %>%
ggplot() +
aes(y = flipper_length_mm, x = bill_depth_mm) +
geom_point() +
geom_point(stat = StatLm, alpha = .25) +
geom_segment(stat = StatLm, alpha = .25)
## Warning: Removed 2 rows containing missing values or values outside the scale range.
## Removed 2 rows containing missing values or values outside the scale range.
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() + aes(color = species) + aes(species = species) + NULL
## Warning: Removed 2 rows containing missing values or values outside the scale
## range.
## Warning: Removed 2 rows containing missing values or values outside the scale
## range.
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() + aes(shape = sex) + NULL
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() + aes(body_mass_g = body_mass_g) + NULL
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() + aes(bill_length_mm = bill_length_mm) + NULL
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() + aes(island = island) + NULL
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() + aes(year = year)
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale range
## (`geom_point()`).
palmerpenguins::penguins %>%
ggplot() +
aes(y = flipper_length_mm, x = bill_depth_mm, sex = sex) +
geom_point() +
geom_point(stat = StatLm, alpha = .25) +
geom_segment(stat = StatLm, alpha = .25)
## Warning: Removed 11 rows containing missing values or values outside the scale range.
## Removed 11 rows containing missing values or values outside the scale range.
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() +
aes(p4 = bill_length_mm)
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() +
aes(p5 = island)
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_point()`).
last_plot() +
aes(p6 = year)
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_point()`).
compute_square = function(data, scales){
data %>% mutate(y = x, xmax = x, ymax = y, xmin = 0, ymin = 0)
}
StatSquare <- ggproto("StatSquare", Stat, compute_group = compute_square)
# residuals
layer_data(i = 2) %>%
ggplot() +
aes(x = residuals) +
geom_rug() +
scale_x_continuous(limits = c(-40, 40)) +
geom_rect(stat = StatSquare, alpha = .2) +
coord_equal()
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
layer_data(i = 2) %>%
ggplot() +
aes(id = "All", area = x^2) +
ggcirclepack::geom_circlepack(alpha = .25) +
ggcirclepack::geom_circlepack_text() +
aes(label = round(after_stat(area))) +
labs(title = "Residual Sum of Squares")
## Warning: Unknown or uninitialised column: `wt`.
## Warning: Unknown or uninitialised column: `within`.
## Warning: Unknown or uninitialised column: `wt`.
## Warning: Unknown or uninitialised column: `within`.
# Diff from mean
palmerpenguins::penguins %>%
remove_missing() %>%
mutate(index = row_number()) %>%
ggplot() +
aes(y = flipper_length_mm, x = index) +
geom_point() +
geom_point(stat = StatLm, alpha = .25, drop_x = T) +
geom_segment(stat = StatLm, alpha = .25, drop_x = T)
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
layer_data(i = 2) %>%
ggplot() +
aes(x = residuals) +
geom_rug() +
geom_rect(stat = StatSquare, alpha = .2) +
scale_x_continuous(limits = c(-40, 40)) +
coord_equal()
layer_data(i = 2) %>%
ggplot() +
aes(id = "All", area = x^2) +
ggcirclepack::geom_circlepack(alpha = .25) +
ggcirclepack::geom_circlepack_text() +
aes(label = round(after_stat(area))) +
labs(title = "Total Sum of Squares")
## Warning: Unknown or uninitialised column: `wt`.
## Unknown or uninitialised column: `within`.
## Warning: Unknown or uninitialised column: `wt`.
## Warning: Unknown or uninitialised column: `within`.
(65219-7567)/66219 # R-squared 0.884
## [1] 0.8706263
lm(flipper_length_mm ~ ., data = palmerpenguins::penguins) %>%
summary()
##
## Call:
## lm(formula = flipper_length_mm ~ ., data = palmerpenguins::penguins)
##
## Residuals:
## Min 1Q Median 3Q Max
## -14.9290 -2.9850 -0.0741 3.0890 14.3291
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.616e+03 6.646e+02 -6.947 2.07e-11 ***
## speciesChinstrap 2.850e+00 1.515e+00 1.881 0.06087 .
## speciesGentoo 2.241e+01 2.261e+00 9.912 < 2e-16 ***
## islandDream 1.706e+00 9.821e-01 1.738 0.08325 .
## islandTorgersen 2.923e+00 1.017e+00 2.876 0.00430 **
## bill_length_mm 2.728e-01 1.205e-01 2.263 0.02428 *
## bill_depth_mm 1.026e+00 3.379e-01 3.037 0.00258 **
## body_mass_g 5.281e-03 8.929e-04 5.915 8.46e-09 ***
## sexmale 7.825e-01 8.858e-01 0.883 0.37768
## year 2.368e+00 3.309e-01 7.156 5.60e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.841 on 323 degrees of freedom
## (11 observations deleted due to missingness)
## Multiple R-squared: 0.884, Adjusted R-squared: 0.8807
## F-statistic: 273.4 on 9 and 323 DF, p-value: < 2.2e-16
knitr::knit_exit()