data("mtcars")
mtcars <- as_tibble(mtcars)
canada_births_1991_2022 <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2024/2024-01-09/canada_births_1991_2022.csv')
## Rows: 384 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (3): year, month, births
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
nhl_player_births <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2024/2024-01-09/nhl_player_births.csv')
## Rows: 8474 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): first_name, last_name, birth_city, birth_country, birth_state_prov...
## dbl (3): player_id, birth_year, birth_month
## date (1): birth_date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
nhl_rosters <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2024/2024-01-09/nhl_rosters.csv')
## Rows: 54883 Columns: 18
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): team_code, position_type, headshot, first_name, last_name, positi...
## dbl (7): season, player_id, sweater_number, height_in_inches, weight_in_po...
## date (1): birth_date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Case of numeric variables
mtcars %>%
map_dbl(.x = ., .f = ~mean(x = .x))
## mpg cyl disp hp drat wt qsec
## 20.090625 6.187500 230.721875 146.687500 3.596563 3.217250 17.848750
## vs am gear carb
## 0.437500 0.406250 3.687500 2.812500
mtcars %>%
map_dbl(.f = ~mean(x = .x))
## mpg cyl disp hp drat wt qsec
## 20.090625 6.187500 230.721875 146.687500 3.596563 3.217250 17.848750
## vs am gear carb
## 0.437500 0.406250 3.687500 2.812500
mtcars %>%
map_dbl(mean)
## mpg cyl disp hp drat wt qsec
## 20.090625 6.187500 230.721875 146.687500 3.596563 3.217250 17.848750
## vs am gear carb
## 0.437500 0.406250 3.687500 2.812500
# Adding an argument
mtcars %>%
map_dbl(.x = ., .f = ~mean(x = .x, trim = 0.1))
## mpg cyl disp hp drat wt
## 19.6961538 6.2307692 222.5230769 141.1923077 3.5792308 3.1526923
## qsec vs am gear carb
## 17.8276923 0.4230769 0.3846154 3.6153846 2.6538462
mtcars %>%
map_dbl(mean, trim = 0.1)
## mpg cyl disp hp drat wt
## 19.6961538 6.2307692 222.5230769 141.1923077 3.5792308 3.1526923
## qsec vs am gear carb
## 17.8276923 0.4230769 0.3846154 3.6153846 2.6538462
mtcars %>%
select(.data = ., mpg)
## # A tibble: 32 × 1
## mpg
## <dbl>
## 1 21
## 2 21
## 3 22.8
## 4 21.4
## 5 18.7
## 6 18.1
## 7 14.3
## 8 24.4
## 9 22.8
## 10 19.2
## # ℹ 22 more rows
mtcars %>% select(mpg)
## # A tibble: 32 × 1
## mpg
## <dbl>
## 1 21
## 2 21
## 3 22.8
## 4 21.4
## 5 18.7
## 6 18.1
## 7 14.3
## 8 24.4
## 9 22.8
## 10 19.2
## # ℹ 22 more rows
Create your own function
# Double values in columns
double_by_factor <- function(x, factor) {
x * factor
}
10 %>% double_by_factor(factor = 2)
## [1] 20
mtcars %>%
map_dfr(.x = ., .f = ~double_by_factor(x = .x, factor = 10))
## # A tibble: 32 × 11
## mpg cyl disp hp drat wt qsec vs am gear carb
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 210 60 1600 1100 39 26.2 165. 0 10 40 40
## 2 210 60 1600 1100 39 28.8 170. 0 10 40 40
## 3 228 40 1080 930 38.5 23.2 186. 10 10 40 10
## 4 214 60 2580 1100 30.8 32.2 194. 10 0 30 10
## 5 187 80 3600 1750 31.5 34.4 170. 0 0 30 20
## 6 181 60 2250 1050 27.6 34.6 202. 10 0 30 10
## 7 143 80 3600 2450 32.1 35.7 158. 0 0 30 40
## 8 244 40 1467 620 36.9 31.9 200 10 0 40 20
## 9 228 40 1408 950 39.2 31.5 229 10 0 40 20
## 10 192 60 1676 1230 39.2 34.4 183 10 0 40 40
## # ℹ 22 more rows
mtcars %>%
map_dfr(double_by_factor, factor = 10)
## # A tibble: 32 × 11
## mpg cyl disp hp drat wt qsec vs am gear carb
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 210 60 1600 1100 39 26.2 165. 0 10 40 40
## 2 210 60 1600 1100 39 28.8 170. 0 10 40 40
## 3 228 40 1080 930 38.5 23.2 186. 10 10 40 10
## 4 214 60 2580 1100 30.8 32.2 194. 10 0 30 10
## 5 187 80 3600 1750 31.5 34.4 170. 0 0 30 20
## 6 181 60 2250 1050 27.6 34.6 202. 10 0 30 10
## 7 143 80 3600 2450 32.1 35.7 158. 0 0 30 40
## 8 244 40 1467 620 36.9 31.9 200 10 0 40 20
## 9 228 40 1408 950 39.2 31.5 229 10 0 40 20
## 10 192 60 1676 1230 39.2 34.4 183 10 0 40 40
## # ℹ 22 more rows
When you have a grouping variable (factor)
mtcars %>%
lm(formula = mpg ~ wt, data = .)
##
## Call:
## lm(formula = mpg ~ wt, data = .)
##
## Coefficients:
## (Intercept) wt
## 37.285 -5.344
mtcars %>%
distinct(cyl)
## # A tibble: 3 × 1
## cyl
## <dbl>
## 1 6
## 2 4
## 3 8
reg_coeff_tbl <- mtcars %>%
# Split it into a list of data frames
split(.$cyl) %>%
# Repeat regression over each group
map(~ lm(formula = mpg ~ wt, data = .x)) %>%
# Extract coefficients from regression results
map(broom::tidy, conf.int = TRUE) %>%
# Convert to tibble
bind_rows(.id = "cyl") %>%
# Filter for wt coefficients
filter(term == "wt")
reg_coeff_tbl %>%
mutate(
estimate = -estimate,
conf.low = -conf.low,
conf.high = -conf.high
) %>%
ggplot(aes(x = estimate, y = cyl)) +
geom_point() +
geom_errorbar(aes(xmin = conf.low, xmax = conf.high))
Choose either one of the two cases above and apply it to your data
### For each NHL position, how much does weight increase for every extra inch of height
# Merge births + rosters by player_id
nhl <- nhl_rosters %>%
left_join(nhl_player_births, by = "player_id") %>%
filter(!is.na(height_in_inches), !is.na(weight_in_pounds)) %>%
filter(!is.na(position_code))
## Warning in left_join(., nhl_player_births, by = "player_id"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 37968 of `x` matches multiple rows in `y`.
## ℹ Row 1 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.
# Quick look
nhl %>% distinct(position_code)
## # A tibble: 5 × 1
## position_code
## <chr>
## 1 L
## 2 R
## 3 C
## 4 D
## 5 G
# (C, LW, RW, D, G, etc.)
reg_coeff_tbl <- nhl %>%
split(.$position_code) %>%
map(~ lm(weight_in_pounds ~ height_in_inches, data = .x)) %>%
map(broom::tidy, conf.int = TRUE) %>%
bind_rows(.id = "position_code") %>%
filter(term == "height_in_inches")
# Plot
reg_coeff_tbl %>%
mutate(
estimate = -estimate,
conf.low = -conf.low,
conf.high = -conf.high
) %>%
ggplot(aes(x = estimate, y = position_code)) +
geom_point(size = 3) +
geom_errorbar(aes(xmin = conf.low, xmax = conf.high), width = 0.25) +
labs(
title = "Effect of Player Height on Weight by NHL Position",
x = "Estimated Slope (Negative Sign Applied)",
y = "Position"
) +
theme_minimal()