Module 13: Apply it to your data 12
Chapter 21 Iteration
Declan Fogarty
Import your data
data("mtcars")
mtcars <- as_tibble(mtcars)
data <- read_excel("../00_data/my data q&a.xlsx")
data## # A tibble: 269,732 × 15
## id name sex age height weight team noc games year season city
## <dbl> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <dbl> <chr> <chr>
## 1 1 A Dijia… M 24 180 80 China CHN 1992… 1992 Summer Barc…
## 2 2 A Lamusi M 23 170 60 China CHN 2012… 2012 Summer Lond…
## 3 3 Gunnar … M 24 NA NA Denm… DEN 1920… 1920 Summer Antw…
## 4 4 Edgar L… M 34 NA NA Denm… DEN 1900… 1900 Summer Paris
## 5 5 Christi… F 21 185 82 Neth… NED 1988… 1988 Winter Calg…
## 6 5 Christi… F 21 185 82 Neth… NED 1988… 1988 Winter Calg…
## 7 5 Christi… F 25 185 82 Neth… NED 1992… 1992 Winter Albe…
## 8 5 Christi… F 25 185 82 Neth… NED 1992… 1992 Winter Albe…
## 9 5 Christi… F 27 185 82 Neth… NED 1994… 1994 Winter Lill…
## 10 5 Christi… F 27 185 82 Neth… NED 1994… 1994 Winter Lill…
## # ℹ 269,722 more rows
## # ℹ 3 more variables: sport <chr>, event <chr>, medal <chr>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.812500mtcars %>% 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_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(.$cyl) %>%
map(~ lm(mpg ~ wt, data = .x)) %>%
map_df(broom::tidy, conf.int = TRUE, .id = "cyl") %>%
filter(term == "wt")
reg_coeff_tbl ## # A tibble: 3 × 8
## cyl term estimate std.error statistic p.value conf.low conf.high
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 wt -5.65 1.85 -3.05 0.0137 -9.83 -1.46
## 2 6 wt -2.78 1.33 -2.08 0.0918 -6.21 0.651
## 3 8 wt -2.19 0.739 -2.97 0.0118 -3.80 -0.582reg_coeff_tbl %>%
mutate(estimate = -estimate,
conf.low = -conf.low,
conf.high = -conf.high) %>%
ggplot(aes(x = estimate, y = factor(cyl))) +
geom_point() +
geom_errorbar(aes(xmin = conf.low, xmax = conf.high), width = 0.2) +
labs(
x = "Negative Coefficient Estimate for wt",
y = "Cylinders",
title = "Effect of Weight on MPG by Cylinder Count"
) +
theme_minimal()
Create your own
Choose either one of the two cases above and apply it to your data
# Clean your data
olympics_clean <- data %>%
filter(!is.na(weight), !is.na(height), !is.na(sport))
# Remove groups without enough variation
olympics_filtered <- olympics_clean %>%
group_by(sport) %>%
filter(n_distinct(height) > 1) %>%
ungroup()
# Create a safe lm function that returns NULL on error
safe_lm <- possibly(~ lm(weight ~ height, data = .x), otherwise = NULL)
# Run regressions safely on each sport group
regression_results <- olympics_filtered %>%
group_split(sport) %>%
set_names(map_chr(., ~ unique(.x$sport))) %>%
map(safe_lm)## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion
## Warning in storage.mode(v) <- "double": NAs introduced by coercion# Remove failed fits (NULL)
regression_results <- discard(regression_results, is.null)
# Tidy results
reg_tbl <- regression_results %>%
map_df(broom::tidy, conf.int = TRUE, .id = "sport") %>%
filter(term == "height")
# Plot the negative coefficient of height
reg_tbl %>%
mutate(
estimate = -estimate,
conf.low = -conf.low,
conf.high = -conf.high
) %>%
ggplot(aes(x = estimate, y = reorder(sport, estimate))) +
geom_point() +
geom_errorbar(aes(xmin = conf.low, xmax = conf.high), width = 0.2) +
labs(
x = "Negative Coefficient of Height",
y = "Sport",
title = "Effect of Height on Weight by Sport"
) +
theme_minimal()