Module 13: Apply it to your data 12
Chapter 21 Iteration
Thomas Hall
11/20/2024
Import your data
data("mtcars")
mtcars <- as_tibble(mtcars)
Summer_Movies <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/refs/heads/master/data/2024/2024-07-30/summer_movies.csv')## Rows: 905 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): tconst, title_type, primary_title, original_title, genres, simple_t...
## dbl (4): year, runtime_minutes, average_rating, num_votes
##
## ℹ 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.mtmovies <- as_tibble(Summer_Movies)Repeat the same operation over different columns of a data frame
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.812500mtcars %>% 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.812500mtcars %>% 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.6538462mtcars %>% 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.6538462mtcars %>% 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 rowsmtcars %>% 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 rowsCreate your own function
# Double values in colums
double_by_factor <- function(x, factor) {x * factor}
10 %>% double_by_factor(factor = 2)## [1] 20mtcars %>% 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 rowsmtcars %>% 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 rowsRepeat the same operation over different elements of a list
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.344mtcars %>% distinct(cyl)## # A tibble: 3 × 1
## cyl
## <dbl>
## 1 6
## 2 4
## 3 8reg_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))
Create your own
Choose either one of the two cases above and apply it to your data
Summer_Movies %>% lm(formula = runtime_minutes ~ average_rating, data = .)##
## Call:
## lm(formula = runtime_minutes ~ average_rating, data = .)
##
## Coefficients:
## (Intercept) average_rating
## 91.7301 -0.1102Summer_Movies %>% distinct(year)## # A tibble: 84 × 1
## year
## <dbl>
## 1 1920
## 2 1935
## 3 1941
## 4 1944
## 5 1946
## 6 1947
## 7 1948
## 8 1949
## 9 1951
## 10 1950
## # ℹ 74 more rowsSmmer_tbl <- Summer_Movies %>%
# Split it into a list of data frames
split(.$year) %>%
# Repeat regression over each group
map(~lm(formula = runtime_minutes ~ average_rating, data = .x)) %>%
# Extract coefficients from regression results
map(broom::tidy, conf.int = TRUE) %>%
# Convert to tibble
bind_rows(.id = "year") %>%
# Filter for wt coefficients
filter(!is.na(estimate), !is.nan(estimate), term == "average_rating")## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs produced
## Warning in qt(a, object$df.residual): NaNs producedSmmer_tbl <- na.omit(Smmer_tbl)
Smmer_tbl## # A tibble: 66 × 8
## year term estimate std.error statistic p.value conf.low conf.high
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1951 average_rating 13.0 6.23 2.09 0.172 -13.8 39.9
## 2 1955 average_rating 4.33 3.97 1.09 0.355 -8.29 17.0
## 3 1956 average_rating -8.92 0.329 -27.1 0.0235 -13.1 -4.75
## 4 1957 average_rating 2.97 8.20 0.363 0.779 -101. 107.
## 5 1958 average_rating 30.7 25.8 1.19 0.356 -80.3 142.
## 6 1959 average_rating -1.68 6.70 -0.252 0.811 -18.9 15.5
## 7 1961 average_rating 3.30 7.30 0.452 0.674 -17.0 23.6
## 8 1963 average_rating 4.50 11.5 0.391 0.734 -45.0 54.0
## 9 1965 average_rating 5.21 10.5 0.497 0.706 -128. 138.
## 10 1967 average_rating -26.2 6.74 -3.89 0.0176 -45.0 -7.53
## # ℹ 56 more rowsSmmer_tbl %>%
mutate(estimate = estimate,
conf.low = conf.low,
conf.high = conf.high) %>%
ggplot(aes(x = estimate, y = year)) +
geom_point() +
geom_errorbar(aes(xmin = conf.low, xmax = conf.high))