├── .gitignore ├── 00-Getting-started.Rmd ├── 01-Visualize.Rmd ├── 02-Transform.Rmd ├── 03-Data-Types.Rmd ├── 04-Import.Rmd ├── 05-Tidy.Rmd ├── 06-Case-Study-1.Rmd ├── 07-Model.Rmd ├── 08-Iterate.Rmd ├── 09-Organize.Rmd ├── 10-Case-Study-2.Rmd ├── 11-Communicate ├── analyze-share-repro.Rmd ├── case-study-2-report │ ├── bib │ │ ├── knit.bib │ │ ├── packages.bib │ │ └── references.bib │ └── csl │ │ └── apa.csl └── chunk-basics.Rmd ├── LICENSE.txt ├── README.Rmd ├── README.md ├── cheatsheets ├── data-import.pdf ├── data-transformation.pdf ├── data-visualization.pdf ├── factors.pdf ├── lubridate.pdf ├── purrr.pdf ├── rmarkdown-reference.pdf ├── rmarkdown.pdf ├── rstudio-ide.pdf └── strings.pdf ├── data └── nimbus.csv ├── resources ├── bialik-fridaythe13th-2.png ├── confint.png ├── density.png └── rstudio-logo.png ├── setup.R ├── slides ├── 00-Preliminaries.pdf ├── 01-Visualize.pdf ├── 02-Transform.pdf ├── 03-Data-Types.pdf ├── 04-Import.pdf ├── 05-Tidy.pdf ├── 06-Case-Study-1.pdf ├── 07-Model.pdf ├── 08-Iterate.pdf ├── 09-Organize.pdf ├── 10-Case-Study-2.pdf ├── 11-Communicate.pdf └── 12-Wrapping-Up.pdf ├── solutions ├── 01-Visualize-Solutions.Rmd ├── 02-Transform-Solutions.Rmd ├── 03-Data-Types-Solutions.Rmd ├── 04-Import-Solutions.Rmd ├── 05-Tidy-Solutions.Rmd ├── 06-Case-Study-1-Solutions.Rmd ├── 07-Model-Solutions.Rmd ├── 08-Iterate-Solutions.Rmd ├── 09-Organize-Solutions.Rmd ├── 10-Case-Study-2-Solutions.Rmd ├── 11-Communicate-Solutions │ ├── analyze-share-repro-Solutions.Rmd │ ├── case-study-2-report-Solutions │ │ ├── bib │ │ │ ├── knit.bib │ │ │ ├── packages.bib │ │ │ └── references.bib │ │ ├── case-study-2-report-Solutions.Rmd │ │ ├── case-study-2-report-Solutions_cache │ │ │ └── html │ │ │ │ ├── __packages │ │ │ │ ├── calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.RData │ │ │ │ ├── calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.rdb │ │ │ │ ├── calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.rdx │ │ │ │ ├── calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.RData │ │ │ │ ├── calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.rdb │ │ │ │ ├── calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.rdx │ │ │ │ ├── rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.RData │ │ │ │ ├── rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.rdb │ │ │ │ └── rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.rdx │ │ ├── csl │ │ │ └── apa.csl │ │ └── figures │ │ │ ├── ccr-dist-1.png │ │ │ ├── diff-plot-1.png │ │ │ ├── logloss-1.png │ │ │ └── logloss-exm-1.png │ ├── chunk-basics-Solutions.Rmd │ └── my-first-rmd-Solutions.Rmd └── 12-reprex.R └── tidyds-2019.Rproj /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .Rprofile 6 | keynotes/* 7 | *.html 8 | -------------------------------------------------------------------------------- /00-Getting-started.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Preliminaries" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | ``` 13 | 14 | ## R notebooks 15 | 16 | This is an [R Markdown](http://rmarkdown.rstudio.com) Notebook. When you execute code within the notebook, the results appear beneath the code. 17 | 18 | R code goes in **code chunks**, denoted by three backticks. Try executing this chunk by clicking the *Run* button within the chunk or by placing your cursor inside it and pressing *Crtl+Shift+Enter* (Windows) or *Cmd+Shift+Enter* (Mac). 19 | 20 | ```{r} 21 | ggplot(data = mpg) + 22 | geom_point(mapping = aes(x = displ, y = hwy)) 23 | ``` 24 | 25 | Add a new chunk by clicking the *Insert* button on the toolbar, then selecting *R* or by pressing *Ctrl+Alt+I* (Windows) or *Cmd+Option+I* (Mac). 26 | 27 | When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the *Preview* button or press *Ctrl+Shift+K* (Windows) or *Cmd+Shift+K* (Mac) to preview the HTML file). 28 | 29 | The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike *Knit*, *Preview* does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed. 30 | 31 | -------------------------------------------------------------------------------- /01-Visualize.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Data Visualization" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ## Setup 11 | 12 | The first chunk in an R Notebook is usually titled "setup," and by convention includes the R packages you want to load. Remember, in order to use an R package you have to run some `library()` code every session. Execute these lines of code to load the packages. 13 | 14 | ```{r setup, include = FALSE} 15 | library(tidyverse) 16 | library(fivethirtyeight) 17 | ``` 18 | 19 | 20 | ## Bechdel test data 21 | 22 | We're going to start by playing with data collected by the website FiveThirtyEight on movies and [the Bechdel test](https://en.wikipedia.org/wiki/Bechdel_test). 23 | 24 | To begin, let's just preview our data. There are a couple ways to do that. One is just to type the name of the data and execute it like a piece of code. 25 | 26 | ```{r} 27 | bechdel 28 | ``` 29 | 30 | Notice that you can page through to see more of the dataset. 31 | 32 | Sometimes, people prefer to see their data in a more spreadsheet-like format, and RStudio provides a way to do that. Go to the Console and type `View(bechdel)` to see the data preview. 33 | 34 | (An aside-- `View` is a special function. Since it makes something happen in the RStudio interface, it doesn't work properly in R Notebooks. Most R functions have names that start with lowercase letters, so the uppercase "V" is there to remind you of its special status.) 35 | 36 | 37 | ## Consider 38 | What relationship do you expect to see between movie budget (budget) and domestic gross(domgross)? 39 | 40 | 41 | ## Your Turn 1 42 | 43 | Run the code on the slide to make a graph. Pay strict attention to spelling, capitalization, and parentheses! 44 | 45 | ```{r} 46 | 47 | ``` 48 | 49 | 50 | ## Your Turn 2 51 | 52 | Add `color`, `size`, `alpha`, and `shape` aesthetics to your graph. Experiment. 53 | 54 | ```{r} 55 | ggplot(data = bechdel) + 56 | geom_point(mapping = aes(x = budget, y = domgross)) 57 | ``` 58 | 59 | 60 | ## Set vs map 61 | 62 | ```{r} 63 | ggplot(bechdel) + 64 | geom_point(mapping = aes(x = budget, y = domgross), color = "blue") 65 | ``` 66 | 67 | 68 | ## Your Turn 3 69 | 70 | Replace this scatterplot with one that draws boxplots. Use the cheatsheet. Try your best guess. 71 | 72 | ```{r} 73 | ggplot(data = bechdel) + 74 | geom_point(mapping = aes(x = clean_test, y = budget)) 75 | ``` 76 | 77 | 78 | ## Your Turn 4 79 | 80 | Make a histogram of the `budget` variable from `bechdel`. 81 | 82 | ```{r} 83 | 84 | ``` 85 | 86 | 87 | ## Your Turn 5 88 | 89 | Make a density plot of `budget` colored by `clean_test`. 90 | 91 | ```{r} 92 | 93 | ``` 94 | 95 | 96 | ## Your Turn 6 97 | 98 | Make a barchart of `clean_test` colored by `clean_test`. 99 | 100 | ```{r} 101 | 102 | ``` 103 | 104 | 105 | ## Your Turn 7 106 | 107 | Predict what this code will do. Then run it. 108 | 109 | ```{r} 110 | ggplot(data = bechdel) + 111 | geom_point(mapping = aes(x = budget, y = domgross)) + 112 | geom_smooth(mapping = aes(x = budget, y = domgross)) 113 | ``` 114 | 115 | 116 | ## global vs local 117 | 118 | ```{r} 119 | ggplot(data = bechdel, mapping = aes(x = budget, y = domgross)) + 120 | geom_point(mapping = aes(color = clean_test)) + 121 | geom_smooth() 122 | ``` 123 | 124 | ```{r} 125 | ggplot(data = bechdel, mapping = aes(x = budget, y = domgross)) + 126 | geom_point(mapping = aes(color = clean_test)) + 127 | geom_smooth(data = filter(bechdel, clean_test == "ok")) 128 | ``` 129 | 130 | 131 | ## Your Turn 8 132 | 133 | Add a position adjustment to this plot to compare the frequency of test results across decades. 134 | 135 | ```{r} 136 | ggplot(data = bechdel, mapping = aes(x = decade_code)) + 137 | geom_bar(mapping = aes(fill = clean_test)) 138 | ``` 139 | 140 | 141 | ## Saving plots 142 | 143 | Save the last plot. If you run your `ggsave()` code inside this notebook, the image will be saved in the same directory as your .Rmd file but if you run `ggsave()` in the Console it will be in your working directory. You can manually set the directory with the `path` argument. 144 | 145 | ```{r} 146 | ggsave("my-plot.png", width = 8, height = 6, units = "in", dpi = "retina") 147 | ``` 148 | 149 | *** 150 | 151 | # Take aways 152 | 153 | You can use this code template to make thousands of graphs with **ggplot2**. 154 | 155 | ```{r eval = FALSE} 156 | ggplot(data = ) + 157 | (mapping = aes(), 158 | stat = , position = ) + 159 | + 160 | + 161 | 162 | ``` 163 | -------------------------------------------------------------------------------- /02-Transform.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Data Transformation" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(babynames) 13 | library(nycflights13) 14 | library(skimr) 15 | ``` 16 | 17 | 18 | ## Babynames 19 | 20 | ```{r} 21 | babynames 22 | skim(babynames) 23 | ``` 24 | 25 | 26 | ## Your Turn 1 27 | 28 | Run the `skim_with()` command, and then try skimming babynames again to see how the output is different 29 | 30 | ```{r} 31 | skim_with(integer = list(p25 = NULL, p75=NULL)) 32 | ``` 33 | 34 | 35 | ## Your Turn 2 36 | 37 | Alter the code to select just the `n` column: 38 | 39 | ```{r} 40 | select(babynames, name, prop) 41 | ``` 42 | 43 | 44 | ## `select()` helpers 45 | 46 | ```{r} 47 | select(storms, name:pressure) 48 | select(storms, -c(name, pressure)) 49 | select(storms, starts_with("w")) 50 | select(storms, ends_with("e")) 51 | select(storms, contains("d")) 52 | select(storms, matches("^.{4}$")) 53 | select(storms, one_of(c("name", "names", "Name"))) 54 | select(storms, num_range("x", 1:5)) 55 | ``` 56 | 57 | 58 | ## Consider 59 | 60 | Which of these is NOT a way to select the `name` and `n` columns together? 61 | 62 | ```{r} 63 | select(babynames, -c(year, sex, prop)) 64 | select(babynames, name:n) 65 | select(babynames, starts_with("n")) 66 | select(babynames, ends_with("n")) 67 | ``` 68 | 69 | 70 | ## Your Turn 3 71 | 72 | Show: 73 | 74 | * All of the names where prop is greater than or equal to 0.08 75 | * All of the children named "Daenerys" 76 | * All of the names that have a missing value for `n` 77 | 78 | ```{r} 79 | 80 | ``` 81 | 82 | 83 | ## Your Turn 4 84 | 85 | Use Boolean operators to alter the code below to return only the rows that contain: 86 | 87 | * Girls named Sea 88 | * Names that were used by exactly 5 or 6 children in 1880 89 | * Names that are one of Acura, Lexus, or Yugo 90 | 91 | ```{r} 92 | filter(babynames, name == "Sea" | name == "Anemone") 93 | ``` 94 | 95 | 96 | ## Your Turn 5 97 | 98 | Arrange babynames by `n`. Add `prop` as a second (tie breaking) variable to arrange on. Can you tell what the smallest value of `n` is? 99 | 100 | ```{r} 101 | 102 | ``` 103 | 104 | 105 | ## Your Turn 6 106 | 107 | * Use `desc()` to find the names with the highest prop. 108 | * Then, use `desc()` to find the names with the highest n. 109 | 110 | ```{r} 111 | 112 | ``` 113 | 114 | 115 | ## Steps and the pipe 116 | 117 | ```{r} 118 | babynames %>% 119 | filter(year == 2015, sex == "M") %>% 120 | select(name, n) %>% 121 | arrange(desc(n)) 122 | ``` 123 | 124 | 125 | ## Your Turn 7 126 | 127 | Use `%>%` to write a sequence of functions that: 128 | 129 | 1. Filter babynames to just the girls that were born in 2015 130 | 2. Select the `name` and `n` columns 131 | 3. Arrange the results so that the most popular names are near the top. 132 | 133 | ```{r} 134 | 135 | ``` 136 | 137 | 138 | ## Your Turn 8 139 | 140 | 1. Trim `babynames` to just the rows that contain your `name` and your `sex` 141 | 2. Trim the result to just the columns that will appear in your graph (not strictly necessary, but useful practice) 142 | 3. Plot the results as a line graph with `year` on the x axis and `prop` on the y axis, colored by `sex` 143 | 144 | ```{r} 145 | 146 | ``` 147 | 148 | 149 | ## Your Turn 9 150 | 151 | Use `summarize()` to compute three statistics about the data: 152 | 153 | 1. The first (minimum) year in the dataset 154 | 2. The last (maximum) year in the dataset 155 | 3. The total number of children represented in the data 156 | 157 | ```{r} 158 | 159 | ``` 160 | 161 | 162 | ## Your Turn 10 163 | 164 | Extract the rows where `name == "Khaleesi"`. Then use `summarize()` to find: 165 | 166 | 1. The total number of children named Khaleesi 167 | 2. The first year Khaleesi appeared in the data 168 | 169 | ```{r} 170 | 171 | ``` 172 | 173 | 174 | ## Toy data for transforming 175 | 176 | ```{r} 177 | # Toy dataset to use 178 | pollution <- tribble( 179 | ~city, ~size, ~amount, 180 | "New York", "large", 23, 181 | "New York", "small", 14, 182 | "London", "large", 22, 183 | "London", "small", 16, 184 | "Beijing", "large", 121, 185 | "Beijing", "small", 56 186 | ) 187 | ``` 188 | 189 | 190 | ## Summarize 191 | 192 | ```{r} 193 | pollution %>% 194 | summarize(mean = mean(amount), sum = sum(amount), n = n()) 195 | ``` 196 | 197 | ```{r} 198 | pollution %>% 199 | group_by(city) %>% 200 | summarize(mean = mean(amount), sum = sum(amount), n = n()) 201 | ``` 202 | 203 | 204 | ## Your Turn 11 205 | 206 | Use `group_by()`, `summarize()`, and `arrange()` to display the ten most popular baby names. Compute popularity as the total number of children of a single gender given a name. 207 | 208 | ```{r} 209 | 210 | ``` 211 | 212 | 213 | ## Your Turn 12 214 | 215 | * Use grouping to calculate and then plot the number of children born each year over time. 216 | * Plot the results as a line graph. 217 | 218 | ```{r} 219 | 220 | ``` 221 | 222 | 223 | ## Mutate 224 | 225 | ```{r} 226 | babynames %>% 227 | mutate(percent = round(prop * 100, 2)) 228 | ``` 229 | 230 | 231 | ## Your Turn 13 232 | 233 | Use `min_rank()` and `mutate()` to rank each row in `babynames` from largest `prop` to lowest `prop`. 234 | 235 | ```{r} 236 | 237 | ``` 238 | 239 | 240 | ## Your Turn 14 241 | 242 | * Compute each name's rank _within its year and sex_. 243 | * Then compute the median rank _for each combination of name and sex_, and arrange the results from highest median rank to lowest. 244 | 245 | ```{r} 246 | 247 | ``` 248 | 249 | 250 | ## Flights data 251 | ```{r} 252 | flights 253 | skim(flights) 254 | ``` 255 | 256 | 257 | ## Toy data 258 | 259 | ```{r} 260 | band <- tribble( 261 | ~name, ~band, 262 | "Mick", "Stones", 263 | "John", "Beatles", 264 | "Paul", "Beatles" 265 | ) 266 | 267 | instrument <- tribble( 268 | ~name, ~plays, 269 | "John", "guitar", 270 | "Paul", "bass", 271 | "Keith", "guitar" 272 | ) 273 | 274 | instrument2 <- tribble( 275 | ~artist, ~plays, 276 | "John", "guitar", 277 | "Paul", "bass", 278 | "Keith", "guitar" 279 | ) 280 | ``` 281 | 282 | 283 | ## Mutating joins 284 | 285 | ```{r} 286 | band %>% left_join(instrument, by = "name") 287 | ``` 288 | 289 | 290 | ## Your Turn 15 291 | 292 | Which airlines had the largest arrival delays? Complete the code below. 293 | 294 | 1. Join `airlines` to `flights` 295 | 2. Compute and order the average arrival delays by airline. Display full names, no codes. 296 | 297 | ```{r} 298 | flights %>% 299 | drop_na(arr_delay) %>% 300 | ___ %>% 301 | group_by(___) %>% 302 | ___ %>% 303 | arrange(___) 304 | ``` 305 | 306 | 307 | ## Different names 308 | 309 | ```{r} 310 | band %>% left_join(instrument2, by = c("name" = "artist")) 311 | ``` 312 | 313 | 314 | ## Your Turn 16 315 | 316 | How many airports in `airports` are serviced by flights originating in New York (i.e. flights in our dataset?) Notice that the column to join on is named `faa` in the **airports** data set and `dest` in the **flights** data set. 317 | 318 | 319 | ```{r} 320 | ___ %>% 321 | ___(___, by = ___) %>% 322 | distinct(___) 323 | ``` 324 | 325 | 326 | *** 327 | 328 | # Take aways 329 | 330 | * Extract variables with `select()` 331 | * Extract cases with `filter()` 332 | * Arrange cases, with `arrange()` 333 | 334 | * Make tables of summaries with `summarize()` 335 | * Make new variables, with `mutate()` 336 | * Do groupwise operations with `group_by()` 337 | 338 | * Connect operations with `%>%` 339 | 340 | * Use `left_join()`, `right_join()`, `full_join()`, or `inner_join()` to join datasets 341 | * Use `semi_join()` or `anti_join()` to filter datasets against each other 342 | -------------------------------------------------------------------------------- /03-Data-Types.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Data Types" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | ```{r setup, include = FALSE} 9 | library(tidyverse) 10 | library(lubridate) 11 | library(hms) 12 | library(babynames) 13 | library(nycflights13) 14 | ``` 15 | 16 | 17 | ## Your Turn 1 18 | 19 | Use `flights` to create `delayed`, the variable that displays whether a flight was delayed (`arr_delay > 0`). 20 | 21 | Then, remove all rows that contain an NA in `delayed`. 22 | 23 | Finally, create a summary table that shows: 24 | 25 | 1. How many flights were delayed? 26 | 2. What proportion of flights were delayed? 27 | 28 | ```{r} 29 | 30 | ``` 31 | 32 | 33 | ## Your Turn 2 34 | 35 | Fill in the blanks to: 36 | 37 | 1. Isolate the last letter of every name 38 | 2. and create a logical variable that displays whether the last letter is one of "a", "e", "i", "o", "u", or "y". 39 | 3. Use a weighted mean to calculate the proportion of children whose name ends in a vowel (by `year` and `sex`) 40 | 4. and then display the results as a line plot. 41 | 42 | ```{r} 43 | babynames %>% 44 | ___(last = ___, 45 | vowel = ___) %>% 46 | group_by(___) %>% 47 | ___(p_vowel = weighted.mean(vowel, n)) %>% 48 | ___(mapping = ___) + 49 | ___(mapping = ___) 50 | ``` 51 | 52 | 53 | ## Your Turn 3 54 | 55 | Repeat the previous exercise, some of whose code is below, to make a sensible graph of average TV consumption by marital status. 56 | 57 | ```{r} 58 | gss_cat %>% 59 | drop_na(___) %>% 60 | group_by(___) %>% 61 | summarize(___) %>% 62 | ggplot(mapping = ___) + 63 | geom_point() 64 | ``` 65 | 66 | 67 | ## Your Turn 4 68 | 69 | Do you think liberals or conservatives watch more TV? 70 | 71 | Compute average tv hours by party ID an then plot the results. 72 | 73 | ```{r} 74 | 75 | ``` 76 | 77 | 78 | ## Your Turn 5 79 | 80 | What is the best time of day to fly? 81 | 82 | Use the `hour` and `minute` variables in `flights` to compute the time of day for each flight as an hms. Then use a smooth line to plot the relationship between time of day and `arr_delay`. 83 | 84 | ```{r} 85 | 86 | ``` 87 | 88 | 89 | ## Your Turn 6 90 | 91 | Fill in the blanks to: 92 | 93 | 1. Extract the day of the week of each flight (as a full name) from `time_hour`. 94 | 2. Calculate the average `arr_delay` by day of the week. 95 | 3. Plot the results as a column chart (bar chart) with `geom_col()`. 96 | 97 | ```{r} 98 | flights %>% 99 | mutate(weekday = ___) %>% 100 | ___ %>% 101 | drop_na(arr_delay) %>% 102 | summarize(avg_delay = ___) %>% 103 | ggplot(mapping = mapping = aes(x = weekday, y = avg_delay)) + 104 | ___() 105 | ``` 106 | 107 | 108 | *** 109 | 110 | # Take Aways 111 | 112 | dplyr gives you three _general_ functions for manipulating data: `mutate()`, `summarize()`, and `group_by()`. Augment these with functions from the packages below, which focus on specific types of data. 113 | 114 | Package | Data Type 115 | --------- | -------- 116 | stringr | strings 117 | forcats | factors 118 | hms | times 119 | lubridate | dates and times 120 | 121 | -------------------------------------------------------------------------------- /04-Import.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Import Data" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(viridis) 13 | 14 | setwd("/Users/jakethompson/Documents/GIT/courses/tidyds-2019") 15 | ``` 16 | 17 | 18 | ## here() 19 | 20 | ```{r} 21 | library(here) 22 | 23 | here() 24 | here("slides") 25 | here("data", "nimbus.csv") 26 | 27 | dr_here() 28 | ``` 29 | 30 | 31 | ## Your Turn 1 32 | 33 | Find nimbus.csv on your server or computer. Then read it into an object. Then view the results. 34 | 35 | ```{r} 36 | nimbus <- ___ 37 | nimbus 38 | ``` 39 | 40 | 41 | ## tibbles 42 | 43 | ```{r} 44 | starwars 45 | as.data.frame(starwars) 46 | ``` 47 | 48 | 49 | ## Your Turn 2 50 | 51 | * Read in the `nimbus` data set 52 | * Set values of `.` to `NA` 53 | 54 | ```{r} 55 | nimbus <- read_csv(here("data", "nimbus.csv")) 56 | ``` 57 | 58 | 59 | ## Your Turn 3 60 | 61 | * Modify the code to specify `ozone` as integer values 62 | 63 | ```{r} 64 | nimbus <- read_csv(here("data", "nimbus.csv"), na = ".") 65 | ``` 66 | 67 | 68 | *** 69 | 70 | # Take Aways 71 | 72 | The readr package provides efficient functions for reading and saving common flat file data formats. The tibble package provides improvements to the default data frame behavior. 73 | 74 | Consider these packages for other types of data: 75 | 76 | Package | Reads 77 | ------------------------- | ----------------------------------- 78 | readr | most flat files (.csv, .tsv, etc.) 79 | readxl | excel files (.xls, .xlsx) 80 | haven | SPSS, Stata, and SAS files 81 | googlesheets, googledrive | Google Sheets and Google Drive 82 | feather | Data transfers between R and Python 83 | rvest | web pages (web scraping) 84 | sparklyr | data loaded into spark 85 | jsonlite | json 86 | xml2 | xml 87 | httr | web API's 88 | DBI | databases 89 | -------------------------------------------------------------------------------- /05-Tidy.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Tidy Data" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | 13 | # Toy data 14 | cases <- tribble( 15 | ~country, ~"2011", ~"2012", ~"2013", 16 | "FR", 7000, 6900, 7000, 17 | "DE", 5800, 6000, 6200, 18 | "US", 15000, 14000, 13000 19 | ) 20 | 21 | pollution <- tribble( 22 | ~city, ~size, ~amount, 23 | "New York", "large", 23, 24 | "New York", "small", 14, 25 | "London", "large", 22, 26 | "London", "small", 16, 27 | "Beijing", "large", 121, 28 | "Beijing", "small", 56 29 | ) 30 | 31 | scores <- tribble( 32 | ~name, ~house, ~score, 33 | "Ronald Weasley", "Gryffindor", 78, 34 | "Harry Potter", "Gryffindor", 85, 35 | "Hermione Granger", "Gryffindor", 100, 36 | "Justin Finch-Fletchley", "Hufflepuff", 87, 37 | "Hannah Abbot", "Hufflepuff", 92, 38 | "Susan Bones", "Hufflepuff", 93, 39 | "Anthony Goldstein", "Ravenclaw", 84, 40 | "Michael Corner", "Ravenclaw", 93, 41 | "Padma Patil", "Ravenclaw", 97, 42 | "Vincent Crabbe", "Slytherin", 61, 43 | "Gregory Goyle", "Slytherin", 61, 44 | "Draco Malfoy", "Slytherin", 92 45 | ) 46 | 47 | 48 | bp_systolic <- tribble( 49 | ~ subject_id, ~ time_1, ~ time_2, ~ time_3, 50 | 1, 120, 118, 121, 51 | 2, 125, 131, NA, 52 | 3, 141, NA, NA 53 | ) 54 | 55 | bp_systolic2 <- tribble( 56 | ~ subject_id, ~ time, ~ systolic, 57 | 1, 1, 120, 58 | 1, 2, 118, 59 | 1, 3, 121, 60 | 2, 1, 125, 61 | 2, 2, 131, 62 | 3, 1, 141 63 | ) 64 | ``` 65 | 66 | 67 | ## Tidy and untidy data 68 | 69 | `table1` is tidy: 70 | 71 | ```{r} 72 | table1 73 | ``` 74 | 75 | `table2` isn't tidy, the count column really contains two variables: 76 | 77 | ```{r} 78 | table2 79 | ``` 80 | 81 | 82 | ## Your Turn 1 83 | 84 | Is `bp_systolic` tidy? 85 | 86 | ```{r} 87 | bp_systolic 88 | ``` 89 | 90 | 91 | ## Your Turn 2 92 | 93 | Using `bp_systolic2` with `group_by()`, and `summarize()`: 94 | 95 | * Find the average systolic blood pressure for each subject 96 | * Find the last time each subject was measured 97 | 98 | ```{r} 99 | bp_systolic2 100 | ``` 101 | 102 | 103 | ## Your Turn 3 104 | 105 | On a sheet of paper, draw how the cases data set would look if it had the same values grouped into three columns: **country**, **year**, **n** 106 | 107 | 108 | ## Your Turn 4 109 | 110 | Use `pivot_longer()` to reorganize `table4a` into three columns: **country**, **year**, and **cases**. 111 | 112 | ```{r} 113 | table4a 114 | ``` 115 | 116 | 117 | ## Your Turn 5 118 | 119 | On a sheet of paper, draw how `pollution` would look if it had the same values grouped into three columns: **city**, **large**, **small** 120 | 121 | 122 | ## Your Turn 6 123 | 124 | Use `pivot_wider()` to reorganize `table2` into four columns: **country**, **year**, **cases**, and **population**. 125 | 126 | ```{r} 127 | table2 128 | ``` 129 | 130 | 131 | ## separate() and unite() 132 | 133 | ```{r} 134 | scores %>% 135 | separate(name, into = c("first", "last"), sep = " ") 136 | ``` 137 | 138 | ```{r} 139 | sep_scores <- scores %>% 140 | separate(name, into = c("first", "last"), sep = " ") 141 | sep_scores %>% 142 | unite("full_name", first, last, sep = " ") 143 | ``` 144 | 145 | 146 | *** 147 | 148 | # Take Aways 149 | 150 | Data comes in many formats but R prefers just one: _tidy data_. 151 | 152 | A data set is tidy if and only if: 153 | 154 | 1. Every variable is in its own column 155 | 2. Every observation is in its own row 156 | 3. Every value is in its own cell (which follows from the above) 157 | 158 | What is a variable and an observation may depend on your immediate goal. 159 | -------------------------------------------------------------------------------- /06-Case-Study-1.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Case Study: Friday the 13th Effect" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(fivethirtyeight) 13 | library(here) 14 | ``` 15 | 16 | 17 | ## Task 18 | 19 | Reproduce this figure from fivethirtyeight's article [*Some People Are Too Superstitious To Have A Baby On Friday The 13th*](https://fivethirtyeight.com/features/some-people-are-too-superstitious-to-have-a-baby-on-friday-the-13th/): 20 | 21 | ![](`r here("resources", "bialik-fridaythe13th-2.png")`) 22 | 23 | 24 | ## Data 25 | 26 | In the `fivethiryeight` package there are two datasets containing birth data, but for now let's just work with one, `US_births_1994_2003`. Note that since we have data from 1994-2003, our results may differ somewhat from the figure based on 1994-2014. 27 | 28 | 29 | ## Your Turn 1 30 | 31 | With your neighbor, brainstorm the steps needed to get the data in a form ready to make the plot. 32 | 33 | ```{r} 34 | US_births_1994_2003 35 | ``` 36 | 37 | 38 | ## Some overviews of the data 39 | 40 | Whole time series: 41 | 42 | ```{r} 43 | ggplot(US_births_1994_2003, aes(x = date, y = births)) + 44 | geom_line() 45 | ``` 46 | 47 | There is so much fluctuation it's really hard to see what is going on. 48 | 49 | Let's try just looking at one year: 50 | 51 | ```{r} 52 | US_births_1994_2003 %>% 53 | filter(year == 1994) %>% 54 | ggplot(mapping = aes(x = date, y = births)) + 55 | geom_line() 56 | ``` 57 | 58 | Strong weekly pattern accounts for most variation. 59 | 60 | 61 | ## Strategy 62 | 63 | Use the figure as a guide for what the data should like to make the final plot. We want to end up with something like: 64 | 65 | day_of_week | avg_diff_13 | 66 | ----------- | ----------- | 67 | Mon | | 68 | Tues | | 69 | Wed | | 70 | ... | ... | 71 | 72 | There is more than one way to get there, but we 73 | ll roughly follow this strategy: 74 | 75 | * Get just the data for the 6th, 13th, and 20th 76 | * Calculate variable of interest: 77 | * (For each month/year): 78 | * Find average births on 6th and 20th 79 | * Find _percentage difference_ between births on 13th and average births on 6th and 20th 80 | * Average _percent difference_ by day of the week 81 | * Create plot 82 | 83 | 84 | ## Your Turn 2 85 | 86 | Extract just the 6th, 13th and 20th of each month: 87 | 88 | ```{r} 89 | US_births_1994_2003 %>% 90 | select(-date) 91 | 92 | ``` 93 | 94 | 95 | ## Your Turn 3 96 | 97 | Which arrangement is tidy? 98 | 99 | **Option 1:** 100 | 101 | | year | month | date_of_month | day_of_week | births | 102 | | ----: | -----: | -------------: | :----------- | ------: | 103 | | 1994 | 1 | 6 | Thurs | 11406 | 104 | | 1994 | 1 | 13 | Thurs | 11212 | 105 | | 1994 | 1 | 20 | Thurs | 11682 | 106 | 107 | **Option 2:** 108 | 109 | | year | month | day_of_week | 6 | 13 | 20 | 110 | | ----: | -----: | :----------- | -----: | -----: | -----: | 111 | | 1994 | 1 | Thurs | 11406 | 11212 | 11682 | 112 | 113 | (**Hint:** think about our next step *"Find the percent difference between the 13th and the average of the 6th and 12th"*. In which layout will this be easier using our tidy tools?) 114 | 115 | **Solution**: Option 2, since then we can easily use `mutate()`. 116 | 117 | 118 | ## Your Turn 4 119 | 120 | Tidy the filtered data to have the days in columns. 121 | 122 | ```{r} 123 | US_births_1994_2003 %>% 124 | select(-date) %>% 125 | filter(date_of_month %in% c(6, 13, 20)) 126 | 127 | ``` 128 | 129 | 130 | ## Your Turn 5 131 | 132 | Now use `mutate()` to add columns for: 133 | 134 | * The average of the births on the 6th and 20th 135 | * The percentage difference between the number of births on the 13th and the average of the 6th and 20th 136 | 137 | ```{r} 138 | US_births_1994_2003 %>% 139 | select(-date) %>% 140 | filter(date_of_month %in% c(6, 13, 20)) %>% 141 | pivot_wider(names_from = date_of_month, values_from = births) 142 | 143 | ``` 144 | 145 | 146 | ## A little additional exploring 147 | 148 | Now we have a percent difference between the 13th and the 6th and 20th of each month, it's probably worth exploring a little (at the very least to check our calculations seem reasonable). 149 | 150 | To make it a little easier let's assign our current data to a variable 151 | 152 | ```{r} 153 | births_diff_13 <- US_births_1994_2003 %>% 154 | select(-date) %>% 155 | filter(date_of_month %in% c(6, 13, 20)) %>% 156 | spread(date_of_month, births) %>% 157 | mutate(avg_6_20 = (`6` + `20`)/2, 158 | diff_13 = (`13` - avg_6_20) / avg_6_20 * 100) 159 | ``` 160 | 161 | Then take a look: 162 | 163 | ```{r} 164 | births_diff_13 %>% 165 | ggplot(mapping = aes(day_of_week, diff_13)) + 166 | geom_point() 167 | ``` 168 | 169 | Looks like we are on the right path. There's a big outlier one Monday: 170 | 171 | ```{r} 172 | births_diff_13 %>% 173 | filter(day_of_week == "Mon", diff_13 > 10) 174 | ``` 175 | 176 | Seem's to be driven but a particularly low number of births on the 6th of Sep 1999. Maybe a holiday effect? Labour Day was of the 6th of September that year. 177 | 178 | 179 | ## Your Turn 6 180 | 181 | Summarize each day of the week to have mean of diff_13. 182 | 183 | Then, recreate the fivethirtyeight plot. 184 | 185 | ```{r} 186 | US_births_1994_2003 %>% 187 | select(-date) %>% 188 | filter(date_of_month %in% c(6, 13, 20)) %>% 189 | pivot_wider(names_from = date_of_month, values_from = births) %>% 190 | mutate(avg_6_20 = (`6` + `20`)/2, 191 | diff_13 = (`13` - avg_6_20) / avg_6_20 * 100) 192 | 193 | ``` 194 | 195 | 196 | ## Extra Challenges 197 | 198 | * If you wanted to use the `US_births_2000_2014` data instead, what would you need to change in the pipeline? How about using both `US_births_1994_2003` and `US_births_2000_2014`? 199 | 200 | * Try not removing the `date` column. At what point in the pipeline does it cause problems? Why? 201 | 202 | * Can you come up with an alternative way to investigate the Friday the 13th effect? Try it out! 203 | 204 | 205 | *** 206 | 207 | ## Takeaways 208 | 209 | The power of the tidyverse comes from being able to easily combine functions that do simple things well. 210 | -------------------------------------------------------------------------------- /07-Model.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Model Data" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(modelr) 13 | library(broom) 14 | 15 | wages <- heights %>% filter(income > 0) 16 | ``` 17 | 18 | 19 | ## Your Turn 1 20 | 21 | Fit the model on the slide and then examine the output. What does it look like? 22 | 23 | ```{r} 24 | mod_e <- lm(log(income) ~ education, data = wages) 25 | mod_e 26 | ``` 27 | 28 | 29 | ## Your Turn 2 30 | 31 | Use a pipe to model `log(income)` against `height`. Then use broom and dplyr functions to extract: 32 | 33 | 1. The **coefficient estimates** and their related statistics 34 | 2. The **adj.r.squared** and **p.value** for the overall model 35 | 36 | ```{r} 37 | mod_h <- wages %>% lm(___) 38 | ``` 39 | 40 | 41 | ## Your Turn 3 42 | 43 | Model `log(income)` against `education` _and_ `height`. Do the coefficients change? 44 | 45 | ```{r} 46 | mod_eh <- wages %>% lm(___) 47 | ``` 48 | 49 | 50 | ## Your Turn 4 51 | 52 | Model `log(income)` against `education` and `height` and `sex`. Can you interpret the coefficients? 53 | 54 | ```{r} 55 | mod_ehs <- wages %>% lm(___) 56 | ``` 57 | 58 | 59 | ## Your Turn 5 60 | 61 | Use a broom function and ggplot2 to make a line graph of `height` vs `.fitted` for our heights model, `mod_h`. 62 | 63 | _Bonus: Overlay the plot on the original data points._ 64 | 65 | ```{r} 66 | 67 | ``` 68 | 69 | 70 | ## Your Turn 6 71 | 72 | Repeat the process to make a line graph of `height` vs `.fitted` colored by `sex` for model `mod_ehs`. Are the results interpretable? Add `+ facet_wrap(~education)` to the end of your code. What happens? 73 | 74 | ```{r} 75 | 76 | ``` 77 | 78 | 79 | ## Your Turn 7 80 | 81 | Use one of `spread_predictions()` or `gather_predictions()` to make a line graph of `height` vs. `pred` colored by `model` for each of mod_h, mod_eh, and mod_ehs. Are the results interpretable? 82 | 83 | Add `+ facet_grid(sex ~ education)` to the end of your code. What happens? 84 | 85 | ```{r} 86 | 87 | ``` 88 | 89 | 90 | ## Your Turn 8 91 | 92 | Use one of `spread_residuals()` or `gather_residuals()` to make a scatter plot of `afqt` vs. `resid` for each of mod_e, mod_h, mod_eh, and mod_ehs. 93 | 94 | Use a faceting function to create a subplot for each model. 95 | 96 | ```{r} 97 | 98 | ``` 99 | 100 | 101 | *** 102 | 103 | # Take Aways 104 | 105 | * Use `glance()`, `tidy()`, and `augment()` from the **broom** package to return model values in a data frame. 106 | 107 | * Use `add_predictions()` or `spread_predictions()` or `gather_predictions()` from the **modelr** package to visualize predictions. 108 | 109 | * Use `add_residuals()` or `spread_residuals()` or `gather_residuals()` from the **modelr** package to visualize residuals. 110 | -------------------------------------------------------------------------------- /08-Iterate.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Iterate" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | 13 | # Toy data 14 | set.seed(9416) 15 | exams <- list( 16 | student1 = round(runif(10, 50, 100)), 17 | student2 = round(runif(10, 50, 100)), 18 | student3 = round(runif(10, 50, 100)), 19 | student4 = round(runif(10, 50, 100)), 20 | student5 = round(runif(10, 50, 100)) 21 | ) 22 | 23 | extra_credit <- list(0, 0, 10, 10, 15) 24 | ``` 25 | 26 | 27 | ## Your Turn 1 28 | 29 | What kind of object is `mod`? Why are models stored as this kind of object? 30 | 31 | ```{r} 32 | mod <- lm(price ~ carat + cut + color + clarity, data = diamonds) 33 | View(mod) 34 | ``` 35 | 36 | 37 | ## Quiz 38 | 39 | What's the difference between a list and an **atomic** vector? 40 | 41 | Atomic vectors are: "logical", "integer", "numeric" (synonym "double"), "complex", "character" and "raw" vectors. 42 | 43 | 44 | ## Your Turn 2 45 | 46 | Here is a list: 47 | 48 | ```{r} 49 | a_list <- list(nums = c(8, 9), 50 | log = TRUE, 51 | cha = c("a", "b", "c")) 52 | ``` 53 | 54 | Here are two subsetting commands. Do they return the same values? Run the code chunk above, _and then_ run the code chunks below to confirm 55 | 56 | ```{r} 57 | a_list["nums"] 58 | ``` 59 | 60 | ```{r} 61 | a_list$nums 62 | ``` 63 | 64 | 65 | ## Your Turn 3 66 | 67 | What will each of these return? Run the code chunks to confirm. 68 | 69 | ```{r} 70 | vec <- c(-2, -1, 0, 1, 2) 71 | abs(vec) 72 | ``` 73 | 74 | ```{r, error = TRUE} 75 | lst <- list(-2, -1, 0, 1, 2) 76 | abs(lst) 77 | ``` 78 | 79 | 80 | ## Your Turn 4 81 | 82 | Run the code in the chunks. What does it return? 83 | 84 | ```{r} 85 | list(student1 = mean(exams$student1), 86 | student2 = mean(exams$student2), 87 | student3 = mean(exams$student3), 88 | student4 = mean(exams$student4), 89 | student5 = mean(exams$student5)) 90 | ``` 91 | 92 | ```{r} 93 | map(exams, mean) 94 | ``` 95 | 96 | 97 | ## Your Turn 5 98 | 99 | Calculate the variance (`var()`) of each student’s exam grades. 100 | 101 | ```{r} 102 | exams 103 | ``` 104 | 105 | 106 | ## Your Turn 6 107 | 108 | Calculate the max grade (`max()`)for each student. Return the result as a vector. 109 | 110 | ```{r} 111 | exams 112 | ``` 113 | 114 | 115 | ## Your Turn 7 116 | 117 | Write a function that counts the best exam twice and then takes the average. Use it to grade all of the students. 118 | 119 | 1. Write code that solves the problem for a real object 120 | 2. Wrap the code in `function(){}` to save it 121 | 3. Add the name of the real object as the function argument 122 | 123 | ```{r} 124 | vec <- exams[[1]] 125 | 126 | 127 | ``` 128 | 129 | 130 | ## Your Turn 8 131 | 132 | Compute a final grade for each student, where the final grade is the average test score plus any `extra_credit` assigned to the student. Return the results as a double (i.e. numeric) vector. 133 | 134 | ```{r} 135 | 136 | ``` 137 | 138 | 139 | *** 140 | 141 | # Take Aways 142 | 143 | Lists are a useful way to organize data, but you need to arrange manually for functions to iterate over the elements of a list. 144 | 145 | You can do this with the `map()` family of functions in the purrr package. 146 | 147 | To write a function, 148 | 149 | 1. Write code that solves the problem for a real object 150 | 2. Wrap the code in `function(){}` to save it 151 | 3. Add the name of the real object as the function argument 152 | 153 | This sequence will help prevent bugs in your code (and reduce the time you spend correcting bugs). 154 | -------------------------------------------------------------------------------- /09-Organize.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Organize with List Columns" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(broom) 13 | library(modelr) 14 | library(rsample) 15 | library(gapminder) 16 | library(tidydscompanion) 17 | library(here) 18 | ``` 19 | 20 | 21 | ## Your Turn 1 22 | 23 | How has life expectancy changed over time? 24 | 25 | * Make a line plot of lifeExp vs. year grouped by country. 26 | * Set alpha to 0.2, to see the results better. 27 | 28 | ```{r} 29 | gapminder 30 | ``` 31 | 32 | 33 | ## Quiz 34 | 35 | How is a data frame/tibble similar to a list? 36 | 37 | 38 | ## Quiz 39 | 40 | If one of the elements of a list can be another list, can one of the columns of a data frame be another list? 41 | 42 | 43 | ## Your Turn 2 44 | 45 | Run this chunk: 46 | 47 | ```{r} 48 | gapminder_nested <- gapminder %>% 49 | group_by(country) %>% 50 | nest() 51 | 52 | fit_model <- function(df) lm(lifeExp ~ year, data = df) 53 | 54 | gapminder_nested <- gapminder_nested %>% 55 | mutate(model = map(data, fit_model)) 56 | 57 | get_rsq <- function(mod) glance(mod)$r.squared 58 | 59 | gapminder_nested <- gapminder_nested %>% 60 | mutate(r.squared = map_dbl(model, get_rsq)) 61 | ``` 62 | 63 | Then filter `gapminder_nested` to find the countries with r.squared less than 0.5. 64 | 65 | ```{r} 66 | 67 | ``` 68 | 69 | 70 | ## Your Turn 3 71 | 72 | Edit the code in the chunk provided to instead find and plot countries with a slope above 0.6 years/year. 73 | 74 | ```{r} 75 | get_slope <- function(mod) { 76 | tidy(mod) %>% filter(term == "year") %>% pull(estimate) 77 | } 78 | 79 | # Add new column with r-sqaured 80 | gapminder_nested <- gapminder_nested %>% 81 | mutate(r.squared = map_dbl(model, get_rsq)) 82 | 83 | # filter big slope countries 84 | poor_fit <- gapminder_nested %>% 85 | filter(r.squared < 0.5) 86 | 87 | # unnest and plot result 88 | unnest(poor_fit, data) %>% 89 | ggplot(aes(x = year, y = lifeExp)) + 90 | geom_line(aes(color = country)) 91 | ``` 92 | 93 | 94 | ## Your Turn 4 95 | 96 | **Challenge:** 97 | 98 | 1. Create your own copy of `gapminder_nested` and then add one more list column: `output` which contains the output of `augment()` for each model. 99 | 2. Plot the residulals against time for the countries with small r-squared. 100 | 101 | ```{r} 102 | 103 | ``` 104 | 105 | 106 | ## Bootstrapping Comparisons 107 | 108 | ```{r} 109 | mean(admission$gre_v[admission$gender == "Male"]) - 110 | mean(admission$gre_v[admission$gender == "Female"]) 111 | 112 | mean_diff <- function(splits) { 113 | x <- analysis(splits) 114 | mean(x$gre_v[x$gender == "Male"]) - 115 | mean(x$gre_v[x$gender == "Female"]) 116 | } 117 | 118 | set.seed(32011) 119 | grev_gender <- admission %>% 120 | bootstraps(times = 100) %>% 121 | mutate(grev_diff = map_dbl(splits, mean_diff)) 122 | 123 | ggplot(grev_gender, mapping = aes(x = grev_diff)) + 124 | geom_density() 125 | 126 | quantile(grev_gender$grev_diff, probs = c(0.025, 0.500, 0.975)) 127 | ``` 128 | 129 | 130 | ## Your Turn 5 131 | 132 | Is there a difference between the percentage of male and female applicants admitted? 133 | 134 | First, write some code to calculate the difference between the percentage of male applicants admitted, and the percentage of female applicants admitted. 135 | 136 | ```{r} 137 | 138 | ``` 139 | 140 | Now, turn that code into a function, `pct_diff()`. 141 | 142 | ```{r} 143 | pct_diff <- function(splits) { 144 | x <- analysis(splits) 145 | 146 | } 147 | ``` 148 | 149 | Generate 100 bootstraps, and apply the `pct_diff()` function to each bootstrapped sample. 150 | 151 | ```{r} 152 | set.seed(32011) 153 | admit_gender <- admission %>% 154 | ___ %>% 155 | mutate(admit_diff = ___) 156 | ``` 157 | 158 | Finally, create a density plot of the difference, and create a 95% interval. 159 | 160 | ```{r} 161 | ggplot(admit_gender, mapping = aes(___)) + 162 | ___() 163 | 164 | quantile(___, probs = c(0.025, 0.500, 0.975)) 165 | ``` 166 | 167 | 168 | *** 169 | 170 | # Take away 171 | 172 | * Store objects and other lists in list-columns of data frames 173 | * Use `bootsraps()` to recreate resampled data objects 174 | * Use `vfold_cv()` to create analysis and assessment sub-samples of your data to assessment model performance 175 | * Use `purrr` to iterate over bootstrapped samples and cross validation folds 176 | -------------------------------------------------------------------------------- /10-Case-Study-2.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Case Study 2 - Solution" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup} 11 | library(tidyverse) 12 | library(broom) 13 | library(rsample) 14 | library(tidydscompanion) 15 | library(here) 16 | ``` 17 | 18 | 19 | ## Task 20 | 21 | Reproduce these figures below, created from an analysis of the `admission` data. 22 | 23 | ![](`r here("resources", "density.png")`) 24 | 25 | ![](`r here("resources", "confint.png")`) 26 | 27 | 28 | ## Data 29 | 30 | In the `tidydscompanion` package there is a data set containing simulated admissions data for a graduate program. 31 | 32 | 33 | ## Your Turn 1 34 | 35 | What are the steps needed to create these plots? 36 | 37 | 38 | ## You Turn 2 39 | 40 | * Create a cross validation resampling with 10 folds and 10 repeats 41 | * Save the object as `models` 42 | 43 | ```{r} 44 | set.seed(32011) 45 | models <- admission 46 | 47 | ``` 48 | 49 | 50 | ## Your Turn 3 51 | 52 | * Complete the function that takes in a `splits` and `formula` and returns predictions 53 | * Model should be fit using the **analysis** data 54 | * Predictions should be made on the **assessment** data 55 | * Use `mutate` to add columns to the predictions 56 | * Predicted acceptance is `1` if `.fitted` is greater than 0.5, `0` otherwise 57 | * Prediction is corrected if predicted value (from above) is the same as `admit` 58 | 59 | ```{r} 60 | holdout_results <- function(splits, formula) { 61 | # Fit the model to the analysis set 62 | mod <- glm(___, data = ___, family = binomial) 63 | 64 | # Save the assessment data 65 | holdout <- ___ 66 | 67 | # `augment` will save the predictions with the holdout data set 68 | res <- broom::augment(___, newdata = ___, type.predict = "response") %>% 69 | mutate(prediction = ___, 70 | correct = ___) 71 | 72 | # Return the assessment data set with the additional columns 73 | res 74 | } 75 | ``` 76 | 77 | 78 | ## Your Turn 4 79 | 80 | * Use `mutate` and `map` to use the `holdout_results` function to fit each model to the cross validation sets 81 | * Formulas for each model have already been saved for your convenience 82 | 83 | ```{r} 84 | empty <- as.formula(admit ~ 1) 85 | academics <- as.formula(admit ~ gre_v * gre_q + gre_w + gpa) 86 | full <- as.formula(admit ~ gre_v * gre_q + gre_w + gpa + gender) 87 | 88 | all_mods <- models %>% 89 | mutate(empty_mod = map(___, ___, formula = ___), 90 | acadm_mod = map(___, ___, formula = ___), 91 | compl_mod = map(___, ___, formula = ___)) 92 | ``` 93 | 94 | 95 | ## Your Turn 5 96 | 97 | * Tidy the data so that the models are all in one column (`results`) with an identifier column (`model`) 98 | * Expand the `results` so we can do calculations on the predictions 99 | 100 | ```{r} 101 | all_preds <- all_mods %>% 102 | select(-splits) 103 | 104 | ``` 105 | 106 | 107 | ## Your Turn 6 108 | 109 | * Calculate the percent of applicants correctly classified for each repeat, fold, and model 110 | * Plot the distributions for each model 111 | 112 | ```{r} 113 | all_preds 114 | 115 | ``` 116 | 117 | 118 | ## Your Turn 7 119 | 120 | * Calculate the Log Loss for each repeat, fold, and model 121 | 122 | ```{r} 123 | all_preds 124 | 125 | ``` 126 | 127 | 128 | ## Your Turn 8 129 | 130 | * For each model, calculate the median, 2.5, and 97.5 percentiles of the Log Loss 131 | * 95% confidence interval 132 | * Plot the results using `geom_errorbarh` 133 | * Hint: look at the required aesthetics using `?geom_errorbarh` 134 | 135 | ```{r} 136 | all_preds %>% 137 | group_by(id, id2, model) %>% 138 | summarize(logloss = -1 * mean((admit * log(.fitted)) + ((1 - admit) * log(1 - .fitted)))) 139 | 140 | ``` 141 | 142 | 143 | ## Extra Challenge 144 | 145 | How would you add multiple error bars fo varying confidence intervals? 146 | 147 | Are there other methods we could use to measure the predictive accuracy of the models? 148 | 149 | 150 | ## Final Graphics 151 | 152 | ```{r include = FALSE} 153 | library(hrbrthemes) 154 | library(colorblindr) 155 | ``` 156 | 157 | ### Correct Classification 158 | 159 | ```{r} 160 | all_preds %>% 161 | group_by(id, id2, model) %>% 162 | summarize(pct_cor = mean(correct)) %>% 163 | ggplot(aes(x = pct_cor)) + 164 | geom_density(aes(color = model, fill = model), alpha = 0.4) + 165 | scale_color_OkabeIto(limits = c("compl_mod", "acadm_mod", "empty_mod"), 166 | breaks = c("empty_mod", "acadm_mod", "compl_mod"), 167 | labels = c("Empty", "Academics", "Full")) + 168 | scale_fill_OkabeIto(limits = c("compl_mod", "acadm_mod", "empty_mod"), 169 | breaks = c("empty_mod", "acadm_mod", "compl_mod"), 170 | labels = c("Empty", "Academics", "Full")) + 171 | expand_limits(x = c(0.6, 0.9)) + 172 | scale_x_percent() + 173 | labs(x = "Correct Classification Rate", y = "Density", color = "Model", 174 | fill = "Model", 175 | title = "Distribution of Applicants Correctly Classified", 176 | subtitle = "Using 10-fold cross validation with 10 repeats") + 177 | theme_ipsum_ps() + 178 | theme(legend.position = "bottom") + 179 | guides(fill = guide_legend(override.aes = list(alpha = 1))) 180 | ``` 181 | 182 | ### Log Loss 183 | 184 | ```{r} 185 | all_preds %>% 186 | group_by(id, id2, model) %>% 187 | summarize(logloss = -1 * mean((admit * log(.fitted)) + ((1 - admit) * log(1 - .fitted)))) %>% 188 | group_by(model) %>% 189 | summarize(med = median(logloss), 190 | lb_99 = quantile(logloss, prob = 0.005), 191 | ub_99 = quantile(logloss, prob = 0.995), 192 | lb_95 = quantile(logloss, prob = 0.025), 193 | ub_95 = quantile(logloss, prob = 0.975), 194 | lb_80 = quantile(logloss, prob = 0.100), 195 | ub_80 = quantile(logloss, prob = 0.900)) %>% 196 | pivot_longer(contains("_"), names_to = "boundary", values_to = "value") %>% 197 | separate(boundary, into = c("bound", "level")) %>% 198 | pivot_wider(names_from = bound, values_from = value) %>% 199 | mutate(level = paste0(level, "%")) %>% 200 | ggplot() + 201 | geom_errorbarh( 202 | aes(y = model, xmin = lb, xmax = ub, color = level, size = level), 203 | height = 0 204 | ) + 205 | geom_point(aes(x = med, y = model), color = "#E69F00", size = 3) + 206 | expand_limits(x = c(0.2, 0.7)) + 207 | scale_y_discrete(limits = c("compl_mod", "acadm_mod", "empty_mod"), 208 | labels = c("Full", "Academics", "Empty")) + 209 | scale_color_manual(values = c( 210 | `80%` = darken("#56B4E9", .2), 211 | `95%` = "#56B4E9", 212 | `99%` = lighten("#56B4E9", .4) 213 | )) + 214 | scale_size_manual(values = c(`80%` = 4, `95%` = 3, `99%` = 2)) + 215 | labs(x = "Median Log Loss", y = NULL, size = "Confidence Level", 216 | color = "Confidence Level", 217 | title = "Log Loss of Competing Models", 218 | subtitle = "Using 10-fold cross validation with 10 repeats") + 219 | theme_ipsum_ps() + 220 | theme(legend.position = "bottom") 221 | ``` 222 | -------------------------------------------------------------------------------- /11-Communicate/analyze-share-repro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: html_document 3 | --- 4 | 5 | Analyze. Share. Reproduce. and do it all with R Markdown. Your data tells a story. Tell it with R Markdown. Turn your analyses into high[^fred] quality[^2] documents, reports, presentations and dashboards - and don't forget to drink some H20 while you do that. R Markdown documents are fully reproducible. Use a productive notebook interface to weave together narrative text and code to produce elegantly formatted output. Use multiple languages including R, Python, and SQL. Do you need still need convincing to use R Markdown? See what a friend once said: I used to use Sweave, and get terrible headaches. Now I use R Markdown, and life is much more pleasant. Or coffee, whatever floats your boat. This link should point to http://rmarkdown.rstudio.com/r_notebooks.html. 6 | 7 | [^fred]: my footnote 8 | [^2]: another footnote 9 | -------------------------------------------------------------------------------- /11-Communicate/case-study-2-report/bib/knit.bib: -------------------------------------------------------------------------------- 1 | @Manual{R-bookdown, 2 | title = {bookdown: Authoring Books and Technical Documents with R Markdown}, 3 | author = {Yihui Xie}, 4 | year = {2019}, 5 | note = {R package version 0.10}, 6 | url = {https://CRAN.R-project.org/package=bookdown}, 7 | } 8 | @Manual{R-rmarkdown, 9 | title = {rmarkdown: Dynamic Documents for R}, 10 | author = {JJ Allaire and Yihui Xie and Jonathan McPherson and Javier Luraschi and Kevin Ushey and Aron Atkins and Hadley Wickham and Joe Cheng and Winston Chang and Richard Iannone}, 11 | year = {2019}, 12 | note = {R package version 1.12}, 13 | url = {https://CRAN.R-project.org/package=rmarkdown}, 14 | } 15 | -------------------------------------------------------------------------------- /11-Communicate/case-study-2-report/bib/packages.bib: -------------------------------------------------------------------------------- 1 | @Manual{R-base, 2 | title = {R: A Language and Environment for Statistical Computing}, 3 | author = {{R Core Team}}, 4 | organization = {R Foundation for Statistical Computing}, 5 | address = {Vienna, Austria}, 6 | year = {2019}, 7 | url = {https://www.R-project.org/}, 8 | } 9 | @Manual{R-broom, 10 | title = {broom: Convert Statistical Analysis Objects into Tidy Tibbles}, 11 | author = {David Robinson and Alex Hayes}, 12 | year = {2019}, 13 | note = {R package version 0.5.2}, 14 | url = {https://CRAN.R-project.org/package=broom}, 15 | } 16 | @Manual{R-colorblindr, 17 | title = {colorblindr: Simulate colorblindness in R figures}, 18 | author = {Claire D. McWhite and Claus O. Wilke}, 19 | note = {R package version 0.1.0}, 20 | url = {https://github.com/clauswilke/colorblindr}, 21 | year = {2019}, 22 | } 23 | @Manual{R-colorspace, 24 | title = {colorspace: A Toolbox for Manipulating and Assessing Colors and Palettes}, 25 | author = {Ross Ihaka and Paul Murrell and Kurt Hornik and Jason C. Fisher and Reto Stauffer and Claus O. Wilke and Claire D. McWhite and Achim Zeileis}, 26 | year = {2019}, 27 | note = {R package version 1.4-1}, 28 | url = {https://CRAN.R-project.org/package=colorspace}, 29 | } 30 | @Manual{R-dplyr, 31 | title = {dplyr: A Grammar of Data Manipulation}, 32 | author = {Hadley Wickham and Romain François and Lionel Henry and Kirill Müller}, 33 | year = {2019}, 34 | note = {R package version 0.8.0.1}, 35 | url = {https://CRAN.R-project.org/package=dplyr}, 36 | } 37 | @Manual{R-forcats, 38 | title = {forcats: Tools for Working with Categorical Variables (Factors)}, 39 | author = {Hadley Wickham}, 40 | year = {2019}, 41 | note = {R package version 0.4.0}, 42 | url = {https://CRAN.R-project.org/package=forcats}, 43 | } 44 | @Manual{R-ggplot2, 45 | title = {ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics}, 46 | author = {Hadley Wickham and Winston Chang and Lionel Henry and Thomas Lin Pedersen and Kohske Takahashi and Claus Wilke and Kara Woo and Hiroaki Yutani}, 47 | year = {2019}, 48 | note = {http://ggplot2.tidyverse.org, https://github.com/tidyverse/ggplot2}, 49 | } 50 | @Manual{R-hrbrthemes, 51 | title = {hrbrthemes: Additional Themes, Theme Components and Utilities for 'ggplot2'}, 52 | author = {Bob Rudis}, 53 | year = {2019}, 54 | note = {R package version 0.6.0}, 55 | url = {https://CRAN.R-project.org/package=hrbrthemes}, 56 | } 57 | @Manual{R-knitr, 58 | title = {knitr: A General-Purpose Package for Dynamic Report Generation in R}, 59 | author = {Yihui Xie}, 60 | year = {2019}, 61 | note = {R package version 1.22}, 62 | url = {https://CRAN.R-project.org/package=knitr}, 63 | } 64 | @Manual{R-purrr, 65 | title = {purrr: Functional Programming Tools}, 66 | author = {Lionel Henry and Hadley Wickham}, 67 | year = {2019}, 68 | note = {R package version 0.3.2}, 69 | url = {https://CRAN.R-project.org/package=purrr}, 70 | } 71 | @Manual{R-readr, 72 | title = {readr: Read Rectangular Text Data}, 73 | author = {Hadley Wickham and Jim Hester and Romain Francois}, 74 | year = {2018}, 75 | note = {R package version 1.3.1}, 76 | url = {https://CRAN.R-project.org/package=readr}, 77 | } 78 | @Manual{R-rsample, 79 | title = {rsample: General Resampling Infrastructure}, 80 | author = {Max Kuhn and Hadley Wickham}, 81 | year = {2019}, 82 | note = {R package version 0.0.4}, 83 | url = {https://CRAN.R-project.org/package=rsample}, 84 | } 85 | @Manual{R-stringr, 86 | title = {stringr: Simple, Consistent Wrappers for Common String Operations}, 87 | author = {Hadley Wickham}, 88 | year = {2019}, 89 | note = {R package version 1.4.0}, 90 | url = {https://CRAN.R-project.org/package=stringr}, 91 | } 92 | @Manual{R-tibble, 93 | title = {tibble: Simple Data Frames}, 94 | author = {Kirill Müller and Hadley Wickham}, 95 | year = {2019}, 96 | note = {R package version 2.1.1}, 97 | url = {https://CRAN.R-project.org/package=tibble}, 98 | } 99 | @Manual{R-tidydscompanion, 100 | title = {tidydscompanion: A Companion Package For Using R And The Tidyverse For Data 101 | Science}, 102 | author = {W. Jake Thompson}, 103 | year = {2019}, 104 | note = {R package version 0.0.1}, 105 | url = {https://github.com/wjakethompson/jayhawkdown}, 106 | } 107 | @Manual{R-tidyr, 108 | title = {tidyr: Easily Tidy Data with 'spread()' and 'gather()' Functions}, 109 | author = {Hadley Wickham and Lionel Henry}, 110 | year = {2019}, 111 | note = {http://tidyr.tidyverse.org, https://github.com/tidyverse/tidyr}, 112 | } 113 | @Manual{R-tidyverse, 114 | title = {tidyverse: Easily Install and Load the 'Tidyverse'}, 115 | author = {Hadley Wickham}, 116 | year = {2017}, 117 | note = {R package version 1.2.1}, 118 | url = {https://CRAN.R-project.org/package=tidyverse}, 119 | } 120 | -------------------------------------------------------------------------------- /11-Communicate/case-study-2-report/bib/references.bib: -------------------------------------------------------------------------------- 1 | @book{gre, 2 | author = {{Educational Testing Service}}, 3 | year = {2012}, 4 | title = {The official guide to the {GRE} revised general test}, 5 | edition = {2nd}, 6 | address = {New York, NY}, 7 | publisher = {McGraw-Hill}, 8 | isbn = {9780071791236} 9 | } 10 | -------------------------------------------------------------------------------- /11-Communicate/case-study-2-report/csl/apa.csl: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /11-Communicate/chunk-basics.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "R in Markdown" 3 | author: "Jake Thompson" 4 | date: "May 24, 2019" 5 | output: 6 | html_document: 7 | highlight: pygments 8 | theme: cosmo 9 | --- 10 | 11 | ```{r setup} 12 | library(tidyverse) 13 | ``` 14 | 15 | ## Preliminary tasks 16 | 17 | 1. It's a good practice to load the major packages for a document in a "setup" or "load packages" chunk. But the output from that chunk is a poor way for a reader to start off with a document. 18 | * Add a chunk option to `setup` to suppress the output. (Hint: the option begins with `i`.) 19 | 2. Add an inline R chunk to your document so that the current date/time show up here: XXXX. Try to put the date in italics. 20 | 21 | ### Add a plot chunk 22 | 23 | 3. Make chunk producing a simple plot using the `mtcars` data frame built into R. 24 | 4. Add a label to the chunk in (3). 25 | 5. Change the chunk options (echo, eval, include, message, warning) to explore what changes in the output. Then, decide on an appropriate option for each of the chunks. Compare your choices to your neighbors'. 26 | 6. Turn the following into a proper chunk for R evaluation rather than just display of code. 27 | 28 | ``` 29 | names(mtcars) 30 | mtcars %>% 31 | summarize_all(median) 32 | ``` 33 | 34 | 7. Returning to the chunk you made in (6), what does the option collapse (set to TRUE or FALSE) do? What is the default setting for this option? 35 | 36 | ## Inline code 37 | 38 | Typical uses of inline code ... 39 | 40 | 8. Avoiding hard-coding of numbers. (They become out of date.) 41 | - Bad: Our analysis involved 51 cars. 42 | - Better: Our analysis involved `r ` cars. 43 | 44 | ```{r car_t_test, echo = FALSE} 45 | mod <- lm(mpg ~ disp + cyl, data = mtcars) 46 | ``` 47 | 48 | 9. Reporting of results calculated elsewhere. 49 | - Bad: Keeping displacement constant, an additional cylinder is associated with a loss of about 1.6 miles-per-gallon. 50 | - Better: ...with a `r ` of about `r ` miles-per-gallon. 51 | 52 | **Stretch goal**: Update the date field in the YAML so that the date at the time of knitting the document is printed. (Hint: You can put YAML strings in quotation marks.) 53 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Attribution 4.0 International 2 | 3 | ======================================================================= 4 | 5 | Creative Commons Corporation ("Creative Commons") is not a law firm and 6 | does not provide legal services or legal advice. Distribution of 7 | Creative Commons public licenses does not create a lawyer-client or 8 | other relationship. Creative Commons makes its licenses and related 9 | information available on an "as-is" basis. Creative Commons gives no 10 | warranties regarding its licenses, any material licensed under their 11 | terms and conditions, or any related information. Creative Commons 12 | disclaims all liability for damages resulting from their use to the 13 | fullest extent possible. 14 | 15 | Using Creative Commons Public Licenses 16 | 17 | Creative Commons public licenses provide a standard set of terms and 18 | conditions that creators and other rights holders may use to share 19 | original works of authorship and other material subject to copyright 20 | and certain other rights specified in the public license below. The 21 | following considerations are for informational purposes only, are not 22 | exhaustive, and do not form part of our licenses. 23 | 24 | Considerations for licensors: Our public licenses are 25 | intended for use by those authorized to give the public 26 | permission to use material in ways otherwise restricted by 27 | copyright and certain other rights. Our licenses are 28 | irrevocable. Licensors should read and understand the terms 29 | and conditions of the license they choose before applying it. 30 | Licensors should also secure all rights necessary before 31 | applying our licenses so that the public can reuse the 32 | material as expected. Licensors should clearly mark any 33 | material not subject to the license. This includes other CC- 34 | licensed material, or material used under an exception or 35 | limitation to copyright. More considerations for licensors: 36 | wiki.creativecommons.org/Considerations_for_licensors 37 | 38 | Considerations for the public: By using one of our public 39 | licenses, a licensor grants the public permission to use the 40 | licensed material under specified terms and conditions. If 41 | the licensor's permission is not necessary for any reason--for 42 | example, because of any applicable exception or limitation to 43 | copyright--then that use is not regulated by the license. Our 44 | licenses grant only permissions under copyright and certain 45 | other rights that a licensor has authority to grant. Use of 46 | the licensed material may still be restricted for other 47 | reasons, including because others have copyright or other 48 | rights in the material. A licensor may make special requests, 49 | such as asking that all changes be marked or described. 50 | Although not required by our licenses, you are encouraged to 51 | respect those requests where reasonable. More considerations 52 | for the public: 53 | wiki.creativecommons.org/Considerations_for_licensees 54 | 55 | ======================================================================= 56 | 57 | Creative Commons Attribution 4.0 International Public License 58 | 59 | By exercising the Licensed Rights (defined below), You accept and agree 60 | to be bound by the terms and conditions of this Creative Commons 61 | Attribution 4.0 International Public License ("Public License"). To the 62 | extent this Public License may be interpreted as a contract, You are 63 | granted the Licensed Rights in consideration of Your acceptance of 64 | these terms and conditions, and the Licensor grants You such rights in 65 | consideration of benefits the Licensor receives from making the 66 | Licensed Material available under these terms and conditions. 67 | 68 | 69 | Section 1 -- Definitions. 70 | 71 | a. Adapted Material means material subject to Copyright and Similar 72 | Rights that is derived from or based upon the Licensed Material 73 | and in which the Licensed Material is translated, altered, 74 | arranged, transformed, or otherwise modified in a manner requiring 75 | permission under the Copyright and Similar Rights held by the 76 | Licensor. For purposes of this Public License, where the Licensed 77 | Material is a musical work, performance, or sound recording, 78 | Adapted Material is always produced where the Licensed Material is 79 | synched in timed relation with a moving image. 80 | 81 | b. Adapter's License means the license You apply to Your Copyright 82 | and Similar Rights in Your contributions to Adapted Material in 83 | accordance with the terms and conditions of this Public License. 84 | 85 | c. Copyright and Similar Rights means copyright and/or similar rights 86 | closely related to copyright including, without limitation, 87 | performance, broadcast, sound recording, and Sui Generis Database 88 | Rights, without regard to how the rights are labeled or 89 | categorized. For purposes of this Public License, the rights 90 | specified in Section 2(b)(1)-(2) are not Copyright and Similar 91 | Rights. 92 | 93 | d. Effective Technological Measures means those measures that, in the 94 | absence of proper authority, may not be circumvented under laws 95 | fulfilling obligations under Article 11 of the WIPO Copyright 96 | Treaty adopted on December 20, 1996, and/or similar international 97 | agreements. 98 | 99 | e. Exceptions and Limitations means fair use, fair dealing, and/or 100 | any other exception or limitation to Copyright and Similar Rights 101 | that applies to Your use of the Licensed Material. 102 | 103 | f. Licensed Material means the artistic or literary work, database, 104 | or other material to which the Licensor applied this Public 105 | License. 106 | 107 | g. Licensed Rights means the rights granted to You subject to the 108 | terms and conditions of this Public License, which are limited to 109 | all Copyright and Similar Rights that apply to Your use of the 110 | Licensed Material and that the Licensor has authority to license. 111 | 112 | h. Licensor means the individual(s) or entity(ies) granting rights 113 | under this Public License. 114 | 115 | i. Share means to provide material to the public by any means or 116 | process that requires permission under the Licensed Rights, such 117 | as reproduction, public display, public performance, distribution, 118 | dissemination, communication, or importation, and to make material 119 | available to the public including in ways that members of the 120 | public may access the material from a place and at a time 121 | individually chosen by them. 122 | 123 | j. Sui Generis Database Rights means rights other than copyright 124 | resulting from Directive 96/9/EC of the European Parliament and of 125 | the Council of 11 March 1996 on the legal protection of databases, 126 | as amended and/or succeeded, as well as other essentially 127 | equivalent rights anywhere in the world. 128 | 129 | k. You means the individual or entity exercising the Licensed Rights 130 | under this Public License. Your has a corresponding meaning. 131 | 132 | 133 | Section 2 -- Scope. 134 | 135 | a. License grant. 136 | 137 | 1. Subject to the terms and conditions of this Public License, 138 | the Licensor hereby grants You a worldwide, royalty-free, 139 | non-sublicensable, non-exclusive, irrevocable license to 140 | exercise the Licensed Rights in the Licensed Material to: 141 | 142 | a. reproduce and Share the Licensed Material, in whole or 143 | in part; and 144 | 145 | b. produce, reproduce, and Share Adapted Material. 146 | 147 | 2. Exceptions and Limitations. For the avoidance of doubt, where 148 | Exceptions and Limitations apply to Your use, this Public 149 | License does not apply, and You do not need to comply with 150 | its terms and conditions. 151 | 152 | 3. Term. The term of this Public License is specified in Section 153 | 6(a). 154 | 155 | 4. Media and formats; technical modifications allowed. The 156 | Licensor authorizes You to exercise the Licensed Rights in 157 | all media and formats whether now known or hereafter created, 158 | and to make technical modifications necessary to do so. The 159 | Licensor waives and/or agrees not to assert any right or 160 | authority to forbid You from making technical modifications 161 | necessary to exercise the Licensed Rights, including 162 | technical modifications necessary to circumvent Effective 163 | Technological Measures. For purposes of this Public License, 164 | simply making modifications authorized by this Section 2(a) 165 | (4) never produces Adapted Material. 166 | 167 | 5. Downstream recipients. 168 | 169 | a. Offer from the Licensor -- Licensed Material. Every 170 | recipient of the Licensed Material automatically 171 | receives an offer from the Licensor to exercise the 172 | Licensed Rights under the terms and conditions of this 173 | Public License. 174 | 175 | b. No downstream restrictions. You may not offer or impose 176 | any additional or different terms or conditions on, or 177 | apply any Effective Technological Measures to, the 178 | Licensed Material if doing so restricts exercise of the 179 | Licensed Rights by any recipient of the Licensed 180 | Material. 181 | 182 | 6. No endorsement. Nothing in this Public License constitutes or 183 | may be construed as permission to assert or imply that You 184 | are, or that Your use of the Licensed Material is, connected 185 | with, or sponsored, endorsed, or granted official status by, 186 | the Licensor or others designated to receive attribution as 187 | provided in Section 3(a)(1)(A)(i). 188 | 189 | b. Other rights. 190 | 191 | 1. Moral rights, such as the right of integrity, are not 192 | licensed under this Public License, nor are publicity, 193 | privacy, and/or other similar personality rights; however, to 194 | the extent possible, the Licensor waives and/or agrees not to 195 | assert any such rights held by the Licensor to the limited 196 | extent necessary to allow You to exercise the Licensed 197 | Rights, but not otherwise. 198 | 199 | 2. Patent and trademark rights are not licensed under this 200 | Public License. 201 | 202 | 3. To the extent possible, the Licensor waives any right to 203 | collect royalties from You for the exercise of the Licensed 204 | Rights, whether directly or through a collecting society 205 | under any voluntary or waivable statutory or compulsory 206 | licensing scheme. In all other cases the Licensor expressly 207 | reserves any right to collect such royalties. 208 | 209 | 210 | Section 3 -- License Conditions. 211 | 212 | Your exercise of the Licensed Rights is expressly made subject to the 213 | following conditions. 214 | 215 | a. Attribution. 216 | 217 | 1. If You Share the Licensed Material (including in modified 218 | form), You must: 219 | 220 | a. retain the following if it is supplied by the Licensor 221 | with the Licensed Material: 222 | 223 | i. identification of the creator(s) of the Licensed 224 | Material and any others designated to receive 225 | attribution, in any reasonable manner requested by 226 | the Licensor (including by pseudonym if 227 | designated); 228 | 229 | ii. a copyright notice; 230 | 231 | iii. a notice that refers to this Public License; 232 | 233 | iv. a notice that refers to the disclaimer of 234 | warranties; 235 | 236 | v. a URI or hyperlink to the Licensed Material to the 237 | extent reasonably practicable; 238 | 239 | b. indicate if You modified the Licensed Material and 240 | retain an indication of any previous modifications; and 241 | 242 | c. indicate the Licensed Material is licensed under this 243 | Public License, and include the text of, or the URI or 244 | hyperlink to, this Public License. 245 | 246 | 2. You may satisfy the conditions in Section 3(a)(1) in any 247 | reasonable manner based on the medium, means, and context in 248 | which You Share the Licensed Material. For example, it may be 249 | reasonable to satisfy the conditions by providing a URI or 250 | hyperlink to a resource that includes the required 251 | information. 252 | 253 | 3. If requested by the Licensor, You must remove any of the 254 | information required by Section 3(a)(1)(A) to the extent 255 | reasonably practicable. 256 | 257 | 4. If You Share Adapted Material You produce, the Adapter's 258 | License You apply must not prevent recipients of the Adapted 259 | Material from complying with this Public License. 260 | 261 | 262 | Section 4 -- Sui Generis Database Rights. 263 | 264 | Where the Licensed Rights include Sui Generis Database Rights that 265 | apply to Your use of the Licensed Material: 266 | 267 | a. for the avoidance of doubt, Section 2(a)(1) grants You the right 268 | to extract, reuse, reproduce, and Share all or a substantial 269 | portion of the contents of the database; 270 | 271 | b. if You include all or a substantial portion of the database 272 | contents in a database in which You have Sui Generis Database 273 | Rights, then the database in which You have Sui Generis Database 274 | Rights (but not its individual contents) is Adapted Material; and 275 | 276 | c. You must comply with the conditions in Section 3(a) if You Share 277 | all or a substantial portion of the contents of the database. 278 | 279 | For the avoidance of doubt, this Section 4 supplements and does not 280 | replace Your obligations under this Public License where the Licensed 281 | Rights include other Copyright and Similar Rights. 282 | 283 | 284 | Section 5 -- Disclaimer of Warranties and Limitation of Liability. 285 | 286 | a. UNLESS OTHERWISE SEPARATELY UNDERTAKEN BY THE LICENSOR, TO THE 287 | EXTENT POSSIBLE, THE LICENSOR OFFERS THE LICENSED MATERIAL AS-IS 288 | AND AS-AVAILABLE, AND MAKES NO REPRESENTATIONS OR WARRANTIES OF 289 | ANY KIND CONCERNING THE LICENSED MATERIAL, WHETHER EXPRESS, 290 | IMPLIED, STATUTORY, OR OTHER. THIS INCLUDES, WITHOUT LIMITATION, 291 | WARRANTIES OF TITLE, MERCHANTABILITY, FITNESS FOR A PARTICULAR 292 | PURPOSE, NON-INFRINGEMENT, ABSENCE OF LATENT OR OTHER DEFECTS, 293 | ACCURACY, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT 294 | KNOWN OR DISCOVERABLE. WHERE DISCLAIMERS OF WARRANTIES ARE NOT 295 | ALLOWED IN FULL OR IN PART, THIS DISCLAIMER MAY NOT APPLY TO YOU. 296 | 297 | b. TO THE EXTENT POSSIBLE, IN NO EVENT WILL THE LICENSOR BE LIABLE 298 | TO YOU ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION, 299 | NEGLIGENCE) OR OTHERWISE FOR ANY DIRECT, SPECIAL, INDIRECT, 300 | INCIDENTAL, CONSEQUENTIAL, PUNITIVE, EXEMPLARY, OR OTHER LOSSES, 301 | COSTS, EXPENSES, OR DAMAGES ARISING OUT OF THIS PUBLIC LICENSE OR 302 | USE OF THE LICENSED MATERIAL, EVEN IF THE LICENSOR HAS BEEN 303 | ADVISED OF THE POSSIBILITY OF SUCH LOSSES, COSTS, EXPENSES, OR 304 | DAMAGES. WHERE A LIMITATION OF LIABILITY IS NOT ALLOWED IN FULL OR 305 | IN PART, THIS LIMITATION MAY NOT APPLY TO YOU. 306 | 307 | c. The disclaimer of warranties and limitation of liability provided 308 | above shall be interpreted in a manner that, to the extent 309 | possible, most closely approximates an absolute disclaimer and 310 | waiver of all liability. 311 | 312 | 313 | Section 6 -- Term and Termination. 314 | 315 | a. This Public License applies for the term of the Copyright and 316 | Similar Rights licensed here. However, if You fail to comply with 317 | this Public License, then Your rights under this Public License 318 | terminate automatically. 319 | 320 | b. Where Your right to use the Licensed Material has terminated under 321 | Section 6(a), it reinstates: 322 | 323 | 1. automatically as of the date the violation is cured, provided 324 | it is cured within 30 days of Your discovery of the 325 | violation; or 326 | 327 | 2. upon express reinstatement by the Licensor. 328 | 329 | For the avoidance of doubt, this Section 6(b) does not affect any 330 | right the Licensor may have to seek remedies for Your violations 331 | of this Public License. 332 | 333 | c. For the avoidance of doubt, the Licensor may also offer the 334 | Licensed Material under separate terms or conditions or stop 335 | distributing the Licensed Material at any time; however, doing so 336 | will not terminate this Public License. 337 | 338 | d. Sections 1, 5, 6, 7, and 8 survive termination of this Public 339 | License. 340 | 341 | 342 | Section 7 -- Other Terms and Conditions. 343 | 344 | a. The Licensor shall not be bound by any additional or different 345 | terms or conditions communicated by You unless expressly agreed. 346 | 347 | b. Any arrangements, understandings, or agreements regarding the 348 | Licensed Material not stated herein are separate from and 349 | independent of the terms and conditions of this Public License. 350 | 351 | 352 | Section 8 -- Interpretation. 353 | 354 | a. For the avoidance of doubt, this Public License does not, and 355 | shall not be interpreted to, reduce, limit, restrict, or impose 356 | conditions on any use of the Licensed Material that could lawfully 357 | be made without permission under this Public License. 358 | 359 | b. To the extent possible, if any provision of this Public License is 360 | deemed unenforceable, it shall be automatically reformed to the 361 | minimum extent necessary to make it enforceable. If the provision 362 | cannot be reformed, it shall be severed from this Public License 363 | without affecting the enforceability of the remaining terms and 364 | conditions. 365 | 366 | c. No term or condition of this Public License will be waived and no 367 | failure to comply consented to unless expressly agreed to by the 368 | Licensor. 369 | 370 | d. Nothing in this Public License constitutes or may be interpreted 371 | as a limitation upon, or waiver of, any privileges and immunities 372 | that apply to the Licensor or You, including from the legal 373 | processes of any jurisdiction or authority. 374 | 375 | 376 | ======================================================================= 377 | 378 | Creative Commons is not a party to its public 379 | licenses. Notwithstanding, Creative Commons may elect to apply one of 380 | its public licenses to material it publishes and in those instances 381 | will be considered the “Licensor.” The text of the Creative Commons 382 | public licenses is dedicated to the public domain under the CC0 Public 383 | Domain Dedication. Except for the limited purpose of indicating that 384 | material is shared under a Creative Commons public license or as 385 | otherwise permitted by the Creative Commons policies published at 386 | creativecommons.org/policies, Creative Commons does not authorize the 387 | use of the trademark "Creative Commons" or any other trademark or logo 388 | of Creative Commons without its prior written consent including, 389 | without limitation, in connection with any unauthorized modifications 390 | to any of its public licenses or any other arrangements, 391 | understandings, or agreements concerning use of licensed material. For 392 | the avoidance of doubt, this paragraph does not form part of the 393 | public licenses. 394 | 395 | Creative Commons may be contacted at creativecommons.org. 396 | 397 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | ```{r setup, include = FALSE} 6 | library(fontawesome) 7 | ``` 8 | 9 | This is the repo for *"Using R and the tidyverse for Data Science"* given at the 2019 Summer Statistical Institute in May 2019. 10 | 11 | ## Description 12 | 13 | This workshop is designed for those who want to learn how to use R to analyze data. The material is based on Hadley Wickham and Garrett Grolemund's [*R for Data Science*](https://r4ds.had.co.nz/index.html). We'll talk about how to conduct a complete data analysis from data import to final reporting in R using a suite of packages known as the [**tidyverse**](https://tidyverse.org). The two goals of this workshop are: 1) learn how to use R to answer questions about our data; and 2) write code that is human readable and reproducible. We will also talk about how to share our code and analyses with others. 14 | 15 | ## Software Requirements 16 | 17 | In order to install the workshop materials (e.g., slides, exercises), you'll need **a laptop that can access the internet** (wifi will be available). Before the workshop, install the following: 18 | 19 | 1. A recent version of R (~3.6.0), which is available for free at [cran.r-project.org](http://www.cran.r-project.org) 20 | 2. A recent version of RStudio IDE (~1.2.1335), available for free at [www.rstudio.com/download](http://www.rstudio.com/download) 21 | 3. The set of relevant R packages, which you can install by connecting to the internet, opening RStudio, and running the code in `setup.R`. 22 | 23 | More detailed instructions can be found on the [workshop website](https://tidy-ds.wjakethompson.com/prework/local/). Don't forget to bring your power cord! 24 | 25 | ## Instructor Info 26 | 27 | Jake Thompson 28 | 29 | * Website: [wjakethompson.com](https://wjakethompson.com) 30 | * GitHub: [wjakethompson](https://github.com/wjakethompson) 31 | * Twitter: [\@wjakethompson](https://twitter.com/wjakethompson) 32 | 33 | 34 | ## License 35 | 36 | Creative Commons License 37 | 38 | *Using R and the tidyverse for Data Science* by [Jake Thompson](https://wjakethompson.com) is licensed under a Creative Commons Attribution 4.0 International License. Based on the work of [Garrett Grolemund](https://github.com/rstudio-education/master-the-tidyverse), [Charlotte Wickham](https://github.com/cwickham/data-science-in-tidyverse), and [Amelia McNamara](https://github.com/AmeliaMN/data-science-in-tidyverse). 39 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | This is the repo for *“Using R and the tidyverse for Data Science”* 3 | given at the 2019 Summer Statistical Institute in May 2019. 4 | 5 | ## Description 6 | 7 | This workshop is designed for those who want to learn how to use R to 8 | analyze data. The material is based on Hadley Wickham and Garrett 9 | Grolemund’s [*R for Data Science*](https://r4ds.had.co.nz/index.html). 10 | We’ll talk about how to conduct a complete data analysis from data 11 | import to final reporting in R using a suite of packages known as the 12 | [**tidyverse**](https://tidyverse.org). The two goals of this workshop 13 | are: 1) learn how to use R to answer questions about our data; and 2) 14 | write code that is human readable and reproducible. We will also talk 15 | about how to share our code and analyses with others. 16 | 17 | ## Software Requirements 18 | 19 | In order to install the workshop materials (e.g., slides, exercises), 20 | you’ll need **a laptop that can access the internet** (wifi will be 21 | available). Before the workshop, install the following: 22 | 23 | 1. A recent version of R (~3.6.0), which is available for free at 24 | [cran.r-project.org](http://www.cran.r-project.org) 25 | 2. A recent version of RStudio IDE (~1.2.1335), available for free at 26 | [www.rstudio.com/download](http://www.rstudio.com/download) 27 | 3. The set of relevant R packages, which you can install by connecting 28 | to the internet, opening RStudio, and running the code in `setup.R`. 29 | 30 | More detailed instructions can be found on the [workshop 31 | website](https://tidy-ds.wjakethompson.com/prework/local/). Don’t forget 32 | to bring your power cord\! 33 | 34 | ## Instructor Info 35 | 36 | Jake Thompson 37 | 38 | - Website: [wjakethompson.com](https://wjakethompson.com) 39 | - GitHub: [wjakethompson](https://github.com/wjakethompson) 40 | - Twitter: 41 | [@wjakethompson](https://twitter.com/wjakethompson) 42 | 43 | ## License 44 | 45 | Creative Commons License 46 | 47 | *Using R and the tidyverse for Data Science* by [Jake 48 | Thompson](https://wjakethompson.com) is licensed under a 49 | Creative 50 | Commons Attribution 4.0 International License. Based on the work of 51 | [Garrett 52 | Grolemund](https://github.com/rstudio-education/master-the-tidyverse), 53 | [Charlotte 54 | Wickham](https://github.com/cwickham/data-science-in-tidyverse), and 55 | [Amelia 56 | McNamara](https://github.com/AmeliaMN/data-science-in-tidyverse). 57 | -------------------------------------------------------------------------------- /cheatsheets/data-import.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/data-import.pdf -------------------------------------------------------------------------------- /cheatsheets/data-transformation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/data-transformation.pdf -------------------------------------------------------------------------------- /cheatsheets/data-visualization.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/data-visualization.pdf -------------------------------------------------------------------------------- /cheatsheets/factors.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/factors.pdf -------------------------------------------------------------------------------- /cheatsheets/lubridate.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/lubridate.pdf -------------------------------------------------------------------------------- /cheatsheets/purrr.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/purrr.pdf -------------------------------------------------------------------------------- /cheatsheets/rmarkdown-reference.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/rmarkdown-reference.pdf -------------------------------------------------------------------------------- /cheatsheets/rmarkdown.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/rmarkdown.pdf -------------------------------------------------------------------------------- /cheatsheets/rstudio-ide.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/rstudio-ide.pdf -------------------------------------------------------------------------------- /cheatsheets/strings.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/cheatsheets/strings.pdf -------------------------------------------------------------------------------- /resources/bialik-fridaythe13th-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/resources/bialik-fridaythe13th-2.png -------------------------------------------------------------------------------- /resources/confint.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/resources/confint.png -------------------------------------------------------------------------------- /resources/density.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/resources/density.png -------------------------------------------------------------------------------- /resources/rstudio-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/resources/rstudio-logo.png -------------------------------------------------------------------------------- /setup.R: -------------------------------------------------------------------------------- 1 | # install packages from CRAN --------------------------------------------------- 2 | cran_pkgs <- c("tidyverse", "remotes") 3 | install.packages(cran_pkgs, repos = "https://cran.rstudio.com/", 4 | dependencies = TRUE) 5 | 6 | 7 | # install packages from GitHub ------------------------------------------------- 8 | github_pkgs <- c("wjakethompson/tidydscompanion") 9 | remotes::install_github(github_pkgs, dependencies = TRUE, upgrade = TRUE) 10 | -------------------------------------------------------------------------------- /slides/00-Preliminaries.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/00-Preliminaries.pdf -------------------------------------------------------------------------------- /slides/01-Visualize.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/01-Visualize.pdf -------------------------------------------------------------------------------- /slides/02-Transform.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/02-Transform.pdf -------------------------------------------------------------------------------- /slides/03-Data-Types.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/03-Data-Types.pdf -------------------------------------------------------------------------------- /slides/04-Import.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/04-Import.pdf -------------------------------------------------------------------------------- /slides/05-Tidy.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/05-Tidy.pdf -------------------------------------------------------------------------------- /slides/06-Case-Study-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/06-Case-Study-1.pdf -------------------------------------------------------------------------------- /slides/07-Model.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/07-Model.pdf -------------------------------------------------------------------------------- /slides/08-Iterate.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/08-Iterate.pdf -------------------------------------------------------------------------------- /slides/09-Organize.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/09-Organize.pdf -------------------------------------------------------------------------------- /slides/10-Case-Study-2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/10-Case-Study-2.pdf -------------------------------------------------------------------------------- /slides/11-Communicate.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/11-Communicate.pdf -------------------------------------------------------------------------------- /slides/12-Wrapping-Up.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/slides/12-Wrapping-Up.pdf -------------------------------------------------------------------------------- /solutions/01-Visualize-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Data Visualization - Solutions" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ## Setup 11 | 12 | The first chunk in an R Notebook is usually titled "setup," and by convention includes the R packages you want to load. Remember, in order to use an R package you have to run some `library()` code every session. Execute these lines of code to load the packages. 13 | 14 | ```{r setup, include = FALSE} 15 | library(tidyverse) 16 | library(fivethirtyeight) 17 | ``` 18 | 19 | 20 | ## Bechdel test data 21 | 22 | We're going to start by playing with data collected by the website FiveThirtyEight on movies and [the Bechdel test](https://en.wikipedia.org/wiki/Bechdel_test). 23 | 24 | To begin, let's just preview our data. There are a couple ways to do that. One is just to type the name of the data and execute it like a piece of code. 25 | 26 | ```{r} 27 | bechdel 28 | ``` 29 | 30 | Notice that you can page through to see more of the dataset. 31 | 32 | Sometimes, people prefer to see their data in a more spreadsheet-like format, and RStudio provides a way to do that. Go to the Console and type `View(bechdel)` to see the data preview. 33 | 34 | (An aside-- `View` is a special function. Since it makes something happen in the RStudio interface, it doesn't work properly in R Notebooks. Most R functions have names that start with lowercase letters, so the uppercase "V" is there to remind you of its special status.) 35 | 36 | 37 | ## Consider 38 | What relationship do you expect to see between movie budget (budget) and domestic gross(domgross)? 39 | 40 | 41 | ## Your Turn 1 42 | 43 | Run the code on the slide to make a graph. Pay strict attention to spelling, capitalization, and parentheses! 44 | 45 | ```{r} 46 | ggplot(data = bechdel) + 47 | geom_point(mapping = aes(x = budget, y = domgross)) 48 | ``` 49 | 50 | 51 | ## Your Turn 2 52 | 53 | Add `color`, `size`, `alpha`, and `shape` aesthetics to your graph. Experiment. 54 | 55 | ```{r} 56 | ggplot(data = bechdel) + 57 | geom_point(mapping = aes(x = budget, y = domgross, color = clean_test)) 58 | 59 | ggplot(bechdel) + 60 | geom_point(mapping = aes(x = budget, y = domgross, size = clean_test)) 61 | ggplot(bechdel) + 62 | geom_point(mapping = aes(x = budget, y = domgross, shape = clean_test)) 63 | ggplot(bechdel) + 64 | geom_point(mapping = aes(x = budget, y = domgross, alpha = clean_test)) 65 | ``` 66 | 67 | 68 | ## Set vs map 69 | 70 | ```{r} 71 | ggplot(bechdel) + 72 | geom_point(mapping = aes(x = budget, y = domgross), color="blue") 73 | ``` 74 | 75 | 76 | ## Your Turn 3 77 | 78 | Replace this scatterplot with one that draws boxplots. Use the cheatsheet. Try your best guess. 79 | 80 | ```{r} 81 | ggplot(data = bechdel) + 82 | geom_point(mapping = aes(x = clean_test, y = budget)) 83 | 84 | ggplot(data = bechdel) + 85 | geom_boxplot(mapping = aes(x = clean_test, y = budget)) 86 | ``` 87 | 88 | 89 | ## Your Turn 4 90 | 91 | Make a histogram of the `budget` variable from `bechdel`. 92 | 93 | ```{r} 94 | ggplot(bechdel) + 95 | geom_histogram(mapping = aes(x = budget)) 96 | ``` 97 | 98 | 99 | ## Your Turn 5 100 | 101 | Make a density plot of `budget` colored by `clean_test`. 102 | 103 | ```{r} 104 | ggplot(data = bechdel) + 105 | geom_density(mapping = aes(x = budget)) 106 | 107 | ggplot(data = bechdel) + 108 | geom_density(mapping = aes(x = budget, color = clean_test)) 109 | ``` 110 | 111 | 112 | ## Your Turn 6 113 | 114 | Make a barchart of `clean_test` colored by `clean_test`. 115 | 116 | ```{r} 117 | ggplot(data=bechdel) + 118 | geom_bar(mapping = aes(x = clean_test, color = clean_test)) 119 | 120 | ggplot(data=bechdel) + 121 | geom_bar(mapping = aes(x = clean_test, fill = clean_test)) 122 | ``` 123 | 124 | 125 | ## Your Turn 7 126 | 127 | Predict what this code will do. Then run it. 128 | 129 | ```{r} 130 | ggplot(bechdel) + 131 | geom_point(mapping = aes(budget, domgross)) + 132 | geom_smooth(mapping = aes(budget, domgross)) 133 | ``` 134 | 135 | 136 | ## global vs local 137 | 138 | ```{r} 139 | ggplot(data = bechdel, mapping = aes(x = budget, y = domgross)) + 140 | geom_point(mapping = aes(color = clean_test)) + 141 | geom_smooth() 142 | ``` 143 | 144 | ```{r} 145 | ggplot(data = bechdel, mapping = aes(x = budget, y = domgross)) + 146 | geom_point(mapping = aes(color = clean_test)) + 147 | geom_smooth(data = filter(bechdel, clean_test == "ok")) 148 | ``` 149 | 150 | 151 | ## Your Turn 8 152 | 153 | Add a position adjustment to this plot to compare the frequency of test results across decades. 154 | 155 | ```{r} 156 | ggplot(data = bechdel, mapping = aes(x = decade_code)) + 157 | geom_bar(mapping = aes(fill = clean_test), position = "fill") 158 | ``` 159 | 160 | 161 | ## Saving plots 162 | 163 | Save the last plot. If you run your `ggsave()` code inside this notebook, the image will be saved in the same directory as your .Rmd file but if you run `ggsave()` in the Console it will be in your working directory. You can manually set the directory with the `path` argument. 164 | 165 | ```{r} 166 | ggsave("my-plot.png", width = 8, height = 6, units = "in", dpi = "retina") 167 | ``` 168 | 169 | *** 170 | 171 | 172 | # Take aways 173 | 174 | You can use this code template to make thousands of graphs with **ggplot2**. 175 | 176 | ```{r eval = FALSE} 177 | ggplot(data = ) + 178 | (mapping = aes(), 179 | stat = , position = ) + 180 | + 181 | + 182 | 183 | ``` 184 | -------------------------------------------------------------------------------- /solutions/02-Transform-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Data Transformation - Solutions" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(babynames) 13 | library(nycflights13) 14 | library(skimr) 15 | ``` 16 | 17 | 18 | ## Babynames 19 | 20 | ```{r} 21 | babynames 22 | skim(babynames) 23 | ``` 24 | 25 | 26 | ## Your Turn 1 27 | 28 | Run the `skim_with()` command, and then try skimming babynames again to see how the output is different 29 | 30 | ```{r} 31 | skim_with(integer = list(p25 = NULL, p75=NULL)) 32 | skim(babynames) 33 | ``` 34 | 35 | 36 | ## Your Turn 2 37 | 38 | Alter the code to select just the `n` column: 39 | 40 | ```{r} 41 | select(babynames, n) 42 | ``` 43 | 44 | 45 | ## `select()` helpers 46 | 47 | ```{r} 48 | select(storms, name:pressure) 49 | select(storms, -c(name, pressure)) 50 | select(storms, starts_with("w")) 51 | select(storms, ends_with("e")) 52 | select(storms, contains("d")) 53 | select(storms, matches("^.{4}$")) 54 | select(storms, one_of(c("name", "names", "Name"))) 55 | select(storms, num_range("x", 1:5)) 56 | ``` 57 | 58 | 59 | ## Consider 60 | 61 | Which of these is NOT a way to select the `name` and `n` columns together? 62 | 63 | ```{r} 64 | select(babynames, -c(year, sex, prop)) 65 | select(babynames, name:n) 66 | select(babynames, starts_with("n")) 67 | select(babynames, ends_with("n")) 68 | ``` 69 | 70 | 71 | ## Your Turn 3 72 | 73 | Show: 74 | 75 | * All of the names where prop is greater than or equal to 0.08 76 | * All of the children named "Daenerys" 77 | * All of the names that have a missing value for `n` 78 | 79 | ```{r} 80 | filter(babynames, prop >= 0.08) 81 | filter(babynames, name == "Daenerys") 82 | filter(babynames, is.na(n)) 83 | ``` 84 | 85 | 86 | ## Your Turn 4 87 | 88 | Use Boolean operators to alter the code below to return only the rows that contain: 89 | 90 | * Girls named Sea 91 | * Names that were used by exactly 5 or 6 children in 1880 92 | * Names that are one of Acura, Lexus, or Yugo 93 | 94 | ```{r} 95 | filter(babynames, name == "Sea", sex == "F") 96 | filter(babynames, n == 5 | n == 6, year == 1880) 97 | filter(babynames, name %in% c("Acura", "Lexus", "Yugo")) 98 | ``` 99 | 100 | 101 | ## Your Turn 5 102 | 103 | Arrange babynames by `n`. Add `prop` as a second (tie breaking) variable to arrange on. Can you tell what the smallest value of `n` is? 104 | 105 | ```{r} 106 | arrange(babynames, n, prop) 107 | ``` 108 | 109 | 110 | ## Your Turn 6 111 | 112 | * Use `desc()` to find the names with the highest prop. 113 | * Then, use `desc()` to find the names with the highest n. 114 | 115 | ```{r} 116 | arrange(babynames, desc(prop)) 117 | arrange(babynames, desc(n)) 118 | ``` 119 | 120 | 121 | ## Steps and the pipe 122 | 123 | ```{r} 124 | babynames %>% 125 | filter(year == 2015, sex == "M") %>% 126 | select(name, n) %>% 127 | arrange(desc(n)) 128 | ``` 129 | 130 | 131 | ## Your Turn 7 132 | 133 | Use `%>%` to write a sequence of functions that: 134 | 135 | 1. Filter babynames to just the girls that were born in 2015 136 | 2. Select the `name` and `n` columns 137 | 3. Arrange the results so that the most popular names are near the top. 138 | 139 | ```{r} 140 | babynames %>% 141 | filter(year == 2015, sex == "F") %>% 142 | select(name, n) %>% 143 | arrange(desc(n)) 144 | ``` 145 | 146 | 147 | ## Your Turn 8 148 | 149 | 1. Trim `babynames` to just the rows that contain your `name` and your `sex` 150 | 2. Trim the result to just the columns that will appear in your graph (not strictly necessary, but useful practice) 151 | 3. Plot the results as a line graph with `year` on the x axis and `prop` on the y axis, colored by `sex` 152 | 153 | ```{r} 154 | babynames %>% 155 | filter(name == "Jake") %>% 156 | select(year, prop, sex) %>% 157 | ggplot(mapping = aes(x = year, y = prop)) + 158 | geom_line(mapping = aes(color = sex)) 159 | ``` 160 | 161 | 162 | ## Your Turn 9 163 | 164 | Use `summarize()` to compute three statistics about the data: 165 | 166 | 1. The first (minimum) year in the dataset 167 | 2. The last (maximum) year in the dataset 168 | 3. The total number of children represented in the data 169 | 170 | ```{r} 171 | babynames %>% 172 | summarize(first = min(year), 173 | last = max(year), 174 | total = sum(n)) 175 | ``` 176 | 177 | 178 | ## Your Turn 10 179 | 180 | Extract the rows where `name == "Khaleesi"`. Then use `summarize()` to find: 181 | 182 | 1. The total number of children named Khaleesi 183 | 2. The first year Khaleesi appeared in the data 184 | 185 | ```{r} 186 | babynames %>% 187 | filter(name == "Khaleesi") %>% 188 | summarize(total = sum(n), first = min(year)) 189 | ``` 190 | 191 | 192 | ## Toy data for transforming 193 | 194 | ```{r} 195 | # Toy dataset to use 196 | pollution <- tribble( 197 | ~city, ~size, ~amount, 198 | "New York", "large", 23, 199 | "New York", "small", 14, 200 | "London", "large", 22, 201 | "London", "small", 16, 202 | "Beijing", "large", 121, 203 | "Beijing", "small", 56 204 | ) 205 | ``` 206 | 207 | 208 | ## Summarize 209 | 210 | ```{r} 211 | pollution %>% 212 | summarize(mean = mean(amount), sum = sum(amount), n = n()) 213 | ``` 214 | 215 | ```{r} 216 | pollution %>% 217 | group_by(city) %>% 218 | summarize(mean = mean(amount), sum = sum(amount), n = n()) 219 | ``` 220 | 221 | 222 | ## Your Turn 11 223 | 224 | Use `group_by()`, `summarize()`, and `arrange()` to display the ten most popular names. Compute popularity as the total number of children of a single gender given a name. 225 | 226 | ```{r} 227 | babynames %>% 228 | group_by(name, sex) %>% 229 | summarize(total = sum(n)) %>% 230 | arrange(desc(total)) 231 | ``` 232 | 233 | ```{r} 234 | babynames %>% 235 | group_by(name, sex) %>% 236 | summarize(total = sum(n)) %>% 237 | arrange(desc(total)) %>% 238 | ungroup() %>% 239 | slice(1:10) %>% 240 | ggplot() + 241 | geom_col(mapping = aes(x = fct_reorder(name, desc(total)), y = total, 242 | fill = sex)) + 243 | theme_bw() + 244 | scale_fill_brewer() + 245 | labs(x = "name") 246 | ``` 247 | 248 | 249 | ## Your Turn 12 250 | 251 | * Use grouping to calculate and then plot the number of children born each year over time. 252 | * Plot the results as a line graph. 253 | 254 | ```{r} 255 | babynames %>% 256 | group_by(year) %>% 257 | summarize(n_children = sum(n)) %>% 258 | ggplot() + 259 | geom_line(mapping = aes(x = year, y = n_children)) 260 | ``` 261 | 262 | 263 | ## Mutate 264 | 265 | ```{r} 266 | babynames %>% 267 | mutate(percent = round(prop * 100, 2)) 268 | ``` 269 | 270 | 271 | ## Your Turn 13 272 | 273 | Use `min_rank()` and `mutate()` to rank each row in `babynames` from largest `prop` to lowest `prop`. 274 | 275 | ```{r} 276 | babynames %>% 277 | mutate(rank = min_rank(desc(prop))) 278 | ``` 279 | 280 | 281 | ## Your Turn 14 282 | 283 | * Compute each name's rank _within its year and sex_. 284 | * Then compute the median rank _for each combination of name and sex_, and arrange the results from highest median rank to lowest. 285 | 286 | ```{r} 287 | babynames %>% 288 | group_by(year, sex) %>% 289 | mutate(rank = min_rank(desc(prop))) %>% 290 | group_by(name, sex) %>% 291 | summarize(score = median(rank)) %>% 292 | arrange(score) 293 | ``` 294 | 295 | 296 | ## Flights data 297 | ```{r} 298 | flights 299 | skim(flights) 300 | ``` 301 | 302 | 303 | ## Toy data 304 | 305 | ```{r} 306 | band <- tribble( 307 | ~name, ~band, 308 | "Mick", "Stones", 309 | "John", "Beatles", 310 | "Paul", "Beatles" 311 | ) 312 | 313 | instrument <- tribble( 314 | ~name, ~plays, 315 | "John", "guitar", 316 | "Paul", "bass", 317 | "Keith", "guitar" 318 | ) 319 | 320 | instrument2 <- tribble( 321 | ~artist, ~plays, 322 | "John", "guitar", 323 | "Paul", "bass", 324 | "Keith", "guitar" 325 | ) 326 | ``` 327 | 328 | 329 | ## Mutating joins 330 | 331 | ```{r} 332 | band %>% left_join(instrument, by = "name") 333 | ``` 334 | 335 | 336 | ## Your Turn 15 337 | 338 | Which airlines had the largest arrival delays? Complete the code below. 339 | 340 | 1. Join `airlines` to `flights` 341 | 2. Compute and order the average arrival delays by airline. Display full names, no codes. 342 | 343 | ```{r} 344 | flights %>% 345 | drop_na(arr_delay) %>% 346 | left_join(airlines, by = "carrier") %>% 347 | group_by(name) %>% 348 | summarize(delay = mean(arr_delay)) %>% 349 | arrange(delay) 350 | ``` 351 | 352 | 353 | ## Different names 354 | 355 | ```{r} 356 | band %>% left_join(instrument2, by = c("name" = "artist")) 357 | ``` 358 | 359 | 360 | ## Your Turn 16 361 | 362 | How many airports in `airports` are serviced by flights originating in New York (i.e. flights in our dataset?) Notice that the column to join on is named `faa` in the **airports** data set and `dest` in the **flights** data set. 363 | 364 | 365 | ```{r} 366 | airports %>% 367 | semi_join(flights, by = c("faa" = "dest")) %>% 368 | distinct(faa) 369 | ``` 370 | 371 | 372 | *** 373 | 374 | # Take aways 375 | 376 | * Extract variables with `select()` 377 | * Extract cases with `filter()` 378 | * Arrange cases, with `arrange()` 379 | 380 | * Make tables of summaries with `summarize()` 381 | * Make new variables, with `mutate()` 382 | * Do groupwise operations with `group_by()` 383 | 384 | * Connect operations with `%>%` 385 | 386 | * Use `left_join()`, `right_join()`, `full_join()`, or `inner_join()` to join datasets 387 | * Use `semi_join()` or `anti_join()` to filter datasets against each other 388 | -------------------------------------------------------------------------------- /solutions/03-Data-Types-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Data Types - Solutions" 3 | output: html_document 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | ```{r setup, include = FALSE} 9 | library(tidyverse) 10 | library(lubridate) 11 | library(hms) 12 | library(babynames) 13 | library(nycflights13) 14 | ``` 15 | 16 | 17 | ## Quiz 18 | 19 | ```{r} 20 | flights %>% 21 | left_join(airlines, by = "carrier") %>% 22 | mutate(air_time = duration(air_time, units = "minutes"), 23 | day = wday(time_hour, label = TRUE, abbr = FALSE), 24 | delayed = arr_delay > 0) %>% 25 | select(time_hour, name, air_time, distance, day, delayed) 26 | ``` 27 | 28 | 29 | ## Your Turn 1 30 | 31 | Use `flights` to create `delayed`, the variable that displays whether a flight was delayed (`arr_delay > 0`). 32 | 33 | Then, remove all rows that contain an NA in `delayed`. 34 | 35 | Finally, create a summary table that shows: 36 | 37 | 1. How many flights were delayed? 38 | 2. What proportion of flights were delayed? 39 | 40 | ```{r} 41 | flights %>% 42 | mutate(delayed = arr_delay > 0) %>% 43 | drop_na(delayed) %>% 44 | summarize(total = sum(delayed), prop = mean(delayed)) 45 | ``` 46 | 47 | 48 | ## Your Turn 2 49 | 50 | In your group, fill in the blanks to: 51 | 52 | 1. Isolate the last letter of every name 53 | 2. and create a logical variable that displays whether the last letter is one of "a", "e", "i", "o", "u", or "y". 54 | 3. Use a weighted mean to calculate the proportion of children whose name ends in a vowel (by `year` and `sex`) 55 | 4. and then display the results as a line plot. 56 | 57 | ```{r} 58 | babynames %>% 59 | mutate(last = str_sub(name, -1), 60 | vowel = last %in% c("a", "e", "i", "o", "u", "y")) %>% 61 | group_by(year, sex) %>% 62 | summarize(p_vowel = weighted.mean(vowel, n)) %>% 63 | ggplot(mapping = aes(x = year, y = p_vowel)) + 64 | geom_line(mapping = aes(color = sex)) 65 | ``` 66 | 67 | 68 | ## Your Turn 3 69 | 70 | Repeat the previous exercise, some of whose code is below, to make a sensible graph of average TV consumption by marital status. 71 | 72 | ```{r} 73 | gss_cat %>% 74 | drop_na(tvhours) %>% 75 | group_by(marital) %>% 76 | summarize(tvhours = mean(tvhours)) %>% 77 | ggplot(mapping = aes(x = tvhours, y = fct_reorder(marital, tvhours))) + 78 | geom_point() 79 | ``` 80 | 81 | 82 | ## Your Turn 4 83 | 84 | Do you think liberals or conservatives watch more TV? 85 | 86 | Compute average tv hours by party ID an then plot the results. 87 | 88 | ```{r} 89 | gss_cat %>% 90 | drop_na(tvhours) %>% 91 | group_by(partyid) %>% 92 | summarize(tvhours = mean(tvhours)) %>% 93 | ggplot(mapping = aes(x = tvhours, y = fct_reorder(partyid, tvhours))) + 94 | geom_point() + 95 | labs(y = "partyid") 96 | ``` 97 | 98 | 99 | ## Your Turn 5 100 | 101 | What is the best time of day to fly? 102 | 103 | Use the `hour` and `minute` variables in `flights` to compute the time of day for each flight as an hms. Then use a smooth line to plot the relationship between time of day and `arr_delay`. 104 | 105 | ```{r} 106 | flights %>% 107 | mutate(time = hms(hour = hour, minute = minute)) %>% 108 | ggplot(mapping = aes(x = time, y = arr_delay)) + 109 | geom_point(alpha = 0.2) + 110 | geom_smooth() 111 | ``` 112 | 113 | 114 | ## Your Turn 6 115 | 116 | Fill in the blanks to: 117 | 118 | 1. Extract the day of the week of each flight (as a full name) from `time_hour`. 119 | 2. Calculate the average `arr_delay` by day of the week. 120 | 3. Plot the results as a column chart (bar chart) with `geom_col()`. 121 | 122 | ```{r} 123 | flights %>% 124 | mutate(weekday = wday(time_hour, label = TRUE, abbr = FALSE)) %>% 125 | group_by(weekday) %>% 126 | drop_na(arr_delay) %>% 127 | summarize(avg_delay = mean(arr_delay)) %>% 128 | ggplot(mapping = aes(x = weekday, y = avg_delay)) + 129 | geom_col() 130 | ``` 131 | 132 | 133 | *** 134 | 135 | # Take Aways 136 | 137 | dplyr gives you three _general_ functions for manipulating data: `mutate()`, `summarize()`, and `group_by()`. Augment these with functions from the packages below, which focus on specific types of data. 138 | 139 | Package | Data Type 140 | --------- | -------- 141 | stringr | strings 142 | forcats | factors 143 | hms | times 144 | lubridate | dates and times 145 | 146 | -------------------------------------------------------------------------------- /solutions/04-Import-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Import Data - Solutions" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(viridis) 13 | 14 | setwd("/Users/jakethompson/Documents/GIT/courses/tidyds-2019") 15 | ``` 16 | 17 | 18 | ## here() 19 | 20 | ```{r} 21 | library(here) 22 | 23 | here() 24 | here("slides") 25 | here("data", "nimbus.csv") 26 | 27 | dr_here() 28 | ``` 29 | 30 | 31 | ## Your Turn 1 32 | 33 | Find nimbus.csv on your server or computer. Then read it into an object. Then view the results. 34 | 35 | ```{r} 36 | nimbus <- read_csv(here("data", "nimbus.csv")) 37 | nimbus 38 | ``` 39 | 40 | 41 | ## tibbles 42 | 43 | ```{r} 44 | starwars 45 | as.data.frame(starwars) 46 | ``` 47 | 48 | 49 | ## Your Turn 2 50 | 51 | * Read in the `nimbus` data set 52 | * Set values of `.` to `NA` 53 | 54 | ```{r} 55 | nimbus <- read_csv(here("data", "nimbus.csv"), na = ".") 56 | ``` 57 | 58 | 59 | ## Your Turn 3 60 | 61 | * Modify the code to specify `ozone` as integer values 62 | 63 | ```{r} 64 | nimbus <- read_csv(here("data", "nimbus.csv"), na = ".", 65 | col_types = cols(ozone = col_integer())) 66 | 67 | world <- map_data(map = "world") 68 | 69 | ggplot(data = nimbus) + 70 | geom_point(mapping = aes(x = longitude, y = latitude, color = ozone)) + 71 | geom_path(data = world, aes(x = long, y = lat, group = group)) + 72 | coord_map("ortho", orientation=c(-90, 0, 0)) + 73 | scale_color_viridis(option = "A") 74 | ``` 75 | 76 | 77 | *** 78 | 79 | # Take Aways 80 | 81 | The readr package provides efficient functions for reading and saving common flat file data formats. The tibble package provides improvements to the default data frame behavior. 82 | 83 | Consider these packages for other types of data: 84 | 85 | Package | Reads 86 | ------------------------- | ----------------------------------- 87 | readr | most flat files (.csv, .tsv, etc.) 88 | readxl | excel files (.xls, .xlsx) 89 | haven | SPSS, Stata, and SAS files 90 | googlesheets, googledrive | Google Sheets and Google Drive 91 | feather | Data transfers between R and Python 92 | rvest | web pages (web scraping) 93 | sparklyr | data loaded into spark 94 | jsonlite | json 95 | xml2 | xml 96 | httr | web API's 97 | DBI | databases 98 | -------------------------------------------------------------------------------- /solutions/05-Tidy-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Tidy Data - Solutions" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | 13 | # Toy data 14 | cases <- tribble( 15 | ~country, ~"2011", ~"2012", ~"2013", 16 | "FR", 7000, 6900, 7000, 17 | "DE", 5800, 6000, 6200, 18 | "US", 15000, 14000, 13000 19 | ) 20 | 21 | pollution <- tribble( 22 | ~city, ~size, ~amount, 23 | "New York", "large", 23, 24 | "New York", "small", 14, 25 | "London", "large", 22, 26 | "London", "small", 16, 27 | "Beijing", "large", 121, 28 | "Beijing", "small", 56 29 | ) 30 | 31 | scores <- tribble( 32 | ~name, ~house, ~score, 33 | "Ronald Weasley", "Gryffindor", 78, 34 | "Harry Potter", "Gryffindor", 85, 35 | "Hermione Granger", "Gryffindor", 100, 36 | "Justin Finch-Fletchley", "Hufflepuff", 87, 37 | "Hannah Abbot", "Hufflepuff", 92, 38 | "Susan Bones", "Hufflepuff", 93, 39 | "Anthony Goldstein", "Ravenclaw", 84, 40 | "Michael Corner", "Ravenclaw", 93, 41 | "Padma Patil", "Ravenclaw", 97, 42 | "Vincent Crabbe", "Slytherin", 61, 43 | "Gregory Goyle", "Slytherin", 61, 44 | "Draco Malfoy", "Slytherin", 92 45 | ) 46 | 47 | 48 | bp_systolic <- tribble( 49 | ~ subject_id, ~ time_1, ~ time_2, ~ time_3, 50 | 1, 120, 118, 121, 51 | 2, 125, 131, NA, 52 | 3, 141, NA, NA 53 | ) 54 | 55 | bp_systolic2 <- tribble( 56 | ~ subject_id, ~ time, ~ systolic, 57 | 1, 1, 120, 58 | 1, 2, 118, 59 | 1, 3, 121, 60 | 2, 1, 125, 61 | 2, 2, 131, 62 | 3, 1, 141 63 | ) 64 | ``` 65 | 66 | ## Tidy and untidy data 67 | 68 | `table1` is tidy: 69 | 70 | ```{r} 71 | table1 72 | ``` 73 | 74 | `table2` isn't tidy, the count column really contains two variables: 75 | 76 | ```{r} 77 | table2 78 | ``` 79 | 80 | 81 | ## Your Turn 1 82 | 83 | Is `bp_systolic` tidy? 84 | 85 | ```{r} 86 | bp_systolic 87 | ``` 88 | 89 | 90 | ## Your Turn 2 91 | 92 | Using `bp_systolic2` with `group_by()`, and `summarize()`: 93 | 94 | * Find the average systolic blood pressure for each subject 95 | * Find the last time each subject was measured 96 | 97 | ```{r} 98 | bp_systolic2 %>% 99 | group_by(subject_id) %>% 100 | summarize(avg_bp = mean(systolic), 101 | last_time = max(time)) 102 | ``` 103 | 104 | 105 | ## Your Turn 3 106 | 107 | On a sheet of paper, draw how the cases data set would look if it had the same values grouped into three columns: **country**, **year**, **n** 108 | 109 | country | year | cases | 110 | ----------- | ---- | ----- | 111 | Afghanistan | 1999 | 745 | 112 | Afghanistan | 2000 | 2666 | 113 | Brazil | 1999 | 37737 | 114 | Brazil | 2000 | 80488 | 115 | China | 1999 | 212258 | 116 | China | 2000 | 213766 | 117 | 118 | 119 | ## Your Turn 4 120 | 121 | Use `pivot_longer()` to reorganize `table4a` into three columns: **country**, **year**, and **cases**. 122 | 123 | ```{r} 124 | table4a %>% 125 | pivot_longer(-country, names_to = "year", values_to = "cases") 126 | ``` 127 | 128 | 129 | ## Your Turn 5 130 | 131 | On a sheet of paper, draw how `pollution` would look if it had the same values grouped into three columns: **city**, **large**, **small** 132 | 133 | city | large | small | 134 | -------- | ----- | ----- | 135 | Beijing | 121 | 121 | 136 | London | 22 | 16 | 137 | New York | 23 | 14 | 138 | 139 | 140 | ## Your Turn 6 141 | 142 | Use `pivot_wider()` to reorganize `table2` into four columns: **country**, **year**, **cases**, and **population**. 143 | 144 | ```{r} 145 | table2 %>% 146 | pivot_wider(names_from = type, values_from = count) 147 | ``` 148 | 149 | 150 | ## separate() and unite() 151 | 152 | ```{r} 153 | scores %>% 154 | separate(name, into = c("first", "last"), sep = " ") 155 | ``` 156 | 157 | ```{r} 158 | sep_scores <- scores %>% 159 | separate(name, into = c("first", "last"), sep = " ") 160 | sep_scores %>% 161 | unite("full_name", first, last, sep = " ") 162 | ``` 163 | 164 | 165 | *** 166 | 167 | # Take Aways 168 | 169 | Data comes in many formats but R prefers just one: _tidy data_. 170 | 171 | A data set is tidy if and only if: 172 | 173 | 1. Every variable is in its own column 174 | 2. Every observation is in its own row 175 | 3. Every value is in its own cell (which follows from the above) 176 | 177 | What is a variable and an observation may depend on your immediate goal. 178 | -------------------------------------------------------------------------------- /solutions/06-Case-Study-1-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: 'Case Study: Friday the 13th Effect - Solution' 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(fivethirtyeight) 13 | library(here) 14 | ``` 15 | 16 | 17 | ## Task 18 | 19 | Reproduce this figure from fivethirtyeight's article [*Some People Are Too Superstitious To Have A Baby On Friday The 13th*](https://fivethirtyeight.com/features/some-people-are-too-superstitious-to-have-a-baby-on-friday-the-13th/): 20 | 21 | ![](`r here("resources", "bialik-fridaythe13th-2.png")`) 22 | 23 | 24 | ## Data 25 | 26 | In the `fivethiryeight` package there are two data sets containing birth data, but for now let's just work with one `US_births_1994_2003`. Note that since we have data from 1994-2003, our results may differ somewhat from the figure based on 1994-2014. 27 | 28 | 29 | ## Your Turn 1 30 | 31 | With your neighbour, brainstorm the steps needed to get the data in a form ready to make the plot. 32 | 33 | ```{r} 34 | US_births_1994_2003 35 | ``` 36 | 37 | 38 | ## Some overviews of the data 39 | 40 | Whole time series: 41 | 42 | ```{r} 43 | ggplot(US_births_1994_2003, aes(x = date, y = births)) + 44 | geom_line() 45 | ``` 46 | 47 | There is so much fluctuation it's really hard to see what is going on. 48 | 49 | Let's try just looking at one year: 50 | 51 | ```{r} 52 | US_births_1994_2003 %>% 53 | filter(year == 1994) %>% 54 | ggplot(mapping = aes(x = date, y = births)) + 55 | geom_line() 56 | ``` 57 | 58 | Strong weekly pattern accounts for most variation. 59 | 60 | 61 | ## Strategy 62 | 63 | Use the figure as a guide for what the data should like to make the final plot. We want to end up with something like: 64 | 65 | day_of_week | avg_diff_13 | 66 | ----------- | ----------- | 67 | Mon | | 68 | Tues | | 69 | Wed | | 70 | ... | ... | 71 | 72 | There is more than one way to get there, but we 73 | ll roughly follow this strategy: 74 | 75 | * Get just the data for the 6th, 13th, and 20th 76 | * Calculate variable of interest: 77 | * (For each month/year): 78 | * Find average births on 6th and 20th 79 | * Find _percentage difference_ between births on 13th and average births on 6th and 20th 80 | * Average _percent difference_ by day of the week 81 | * Create plot 82 | 83 | 84 | ## Your Turn 2 85 | 86 | Extract just the 6th, 13th and 20th of each month: 87 | 88 | ```{r} 89 | US_births_1994_2003 %>% 90 | select(-date) %>% 91 | filter(date_of_month %in% c(6, 13, 20)) 92 | ``` 93 | 94 | 95 | ## Your Turn 3 96 | 97 | Which arrangement is tidy? 98 | 99 | **Option 1:** 100 | 101 | | year | month | date_of_month | day_of_week | births | 102 | | ----: | -----: | -------------: | :----------- | ------: | 103 | | 1994 | 1 | 6 | Thurs | 11406 | 104 | | 1994 | 1 | 13 | Thurs | 11212 | 105 | | 1994 | 1 | 20 | Thurs | 11682 | 106 | 107 | **Option 2:** 108 | 109 | | year | month | day_of_week | 6 | 13 | 20 | 110 | | ----: | -----: | :----------- | -----: | -----: | -----: | 111 | | 1994 | 1 | Thurs | 11406 | 11212 | 11682 | 112 | 113 | (**Hint:** think about our next step *"Find the percent difference between the 13th and the average of the 6th and 12th"*. In which layout will this be easier using our tidy tools?) 114 | 115 | **Solution**: Option 2, since then we can easily use `mutate()`. 116 | 117 | 118 | ## Your Turn 4 119 | 120 | Tidy the filtered data to have the days in columns. 121 | 122 | ```{r} 123 | US_births_1994_2003 %>% 124 | select(-date) %>% 125 | filter(date_of_month %in% c(6, 13, 20)) %>% 126 | pivot_wider(names_from = date_of_month, values_from = births) 127 | ``` 128 | 129 | 130 | ## Your Turn 5 131 | 132 | Now use `mutate()` to add columns for: 133 | 134 | * The average of the births on the 6th and 20th 135 | * The percentage difference between the number of births on the 13th and the average of the 6th and 20th 136 | 137 | ```{r} 138 | US_births_1994_2003 %>% 139 | select(-date) %>% 140 | filter(date_of_month %in% c(6, 13, 20)) %>% 141 | pivot_wider(names_from = date_of_month, values_from = births) %>% 142 | mutate(avg_6_20 = (`6` + `20`) / 2, 143 | diff_13 = (`13` - avg_6_20) / avg_6_20 * 100) 144 | ``` 145 | 146 | 147 | ## A little additional exploring 148 | 149 | Now we have a percent difference between the 13th and the 6th and 20th of each month, it's probably worth exploring a little (at the very least to check our calculations seem reasonable). 150 | 151 | To make it a little easier let's assign our current data to a variable: 152 | 153 | ```{r} 154 | births_diff_13 <- US_births_1994_2003 %>% 155 | select(-date) %>% 156 | filter(date_of_month %in% c(6, 13, 20)) %>% 157 | pivot_wider(names_from = date_of_month, values_from = births) %>% 158 | mutate(avg_6_20 = (`6` + `20`) / 2, 159 | diff_13 = (`13` - avg_6_20) / avg_6_20 * 100) 160 | ``` 161 | 162 | Then take a look: 163 | 164 | ```{r} 165 | births_diff_13 %>% 166 | ggplot(mapping = aes(x = day_of_week, y = diff_13)) + 167 | geom_point() 168 | ``` 169 | 170 | Looks like we are on the right path. There's a big outlier one Monday: 171 | 172 | ```{r} 173 | births_diff_13 %>% 174 | filter(day_of_week == "Mon", diff_13 > 10) 175 | ``` 176 | 177 | Seem's to be driven but a particularly low number of births on the 6th of Sep 1999. Maybe a holiday effect? Labour Day was of the 6th of September that year. 178 | 179 | 180 | ## Your Turn 6 181 | 182 | Summarize each day of the week to have mean of diff_13. 183 | 184 | Then, recreate the fivethirtyeight plot. 185 | 186 | ```{r} 187 | births_13_sum <- US_births_1994_2003 %>% 188 | select(-date) %>% 189 | filter(date_of_month %in% c(6, 13, 20)) %>% 190 | pivot_wider(names_from = date_of_month, values_from = births) %>% 191 | mutate(avg_6_20 = (`6` + `20`)/2, 192 | diff_13 = (`13` - avg_6_20) / avg_6_20 * 100) %>% 193 | group_by(day_of_week) %>% 194 | summarize(avg_diff_13 = mean(diff_13)) 195 | ``` 196 | 197 | ```{r} 198 | ggplot(data = births_13_sum, aes(x = day_of_week, y = avg_diff_13)) + 199 | geom_col() 200 | ``` 201 | 202 | And the code to more closely mimic the actual FiveThirtyEight graphic: 203 | 204 | ```{r} 205 | births_13_sum %>% 206 | mutate(day_of_week = fct_relevel(day_of_week, "Mon", "Tues", "Wed", "Thurs", 207 | "Fri", "Sat", "Sun"), 208 | friday = day_of_week == "Fri") %>% 209 | ggplot(aes(x = day_of_week, y = avg_diff_13)) + 210 | geom_col(aes(fill = friday), show.legend = FALSE) + 211 | geom_hline(yintercept = 0) + 212 | scale_fill_manual(values = c("#F2B5ED", "#F200DF")) + 213 | scale_x_discrete(position = "top") + 214 | scale_y_continuous(breaks = seq(-6, 0, by = 1), 215 | labels = c(-6:-1, "0 ppt")) + 216 | # coord_cartesian(expand = FALSE) + 217 | labs(x = NULL, y = NULL, 218 | title = "The Friday the 13th effect", 219 | subtitle = "Difference in the share of U.S. births on the 13th of each month\nfrom the average of births on the 6th and the 20th, 1994-2003") + 220 | theme(axis.ticks = element_blank(), 221 | axis.text.y = element_text(hjust = 0), 222 | panel.grid.minor = element_blank(), 223 | panel.background = element_rect(fill = "#F0F0F0"), 224 | plot.background = element_rect(fill = "#F0F0F0"), 225 | panel.grid.major = element_line(color = "#DBDBDB"), 226 | plot.title = element_text(face = "bold", size = rel(1.5))) 227 | ``` 228 | 229 | 230 | ## Extra Challenges 231 | 232 | * If you wanted to use the `US_births_2000_2014` data instead, what would you need to change in the pipeline? How about using both `US_births_1994_2003` and `US_births_2000_2014`? 233 | 234 | * Try not removing the `date` column. At what point in the pipeline does it cause problems? Why? 235 | 236 | * Can you come up with an alternative way to investigate the Friday the 13th effect? Try it out! 237 | 238 | 239 | *** 240 | 241 | ## Takeaways 242 | 243 | The power of the tidyverse comes from being able to easily combine functions that do simple things well. 244 | -------------------------------------------------------------------------------- /solutions/07-Model-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Model Data - Solutions" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(modelr) 13 | library(broom) 14 | 15 | wages <- heights %>% filter(income > 0) 16 | ``` 17 | 18 | 19 | ## Your Turn 1 20 | 21 | Fit the model on the slide and then examine the output. What does it look like? 22 | 23 | ```{r} 24 | mod_e <- lm(log(income) ~ education, data = wages) 25 | mod_e 26 | ``` 27 | 28 | 29 | ## Your Turn 2 30 | 31 | Use a pipe to model `log(income)` against `height`. Then use broom and dplyr functions to extract: 32 | 33 | 1. The **coefficient estimates** and their related statistics 34 | 2. The **adj.r.squared** and **p.value** for the overall model 35 | 36 | ```{r} 37 | mod_h <- wages %>% lm(log(income) ~ height, data = .) 38 | mod_h %>% 39 | tidy() 40 | 41 | mod_h %>% 42 | glance() %>% 43 | select(adj.r.squared, p.value) 44 | ``` 45 | 46 | 47 | ## Your Turn 3 48 | 49 | Model `log(income)` against `education` _and_ `height`. Do the coefficients change? 50 | 51 | ```{r} 52 | mod_eh <- wages %>% 53 | lm(log(income) ~ education + height, data = .) 54 | 55 | mod_eh %>% 56 | tidy() 57 | ``` 58 | 59 | 60 | ## Your Turn 4 61 | 62 | Model `log(income)` against `education` and `height` and `sex`. Can you interpret the coefficients? 63 | 64 | ```{r} 65 | mod_ehs <- wages %>% 66 | lm(log(income) ~ education + height + sex, data = .) 67 | 68 | mod_ehs %>% 69 | tidy() 70 | ``` 71 | 72 | 73 | ## Your Turn 5 74 | 75 | Use a broom function and ggplot2 to make a line graph of `height` vs `.fitted` for our heights model, `mod_h`. 76 | 77 | _Bonus: Overlay the plot on the original data points._ 78 | 79 | ```{r} 80 | mod_h %>% 81 | augment(data = wages) %>% 82 | ggplot(mapping = aes(x = height, y = .fitted)) + 83 | geom_point(mapping = aes(y = log(income)), alpha = 0.1) + 84 | geom_line(color = "blue") 85 | ``` 86 | 87 | 88 | ## Your Turn 6 89 | 90 | Repeat the process to make a line graph of `height` vs `.fitted` colored by `sex` for model mod_ehs. Are the results interpretable? Add `+ facet_wrap(~education)` to the end of your code. What happens? 91 | 92 | ```{r} 93 | mod_ehs %>% 94 | augment(data = wages) %>% 95 | ggplot(mapping = aes(x = height, y = .fitted, color = sex)) + 96 | geom_line() + 97 | facet_wrap(vars(education)) 98 | ``` 99 | 100 | 101 | ## Your Turn 7 102 | 103 | Use one of `spread_predictions()` or `gather_predictions()` to make a line graph of `height` vs `pred` colored by `model` for each of mod_h, mod_eh, and mod_ehs. Are the results interpretable? 104 | 105 | Add `+ facet_grid(sex ~ education)` to the end of your code. What happens? 106 | 107 | ```{r} 108 | wages %>% 109 | gather_predictions(mod_h, mod_eh, mod_ehs) %>% 110 | filter(education > 11) %>% 111 | ggplot(mapping = aes(x = height, y = pred, color = sex)) + 112 | geom_line() + 113 | facet_grid(rows = vars(model), cols = vars(education)) 114 | ``` 115 | 116 | You can also create dummy data in order to generate predictions across a range of values that was not observed in your data. 117 | 118 | ```{r} 119 | new_data <- crossing(height = 50:90, 120 | education = 1:20, 121 | sex = factor(c("male", "female"), 122 | levels = c("male", "female"))) 123 | 124 | new_data %>% 125 | gather_predictions(mod_h, mod_eh, mod_ehs) %>% 126 | filter(education > 11) %>% 127 | ggplot(mapping = aes(x = height, y = pred, color = sex)) + 128 | geom_line() + 129 | facet_grid(rows = vars(model), cols = vars(education)) 130 | ``` 131 | 132 | ## Your Turn 8 133 | 134 | Use one of `spread_residuals()` or `gather_residuals()` to make a scatter plot of `afqt` vs. `resid` for each of mod_e, mod_h, mod_eh, and mod_ehs. 135 | 136 | Use a faceting function to create a subplot for each model. 137 | 138 | ```{r} 139 | wages %>% 140 | gather_residuals(mod_e, mod_eh, mod_ehs, mod_h) %>% 141 | ggplot(mapping = aes(x = afqt, y = resid)) + 142 | geom_point() + 143 | facet_wrap(vars(model)) 144 | ``` 145 | 146 | ```{r} 147 | wages %>% 148 | gather_residuals(mod_e, mod_eh, mod_ehs, mod_h) %>% 149 | ggplot(mapping = aes(x = afqt, y = resid)) + 150 | geom_hex() + 151 | scale_fill_viridis_c() + 152 | facet_wrap(vars(model)) 153 | ``` 154 | 155 | 156 | *** 157 | 158 | # Take Aways 159 | 160 | * Use `glance()`, `tidy()`, and `augment()` from the **broom** package to return model values in a data frame. 161 | 162 | * Use `add_predictions()` or `spread_predictions()` or `gather_predictions()` from the **modelr** package to visualize predictions. 163 | 164 | * Use `add_residuals()` or `spread_residuals()` or `gather_residuals()` from the **modelr** package to visualize residuals. 165 | -------------------------------------------------------------------------------- /solutions/08-Iterate-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Iterate - Solutions" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | 13 | # Toy data 14 | set.seed(9416) 15 | exams <- list( 16 | student1 = round(runif(10, 50, 100)), 17 | student2 = round(runif(10, 50, 100)), 18 | student3 = round(runif(10, 50, 100)), 19 | student4 = round(runif(10, 50, 100)), 20 | student5 = round(runif(10, 50, 100)) 21 | ) 22 | 23 | extra_credit <- list(0, 0, 10, 10, 15) 24 | ``` 25 | 26 | 27 | ## Your Turn 1 28 | 29 | What kind of object is `mod`? Why are models stored as this kind of object? 30 | 31 | ```{r} 32 | mod <- lm(price ~ carat + cut + color + clarity, data = diamonds) 33 | # View(mod) 34 | ``` 35 | 36 | `mod` is a list. A list is used because we need to store lots of heterogeneous information. 37 | 38 | 39 | ## Quiz 40 | 41 | What's the difference between a list and an **atomic** vector? 42 | 43 | Atomic vectors are: "logical", "integer", "numeric" (synonym "double"), "complex", "character" and "raw" vectors. 44 | 45 | Lists can hold data of different types and different lengths, we can even put lists inside other lists. 46 | 47 | 48 | ## Your Turn 2 49 | 50 | Here is a list: 51 | 52 | ```{r} 53 | a_list <- list(num = c(8, 9), 54 | log = TRUE, 55 | cha = c("a", "b", "c")) 56 | ``` 57 | 58 | Here are two subsetting commands. Do they return the same values? Run the code chunk above, _and then_ run the code chunks below to confirm 59 | 60 | ```{r} 61 | a_list["num"] 62 | ``` 63 | 64 | ```{r} 65 | a_list$num 66 | ``` 67 | 68 | 69 | ## Your Turn 3 70 | 71 | What will each of these return? Run the code chunks to confirm. 72 | 73 | ```{r} 74 | vec <- c(-2, -1, 0, 1, 2) 75 | abs(vec) 76 | ``` 77 | 78 | `abs()` returns the absolute value of each element. 79 | 80 | ```{r} 81 | lst <- list(-2, -1, 0, 1, 2) 82 | abs(lst) 83 | ``` 84 | 85 | Out intent might be to take the absolute value of each element, but we get an error, because `abs()` doens't know how to handle a list. 86 | 87 | 88 | ## Your Turn 4 89 | 90 | Run the code in the chunks. What does it return? 91 | 92 | ```{r} 93 | list(student1 = mean(exams$student1), 94 | student2 = mean(exams$student2), 95 | student3 = mean(exams$student3), 96 | student4 = mean(exams$student4), 97 | student5 = mean(exams$student5)) 98 | ``` 99 | 100 | This chunk manually iterates over the elements of `exams` taking the mean of each element, and returning the results in a list. 101 | 102 | ```{r} 103 | map(exams, mean) 104 | ``` 105 | 106 | This does the exact same thing, but automatically. 107 | 108 | 109 | ## Your Turn 5 110 | 111 | Calculate the variance (`var()`) of each student’s exam grades. 112 | 113 | ```{r} 114 | exams %>% map(var) 115 | ``` 116 | 117 | 118 | ## Your Turn 6 119 | 120 | Calculate the max grade (`max()`)for each student. Return the result as a vector. 121 | 122 | ```{r} 123 | exams %>% map_dbl(max) 124 | ``` 125 | 126 | 127 | ## Your Turn 7 128 | 129 | Write a function that counts the best exam twice and then takes the average. Use it to grade all of the students. 130 | 131 | 1. Write code that solves the problem for a real object 132 | 2. Wrap the code in `function(){}` to save it 133 | 3. Add the name of the real object as the function argument 134 | 135 | ```{r} 136 | double_best <- function(x) { 137 | (sum(x) + max(x)) / (length(x) + 1) 138 | } 139 | 140 | exams %>% 141 | map_dbl(double_best) 142 | ``` 143 | 144 | 145 | ## Your Turn 8 146 | 147 | Compute a final grade for each student, where the final grade is the average test score plus any `extra_credit` assigned to the student. Return the results as a double (i.e. numeric) vector. 148 | 149 | ```{r} 150 | exams %>% 151 | map2_dbl(extra_credit, function(x, y) mean(x) + y) 152 | ``` 153 | 154 | 155 | *** 156 | 157 | # Take Aways 158 | 159 | Lists are a useful way to organize data, but you need to arrange manually for functions to iterate over the elements of a list. 160 | 161 | You can do this with the `map()` family of functions in the purrr package. 162 | 163 | To write a function, 164 | 165 | 1. Write code that solves the problem for a real object 166 | 2. Wrap the code in `function(){}` to save it 167 | 3. Add the name of the real object as the function argument 168 | 169 | This sequence will help prevent bugs in your code (and reduce the time you spend correcting bugs). 170 | -------------------------------------------------------------------------------- /solutions/09-Organize-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Organize with List Columns - Solution" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup, include = FALSE} 11 | library(tidyverse) 12 | library(broom) 13 | library(modelr) 14 | library(rsample) 15 | library(gapminder) 16 | library(tidydscompanion) 17 | library(here) 18 | ``` 19 | 20 | 21 | ## Your Turn 1 22 | 23 | How has life expectancy changed in other countries? 24 | 25 | * Make a line plot of `lifeExp` vs. `year` grouped by `country.` 26 | * Set alpha to 0.2, to see the results better. 27 | 28 | ```{r} 29 | gapminder %>% 30 | ggplot(mapping = aes(x = year, y = lifeExp, group = country)) + 31 | geom_line(alpha = 0.2) 32 | ``` 33 | 34 | 35 | ## Quiz 36 | 37 | How is a data frame/tibble similar to a list? 38 | 39 | ```{r} 40 | gapminder_sm <- gapminder[1:5, ] 41 | ``` 42 | 43 | It is a list! Columns are like elements of a list 44 | 45 | You can extract them with `$` of `[[` 46 | 47 | ```{r} 48 | gapminder_sm$country 49 | gapminder_sm[["country"]] 50 | ``` 51 | 52 | Or get a new smaller list with `[`: 53 | 54 | ```{r} 55 | gapminder_sm["country"] 56 | ``` 57 | 58 | 59 | ## Quiz 60 | 61 | If one of the elements of a list can be another list, can one of the columns of a data frame be another list? 62 | 63 | **Yes!**. 64 | 65 | ```{r} 66 | tibble( 67 | num = c(1, 2, 3), 68 | cha = c("one", "two", "three"), 69 | listcol = list(1, c("1", "two", "FALSE"), FALSE) 70 | ) 71 | ``` 72 | 73 | And we call it a **list column**. 74 | 75 | 76 | ## Your Turn 2 77 | 78 | Run this chunk: 79 | 80 | ```{r} 81 | gapminder_nested <- gapminder %>% 82 | group_by(country) %>% 83 | nest() 84 | 85 | fit_model <- function(df) lm(lifeExp ~ year, data = df) 86 | 87 | gapminder_nested <- gapminder_nested %>% 88 | mutate(model = map(data, fit_model)) 89 | 90 | get_rsq <- function(mod) glance(mod)$r.squared 91 | 92 | gapminder_nested <- gapminder_nested %>% 93 | mutate(r.squared = map_dbl(model, get_rsq)) 94 | ``` 95 | 96 | Then filter `gapminder_nested` to find the countries with r.squared less than 0.5. 97 | 98 | ```{r} 99 | gapminder_nested %>% 100 | filter(r.squared < 0.5) 101 | ``` 102 | 103 | 104 | ## Your Turn 3 105 | 106 | Edit the code in the chunk provided to instead find and plot countries with a slope above 0.6 years/year. 107 | 108 | ```{r} 109 | get_slope <- function(mod) { 110 | tidy(mod) %>% filter(term == "year") %>% pull(estimate) 111 | } 112 | 113 | # Add new column with r-sqaured 114 | gapminder_nested <- gapminder_nested %>% 115 | mutate(slope = map_dbl(model, get_slope)) 116 | 117 | # filter to big slope countries 118 | big_slope <- gapminder_nested %>% 119 | filter(slope > 0.6) 120 | 121 | # unnest and plot result 122 | unnest(big_slope, data) %>% 123 | ggplot(aes(x = year, y = lifeExp)) + 124 | geom_line(aes(color = country)) 125 | ``` 126 | 127 | 128 | ## Your Turn 4 129 | 130 | **Challenge:** 131 | 132 | 1. Create your own copy of `gapminder_nested` and then add one more list column: `output` which contains the output of `augment()` for each model. 133 | 2. Plot the residuals against time for the countries with small r-squared. 134 | 135 | ```{r} 136 | jake_gapminder <- gapminder_nested 137 | 138 | jake_gapminder %>% 139 | mutate(output = map(model, augment)) %>% 140 | filter(r.squared < 0.5) %>% 141 | unnest(output) %>% 142 | ggplot(aes(x = year, y = .resid)) + 143 | geom_line(aes(color = country)) 144 | ``` 145 | 146 | 147 | ## Bootstrapping Comparisons 148 | 149 | ```{r} 150 | mean(admission$gre_v[admission$gender == "Male"]) - 151 | mean(admission$gre_v[admission$gender == "Female"]) 152 | 153 | mean_diff <- function(splits) { 154 | x <- analysis(splits) 155 | mean(x$gre_v[x$gender == "Male"]) - 156 | mean(x$gre_v[x$gender == "Female"]) 157 | } 158 | 159 | set.seed(32011) 160 | grev_gender <- admission %>% 161 | bootstraps(times = 100) %>% 162 | mutate(grev_diff = map_dbl(splits, mean_diff)) 163 | 164 | ggplot(grev_gender, mapping = aes(x = grev_diff)) + 165 | geom_density() 166 | 167 | quantile(grev_gender$grev_diff, probs = c(0.025, 0.500, 0.975)) 168 | ``` 169 | 170 | 171 | ## Your Turn 5 172 | 173 | Is there a difference between the percentage of male and female applicants admitted? 174 | 175 | First, write some code to calculate the difference between the percentage of male applicants admitted, and the percentage of female applicants admitted. 176 | 177 | ```{r} 178 | mean(admission$admit[admission$gender == "Male"]) - 179 | mean(admission$admit[admission$gender == "Female"]) 180 | ``` 181 | 182 | Now, turn that code into a function, `pct_diff()`. 183 | 184 | ```{r} 185 | pct_diff <- function(splits) { 186 | x <- analysis(splits) 187 | mean(x$admit[x$gender == "Male"]) - 188 | mean(x$admit[x$gender == "Female"]) 189 | } 190 | ``` 191 | 192 | Generate 100 bootstraps, and apply the `pct_diff()` function to each bootstrapped sample. 193 | 194 | ```{r} 195 | set.seed(32011) 196 | admit_gender <- admission %>% 197 | bootstraps(times = 100) %>% 198 | mutate(admit_diff = map_dbl(splits, pct_diff)) 199 | ``` 200 | 201 | Finally, create a density plot of the difference, and create a 95% interval. 202 | 203 | ```{r} 204 | ggplot(admit_gender, mapping = aes(x = admit_diff)) + 205 | geom_density() 206 | 207 | quantile(admit_gender$admit_diff, probs = c(0.025, 0.500, 0.975)) 208 | ``` 209 | 210 | 211 | *** 212 | 213 | # Take away 214 | 215 | * Store objects and other lists in list-columns of data frames 216 | * Use `bootsraps()` to recreate resampled data objects 217 | * Use `vfold_cv()` to create analysis and assessment sub-samples of your data to assessment model performance 218 | * Use `purrr` to iterate over bootstrapped samples and cross validation folds 219 | -------------------------------------------------------------------------------- /solutions/10-Case-Study-2-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Case Study 2 - Solution" 3 | output: html_notebook 4 | editor_options: 5 | chunk_output_type: inline 6 | --- 7 | 8 | 9 | 10 | ```{r setup} 11 | library(tidyverse) 12 | library(broom) 13 | library(rsample) 14 | library(tidydscompanion) 15 | library(here) 16 | library(colorblindr) 17 | library(hrbrthemes) 18 | ``` 19 | 20 | 21 | ## Task 22 | 23 | Reproduce these figures below, created from an analysis of the `admission` data. 24 | 25 | ![](`r here("resources", "density.png")`) 26 | 27 | ![](`r here("resources", "confint.png")`) 28 | 29 | 30 | ## Data 31 | 32 | In the `tidydscompanion` package there is a data set containing simulated admissions data for a graduate program. 33 | 34 | 35 | ## Your Turn 1 36 | 37 | What are the steps needed to create these plots? 38 | 39 | We'll follow these steps: 40 | 41 | 1. Create cross validation sets 42 | 2. Fit all three models to each analysis set 43 | 3. Get predictions for each assessment set 44 | 4. Calculate the outcome measures for each set of predictions 45 | 5. Plot the distributions of the outcome measures 46 | 47 | 48 | ## You Turn 2 49 | 50 | * Create a cross validation resampling with 10 folds and 10 repeats 51 | * Save the object as `models` 52 | 53 | ```{r} 54 | set.seed(32011) 55 | models <- admission %>% 56 | vfold_cv(v = 10, repeats = 10) 57 | ``` 58 | 59 | 60 | ## Your Turn 3 61 | 62 | * Complete the function that takes in a `splits` and `formula` and returns predictions 63 | * Model should be fit using the **analysis** data 64 | * Predictions should be made on the **assessment** data 65 | * Use `mutate` to add columns to the predictions 66 | * Predicted acceptance is `1` if `.fitted` is greater than 0.5, `0` otherwise 67 | * Prediction is corrected if predicted value (from above) is the same as `admit` 68 | 69 | ```{r} 70 | holdout_results <- function(splits, formula) { 71 | # Fit the model to the analysis set 72 | mod <- glm(formula, data = analysis(splits), family = binomial) 73 | 74 | # Save the assessment data 75 | holdout <- assessment(splits) 76 | 77 | # `augment` will save the predictions with the holdout data set 78 | res <- broom::augment(mod, newdata = holdout, type.predict = "response") %>% 79 | mutate(prediction = ifelse(.fitted > 0.5, 1L, 0L), 80 | correct = prediction == admit) 81 | 82 | # Return the assessment data set with the additional columns 83 | res 84 | } 85 | ``` 86 | 87 | 88 | ## Your Turn 4 89 | 90 | * Use `mutate` and `map` to use the `holdout_results` function to fit each model to the cross validation sets 91 | * Formulas for each model have already been saved for your convenience 92 | 93 | ```{r} 94 | empty <- as.formula(admit ~ 1) 95 | academics <- as.formula(admit ~ gre_v * gre_q + gre_w + gpa) 96 | full <- as.formula(admit ~ gre_v * gre_q + gre_w + gpa + gender) 97 | 98 | all_mods <- models %>% 99 | mutate(empty_mod = map(splits, holdout_results, formula = empty), 100 | acadm_mod = map(splits, holdout_results, formula = academics), 101 | compl_mod = map(splits, holdout_results, formula = full)) 102 | ``` 103 | 104 | 105 | ## Your Turn 5 106 | 107 | * Tidy the data so that the models are all in one column (`results`) with an identifier column (`model`) 108 | * Expand the `results` so we can do calculations on the predictions 109 | 110 | ```{r} 111 | all_preds <- all_mods %>% 112 | select(-splits) %>% 113 | pivot_longer(contains("mod"), names_to = "model", values_to = "results") %>% 114 | unnest(results) 115 | ``` 116 | 117 | 118 | ## Your Turn 6 119 | 120 | * Calculate the percent of applicants correctly classified for each repeat, fold, and model 121 | * Plot the distributions for each model 122 | 123 | ```{r} 124 | all_preds %>% 125 | group_by(id, id2, model) %>% 126 | summarize(pct_cor = mean(correct)) %>% 127 | ggplot(aes(x = pct_cor)) + 128 | geom_density(aes(fill = model, color = model), alpha = 0.6) 129 | ``` 130 | 131 | And the code to reproduce the entire graphic: 132 | 133 | ```{r} 134 | all_preds %>% 135 | group_by(id, id2, model) %>% 136 | summarize(pct_cor = mean(correct)) %>% 137 | ggplot(aes(x = pct_cor)) + 138 | geom_density(aes(color = model, fill = model), alpha = 0.4) + 139 | scale_color_OkabeIto(limits = c("compl_mod", "acadm_mod", "empty_mod"), 140 | breaks = c("empty_mod", "acadm_mod", "compl_mod"), 141 | labels = c("Empty", "Academics", "Full")) + 142 | scale_fill_OkabeIto(limits = c("compl_mod", "acadm_mod", "empty_mod"), 143 | breaks = c("empty_mod", "acadm_mod", "compl_mod"), 144 | labels = c("Empty", "Academics", "Full")) + 145 | expand_limits(x = c(0.6, 0.9)) + 146 | scale_x_percent() + 147 | labs(x = "Correct Classification Rate", y = "Density", color = "Model", 148 | fill = "Model", 149 | title = "Distribution of Applicants Correctly Classified", 150 | subtitle = "Using 10-fold cross validation with 10 repeats") + 151 | theme_ipsum_ps() + 152 | theme(legend.position = "bottom") + 153 | guides(fill = guide_legend(override.aes = list(alpha = 1))) 154 | ``` 155 | 156 | 157 | ## Your Turn 7 158 | 159 | * Calculate the Log Loss for each repeat, fold, and model 160 | 161 | ```{r} 162 | all_preds %>% 163 | group_by(id, id2, model) %>% 164 | summarize(logloss = -1 * mean((admit * log(.fitted)) + ((1 - admit) * log(1 - .fitted)))) 165 | ``` 166 | 167 | 168 | ## Your Turn 8 169 | 170 | * For each model, calculate the median, 2.5, and 97.5 percentiles of the Log Loss 171 | * 95% confidence interval 172 | * Plot the results using `geom_errorbarh` 173 | * Hint: look at the required aesthetics using `?geom_errorbarh` 174 | 175 | ```{r} 176 | all_preds %>% 177 | group_by(id, id2, model) %>% 178 | summarize(logloss = -1 * mean((admit * log(.fitted)) + ((1 - admit) * log(1 - .fitted)))) %>% 179 | group_by(model) %>% 180 | summarize(median = median(logloss), 181 | lb = quantile(logloss, probs = 0.025), 182 | ub = quantile(logloss, probs = 0.975)) %>% 183 | ggplot(aes(y = model)) + 184 | geom_errorbarh(aes(xmin = lb, xmax = ub), height = 0) + 185 | geom_point(aes(x = median)) 186 | ``` 187 | 188 | And the code for the full graphic: 189 | 190 | ```{r} 191 | all_preds %>% 192 | group_by(id, id2, model) %>% 193 | summarize(logloss = -1 * mean((admit * log(.fitted)) + ((1 - admit) * log(1 - .fitted)))) %>% 194 | group_by(model) %>% 195 | summarize(med = median(logloss), 196 | lb_99 = quantile(logloss, prob = 0.005), 197 | ub_99 = quantile(logloss, prob = 0.995), 198 | lb_95 = quantile(logloss, prob = 0.025), 199 | ub_95 = quantile(logloss, prob = 0.975), 200 | lb_80 = quantile(logloss, prob = 0.100), 201 | ub_80 = quantile(logloss, prob = 0.900)) %>% 202 | pivot_longer(contains("_"), names_to = "boundary", values_to = "value") %>% 203 | separate(boundary, into = c("bound", "level")) %>% 204 | pivot_wider(names_from = bound, values_from = value) %>% 205 | mutate(level = paste0(level, "%")) %>% 206 | ggplot() + 207 | geom_errorbarh( 208 | aes(y = model, xmin = lb, xmax = ub, color = level, size = level), 209 | height = 0 210 | ) + 211 | geom_point(aes(x = med, y = model), color = "#E69F00", size = 3) + 212 | expand_limits(x = c(0.2, 0.7)) + 213 | scale_y_discrete(limits = c("compl_mod", "acadm_mod", "empty_mod"), 214 | labels = c("Full", "Academics", "Empty")) + 215 | scale_color_manual(values = c( 216 | `80%` = darken("#56B4E9", .2), 217 | `95%` = "#56B4E9", 218 | `99%` = lighten("#56B4E9", .4) 219 | )) + 220 | scale_size_manual(values = c(`80%` = 4, `95%` = 3, `99%` = 2)) + 221 | labs(x = "Median Log-Loss", y = NULL, size = "Confidence Level", 222 | color = "Confidence Level", 223 | title = "Log-loss of Competing Models", 224 | subtitle = "Using 10-fold cross validation with 10 repeats") + 225 | theme_ipsum_ps() + 226 | theme(legend.position = "bottom") 227 | ``` 228 | 229 | 230 | ## Extra Challenge 231 | 232 | How would you add multiple error bars fo varying confidence intervals? 233 | 234 | Are there other methods we could use to measure the predictive accuracy of the models? 235 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/analyze-share-repro-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | html_document: 4 | theme: cosmo 5 | --- 6 | 7 | 8 | 9 | # Analyze. Share. Reproduce. 10 | 11 | ## and do it all 12 | 13 | ### with R Markdown 14 | 15 | Your data tells a ~~joke~~ story. Tell it with `R` Markdown. Turn your analyses into **high quality** documents, reports, presentations and dashboards -- and don't forget to drink some H~2~0 while you do that.[^1] 16 | 17 | R Markdown documents are fully reproducible. Use a productive [notebook interface](http://rmarkdown.rstudio.com/r_notebooks.html)[^2] to weave together narrative text and code to produce *elegantly formatted* output. Use multiple languages including 18 | 19 | - R 20 | - Python 21 | 22 | and 23 | 24 | - SQL 25 | 26 | Do you need still need convincing to use R Markdown? See what a friend once said: 27 | 28 | > I used to use Sweave, and get terrible headaches. Now I use R Markdown, 29 | > and life is much more pleasant. 30 | 31 | [^1]: Or coffee, whatever floats your boat. 32 | [^2]: This link should point to http://rmarkdown.rstudio.com/r_notebooks.html. 33 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/bib/knit.bib: -------------------------------------------------------------------------------- 1 | @Manual{R-bookdown, 2 | title = {bookdown: Authoring Books and Technical Documents with R Markdown}, 3 | author = {Yihui Xie}, 4 | year = {2019}, 5 | note = {R package version 0.10}, 6 | url = {https://CRAN.R-project.org/package=bookdown}, 7 | } 8 | @Manual{R-rmarkdown, 9 | title = {rmarkdown: Dynamic Documents for R}, 10 | author = {JJ Allaire and Yihui Xie and Jonathan McPherson and Javier Luraschi and Kevin Ushey and Aron Atkins and Hadley Wickham and Joe Cheng and Winston Chang and Richard Iannone}, 11 | year = {2019}, 12 | note = {R package version 1.12}, 13 | url = {https://CRAN.R-project.org/package=rmarkdown}, 14 | } 15 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/bib/packages.bib: -------------------------------------------------------------------------------- 1 | @Manual{R-base, 2 | title = {R: A Language and Environment for Statistical Computing}, 3 | author = {{R Core Team}}, 4 | organization = {R Foundation for Statistical Computing}, 5 | address = {Vienna, Austria}, 6 | year = {2019}, 7 | url = {https://www.R-project.org/}, 8 | } 9 | @Manual{R-broom, 10 | title = {broom: Convert Statistical Analysis Objects into Tidy Tibbles}, 11 | author = {David Robinson and Alex Hayes}, 12 | year = {2019}, 13 | note = {R package version 0.5.2}, 14 | url = {https://CRAN.R-project.org/package=broom}, 15 | } 16 | @Manual{R-colorblindr, 17 | title = {colorblindr: Simulate colorblindness in R figures}, 18 | author = {Claire D. McWhite and Claus O. Wilke}, 19 | note = {R package version 0.1.0}, 20 | url = {https://github.com/clauswilke/colorblindr}, 21 | year = {2019}, 22 | } 23 | @Manual{R-colorspace, 24 | title = {colorspace: A Toolbox for Manipulating and Assessing Colors and Palettes}, 25 | author = {Ross Ihaka and Paul Murrell and Kurt Hornik and Jason C. Fisher and Reto Stauffer and Claus O. Wilke and Claire D. McWhite and Achim Zeileis}, 26 | year = {2019}, 27 | note = {R package version 1.4-1}, 28 | url = {https://CRAN.R-project.org/package=colorspace}, 29 | } 30 | @Manual{R-dplyr, 31 | title = {dplyr: A Grammar of Data Manipulation}, 32 | author = {Hadley Wickham and Romain François and Lionel Henry and Kirill Müller}, 33 | year = {2019}, 34 | note = {R package version 0.8.0.1}, 35 | url = {https://CRAN.R-project.org/package=dplyr}, 36 | } 37 | @Manual{R-forcats, 38 | title = {forcats: Tools for Working with Categorical Variables (Factors)}, 39 | author = {Hadley Wickham}, 40 | year = {2019}, 41 | note = {R package version 0.4.0}, 42 | url = {https://CRAN.R-project.org/package=forcats}, 43 | } 44 | @Manual{R-ggplot2, 45 | title = {ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics}, 46 | author = {Hadley Wickham and Winston Chang and Lionel Henry and Thomas Lin Pedersen and Kohske Takahashi and Claus Wilke and Kara Woo and Hiroaki Yutani}, 47 | year = {2019}, 48 | note = {http://ggplot2.tidyverse.org, https://github.com/tidyverse/ggplot2}, 49 | } 50 | @Manual{R-hrbrthemes, 51 | title = {hrbrthemes: Additional Themes, Theme Components and Utilities for 'ggplot2'}, 52 | author = {Bob Rudis}, 53 | year = {2019}, 54 | note = {R package version 0.6.0}, 55 | url = {https://CRAN.R-project.org/package=hrbrthemes}, 56 | } 57 | @Manual{R-knitr, 58 | title = {knitr: A General-Purpose Package for Dynamic Report Generation in R}, 59 | author = {Yihui Xie}, 60 | year = {2019}, 61 | note = {R package version 1.22}, 62 | url = {https://CRAN.R-project.org/package=knitr}, 63 | } 64 | @Manual{R-purrr, 65 | title = {purrr: Functional Programming Tools}, 66 | author = {Lionel Henry and Hadley Wickham}, 67 | year = {2019}, 68 | note = {R package version 0.3.2}, 69 | url = {https://CRAN.R-project.org/package=purrr}, 70 | } 71 | @Manual{R-readr, 72 | title = {readr: Read Rectangular Text Data}, 73 | author = {Hadley Wickham and Jim Hester and Romain Francois}, 74 | year = {2018}, 75 | note = {R package version 1.3.1}, 76 | url = {https://CRAN.R-project.org/package=readr}, 77 | } 78 | @Manual{R-rsample, 79 | title = {rsample: General Resampling Infrastructure}, 80 | author = {Max Kuhn and Hadley Wickham}, 81 | year = {2019}, 82 | note = {R package version 0.0.4}, 83 | url = {https://CRAN.R-project.org/package=rsample}, 84 | } 85 | @Manual{R-stringr, 86 | title = {stringr: Simple, Consistent Wrappers for Common String Operations}, 87 | author = {Hadley Wickham}, 88 | year = {2019}, 89 | note = {R package version 1.4.0}, 90 | url = {https://CRAN.R-project.org/package=stringr}, 91 | } 92 | @Manual{R-tibble, 93 | title = {tibble: Simple Data Frames}, 94 | author = {Kirill Müller and Hadley Wickham}, 95 | year = {2019}, 96 | note = {R package version 2.1.1}, 97 | url = {https://CRAN.R-project.org/package=tibble}, 98 | } 99 | @Manual{R-tidydscompanion, 100 | title = {tidydscompanion: A Companion Package For Using R And The Tidyverse For Data 101 | Science}, 102 | author = {W. Jake Thompson}, 103 | year = {2019}, 104 | note = {R package version 0.0.1}, 105 | url = {https://github.com/wjakethompson/jayhawkdown}, 106 | } 107 | @Manual{R-tidyr, 108 | title = {tidyr: Easily Tidy Data with 'spread()' and 'gather()' Functions}, 109 | author = {Hadley Wickham and Lionel Henry}, 110 | year = {2019}, 111 | note = {http://tidyr.tidyverse.org, https://github.com/tidyverse/tidyr}, 112 | } 113 | @Manual{R-tidyverse, 114 | title = {tidyverse: Easily Install and Load the 'Tidyverse'}, 115 | author = {Hadley Wickham}, 116 | year = {2017}, 117 | note = {R package version 1.2.1}, 118 | url = {https://CRAN.R-project.org/package=tidyverse}, 119 | } 120 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/bib/references.bib: -------------------------------------------------------------------------------- 1 | @book{gre, 2 | author = {{Educational Testing Service}}, 3 | year = {2012}, 4 | title = {The official guide to the {GRE} revised general test}, 5 | edition = {2nd}, 6 | address = {New York, NY}, 7 | publisher = {McGraw-Hill}, 8 | isbn = {9780071791236} 9 | } 10 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Examining the Effect of Gender on Graduate Program Admission" 3 | author: "Jake Thompson" 4 | date: "`r format(Sys.Date(), '%B %d, %Y')`" 5 | bibliography: ["bib/references.bib", "bib/packages.bib", "bib/knit.bib"] 6 | biblio-style: apalike2 7 | csl: csl/apa.csl 8 | link-citations: true 9 | output: 10 | bookdown::html_document2: 11 | theme: cosmo 12 | number_sections: false 13 | --- 14 | 15 | ```{r setup, include = FALSE} 16 | library(tidyverse) 17 | library(broom) 18 | library(rsample) 19 | library(tidydscompanion) 20 | library(knitr) 21 | library(hrbrthemes) 22 | library(colorblindr) 23 | 24 | knitr::opts_chunk$set( 25 | echo = FALSE, 26 | message = FALSE, 27 | warning = FALSE, 28 | error = FALSE, 29 | fig.path = "figures/", 30 | fig.retina = 3, 31 | fig.width = 8, 32 | fig.asp = 0.618, 33 | fig.align = "center", 34 | out.width = "90%" 35 | ) 36 | ``` 37 | 38 | Admissions into graduate school is important for many reasons. In most academic programs, admission requires an application that includes test scores and undergraduate grade point average (GPA). However, there are other factors of an applications that should not be considered when deciding whether or not to admit an individual into a graduate program. For example, an individual's gender should not impact the admission decision. Stated another way, given comparable academic credentials, individuals of different genders should have the same probability of acceptance. In this report, we explore the effect of applicants' gender on the admission decision for a made-up university. Using one of the more popular graduate admissions tests, the Graduate Record Examination [GRE; @gre]. 39 | 40 | ## Data 41 | 42 | ```{r read-data} 43 | data("admission", package = "tidydscompanion") 44 | 45 | # calculate summary statistics 46 | total <- nrow(admission) 47 | total_admit <- sum(admission$admit) 48 | rate <- round((total_admit / total) * 100, digits = 0) 49 | total <- prettyNum(total, big.mark = ",") 50 | total_admit <- prettyNum(total_admit, big.mark = ",") 51 | 52 | gender_counts <- admission %>% 53 | count(gender) %>% 54 | pivot_wider(names_from = gender, values_from = n) 55 | 56 | male_total <- gender_counts$Male 57 | female_total <- gender_counts$Female 58 | male_admit <- sum(admission$admit[admission$gender == "Male"]) 59 | female_admit <- sum(admission$admit[admission$gender == "Female"]) 60 | male_rate <- round((male_admit / male_total) * 100, digits = 0) 61 | female_rate <- round((female_admit / female_total) * 100, digits = 0) 62 | 63 | male_total <- prettyNum(male_total, big.mark = ",") 64 | female_total <- prettyNum(female_total, big.mark = ",") 65 | ``` 66 | 67 | Data was collected for `r total` make-believe students. In total, there were `r male_total` males and `r female_total` females included in the sample. Of the `r total` applicants, `r total_admit` (`r rate`%) were admitted into the graduate program, including `r male_rate`% of male appicants and `r female_rate`% of female applicants. The GRE consists of three parts: 68 | 69 | 1. Verbal Reasoning 70 | 2. Quantitative Reasoning 71 | 3. Analytical Writing 72 | 73 | The verbal and quantitative reasoning subtests are scored between 130 and 170 in integer increments, with an average score of 150. The writing subtest is scored on a 0 to 6 scale in 0.5 increments. Table \@ref(tab:gender-summary) shows the median scores for males and females on each section of the GRE, as well as the median GPA. This indicates that on average male and female applicants had similar scores on academic measures. 74 | 75 | ```{r gender-summary} 76 | admission %>% 77 | group_by(gender) %>% 78 | summarize(n = n(), 79 | gre_v = mean(gre_v), 80 | gre_q = mean(gre_q), 81 | gre_w = mean(gre_w), 82 | gpa = mean(gpa)) %>% 83 | kable(align = "c", booktabs = TRUE, digits = 2, 84 | format.args = list(big.mark = ","), 85 | caption = "Median test scores and GPA, by Gender", 86 | col.names = c("Gender", "n", "Verbal", "Quantitative", "Writing", 87 | "GPA")) 88 | ``` 89 | 90 | ## Method 91 | 92 | ```{r rsample-params, cache = TRUE} 93 | boot_samples <- 100 94 | folds <- 10 95 | repeats <- 10 96 | ``` 97 | 98 | ```{r single-mod} 99 | # set seed for reproducibility 100 | set.seed(32011) 101 | 102 | # run a single model on the full data set 103 | single_mod <- glm(admit ~ gre_v * gre_q + gre_w + gpa + gender, 104 | data = admission, family = "binomial") %>% 105 | augment(type.predict = "response") %>% 106 | rowid_to_column(var = "id") 107 | 108 | # sample example applicants for the text 109 | exm1 <- single_mod %>% 110 | filter(admit == 1, between(.fitted, 0.51, 0.55)) %>% 111 | sample_n(1) 112 | exm2 <- single_mod %>% 113 | filter(admit == 1, between(.fitted, 0.95, 0.99)) %>% 114 | sample_n(1) 115 | exm3 <- single_mod %>% 116 | filter(admit == 1, between(.fitted, 0.45, 0.49)) %>% 117 | sample_n(1) 118 | ``` 119 | 120 | In order to evaluate the effect of gender on admissions decisions, two types of analyses were conducted. First, the difference in average academic indicators between males and females was examined using bootstrapping. Second, v-fold cross validation was using to compare the predictive ability of logistic regression models that include gender as a predictor versus models that do not. 121 | 122 | All analyses were conducted in R version `r getRversion()` [@R-base]. In the first analysis, `r prettyNum(boot_samples, big.mark = ",")` bootstrap samples were generated using the rsample package [@R-rsample]. Then, for each bootstrap sample, the difference between the average score of males and females was calculated for each of the academic indicators: GRE Verbal Reasoning, GRE Quantitative Reasoning, GRE Analytical Writing, and GPA. If academic performance is consistent across groups (as indicated in Table \@ref(tab:gender-summary)), the distributions of each difference should be centered around zero. A *t*-test was also conducted on each measure of academic performance for the purpose of comparison to the bootstrap results. 123 | 124 | In the second analysis, a `r prettyNum(folds, big.mark = ",")`-fold cross validation with `r prettyNum(repeats, big.mark = ",")` repeat was conducted using the rsample package [@R-rsample]. For each fold, three models were estimated on the analysis (also called 'training') data. 125 | 126 | * __Empty.__ In this model, the probability of admission for each applicant is equal to the overall admission rate. 127 | * __Academics.__ In this model, the probability of admission for each applicant is predicted by only the GRE scores and GPA. 128 | * __Full.__ In this model, the probability of admission for each applicant is predicted by all academic indicators, as well as applicant gender. 129 | 130 | Model performance was assessed using the assessment (also known as 'test') data, which was not included in the model estimation. The predictive ability of model was evaluated using the proportion of correctly classified applicants and the Log Loss for the fitted probabilities for each applicant in the assessment data. The correct classification rate measures whether the predicted outcome matches the observed outcome. Because the predicted outcome is on a probability scale, applicants with predicted probabilities greater than 0.50 are predicted to be admitted, and those with a predicted probability less than 0.50 are predicted to not be admitted. 131 | 132 | The correct classification rate provides a high level overview of model performance, but is not always the best or most effective indicator. Take for example Applicant A, who was admitted and had a `r sprintf("%0.2f", pull(exm1, .fitted))` probability of being accepted (when using the full model on the entire data set). Similarly, Applicant B was also accepted but had a `r sprintf("%0.2f", pull(exm2, .fitted))` probability of being admitted. Clearly, the `r sprintf("%0.2f", pull(exm2, .fitted))` probability for Applicant B is a better prediction, even though both are counted the same for the correct classification rate. Conversely, Applicant C had a `r sprintf("%0.2f", pull(exm3, .fitted))` probability of being accepted but was admitted. Using correct classification rate, this prediction would be incorrect, even though it is very similar to the `r sprintf("%0.2f", pull(exm1, .fitted))` probability of Applicant A, which was considered correct. 133 | 134 | Instead of dichotomizing the predicted probabilities at 0.5, a better measure would evaluate the actual values of the probabilities in relation to the observed outcome. One such measure is the Log Loss. This measure penalizes predictions based on how far the fitted probabilities are from the observed outcome, with lower scores indicating more accurate predictions. The Log Loss is calculated as shown in equation \@ref(eq:log-loss), where $n$ is the total sample size of the assessment data, $\hat{y_i}$ is the model predicted probability of admission, and $y_i$ is the observed admission decision. 135 | 136 | \begin{equation} 137 | \text{LogLoss} = -\frac{1}{n}\sum_{i=1}^n[y_i\log(\hat{y_i}) + (1-y_i)\log(1-\hat{y_i})] 138 | (\#eq:log-loss) 139 | \end{equation} 140 | 141 | Because the $\log$ of the fitted probabilities is used, this measure heavily penalizes models that are confident in incorrect classifications. Figure \@ref(fig:logloss-exm) shows the penalty for a single observation with an observed outcome of 1. There is a gradual slope away from 1, but as the predicted probability gets closer to 0 (i.e., more confident in a prediction of 0), the penalty increases rapidly. As demonstrated in equation \@ref(eq:log-loss), the overall Log Loss is the average of the penalties for each observation. Thus, having confidently incorrect predictions can have a large impact on the overall Log Loss score. 142 | 143 | ```{r logloss-exm, fig.cap = "Penalty for a single observation with an observed outcome of 1."} 144 | tibble(x = seq(0.0001, 1, 0.0001)) %>% 145 | mutate(logloss = -1 * log(x)) %>% 146 | ggplot(aes(x = x, y = logloss)) + 147 | geom_line() + 148 | labs(x = expression(hat(y)[i]), 149 | y = "Log Loss") + 150 | theme_ipsum() 151 | ``` 152 | 153 | ## Results 154 | 155 | ### Comparison of Academic Indicators 156 | 157 | ```{r calc-bootstrap, cache = TRUE, dependson = "rsample-params"} 158 | # define function to calculate difference on all academic indicators between 159 | # males and females 160 | mean_diff <- function(splits) { 161 | x <- analysis(splits) 162 | 163 | x %>% 164 | select(gender, gre_v, gre_q, gre_w, gpa) %>% 165 | group_by(gender) %>% 166 | summarize_all(mean) %>% 167 | pivot_longer(-gender, names_to = "indicator", values_to = "score") %>% 168 | pivot_wider(names_from = gender, values_from = score) %>% 169 | mutate(diff = Male - Female) %>% 170 | select(indicator, diff) %>% 171 | pivot_wider(names_from = indicator, values_from = diff) 172 | } 173 | 174 | # set random seed for reproducibility 175 | set.seed(32011) 176 | 177 | # create bootstrap samples 178 | bootstrap_results <- admission %>% 179 | bootstraps(times = boot_samples) %>% 180 | mutate(results = map(splits, mean_diff)) %>% 181 | unnest(results) %>% 182 | pivot_longer(gre_v:gpa, names_to = "indicator", values_to = "score") %>% 183 | mutate(indicator = factor(indicator, 184 | levels = c("gre_v", "gre_q", "gre_w", "gpa"), 185 | labels = c("Verbal Reasoning", 186 | "Quantitative Reasoning", 187 | "Analytical Writing", "GPA"))) 188 | ``` 189 | 190 | ```{r t-tests} 191 | t_tests <- admission %>% 192 | rowid_to_column(var = "applicant") %>% 193 | select(-admit) %>% 194 | pivot_longer(gre_v:gpa, names_to = "indicator", values_to = "score") %>% 195 | group_by(indicator) %>% 196 | nest() %>% 197 | mutate(t_test = map(data, ~ t.test(score ~ gender, data = .x)), 198 | t = map_dbl(t_test, "statistic"), 199 | df = map_dbl(t_test, "parameter"), 200 | pval = map_dbl(t_test, "p.value"), 201 | indicator = factor(indicator, 202 | levels = c("gre_v", "gre_q", "gre_w", "gpa"), 203 | labels = c("Verbal Reasoning", 204 | "Quantitative Reasoning", 205 | "Analytical Writing", "GPA"))) %>% 206 | select(Measure = indicator, t, df, `p-value` = pval) 207 | ``` 208 | 209 | The distributions of the difference in average scores between males and females can be see in Figure \@ref(fig:diff-plot). As expected given the summary statistics in Table \@ref(tab:gender-summary), all differences are centered around zero. There is more variability in the differences for the GRE Verbal Reasoning and GRE Quantitative Reasoning scores; however, this is also expected given larger variability and range of possible scores for these measures. Table \@ref(tab:bootstrap-sum) shows the empirical 95% confidence interval for each difference, calculated as the 2.5 and 97.5 percentiles of the distribution for each difference. 210 | 211 | (ref:diff-plot) Average performance on academic indicators for males compared to females over `r prettyNum(boot_samples, big.mark = ",")` bootstrapped samples. 212 | 213 | ```{r diff-plot, fig.cap = "(ref:diff-plot)"} 214 | ggplot(bootstrap_results, aes(x = score, color = indicator)) + 215 | geom_density(aes(fill = indicator, color = indicator), alpha = 0.8, 216 | show.legend = FALSE) + 217 | geom_vline(xintercept = 0, linetype = "dashed") + 218 | facet_wrap(~ indicator, scales = "free_y", nrow = 2) + 219 | expand_limits(x = c(-1, 1)) + 220 | scale_color_OkabeIto() + 221 | scale_fill_OkabeIto() + 222 | labs(x = "Average score for males compared to females", y = "Density") + 223 | theme_ipsum() 224 | ``` 225 | 226 | ```{r bootstrap-sum} 227 | bootstrap_results %>% 228 | group_by(Measure = indicator) %>% 229 | summarize(Mean = mean(score), 230 | Median = median(score), 231 | `2.5%` = quantile(score, probs = 0.025), 232 | `97.5%` = quantile(score, probs = 0.975)) %>% 233 | kable(align = c("l", rep("r", 4)), booktabs = TRUE, digits = 2, 234 | caption = "Summary of bootstrapped distributions of the difference in academic indicators between males and females") 235 | ``` 236 | 237 | Finally, a *t*-test was conducted for each measure of academic performance. Equal variance was not assumed across group. Thus, the Welch (or Satterthwaite) approximation for degrees of freedom was used. The results of all the tests can be seen in Table \@ref(tab:bootstrap-t). All *t*-tests were non-significant at an alpha level of .05. This is consistent with the bootstrapped confidence intervals (Table \@ref(tab:bootstrap-sum)) and overall distributions (Figure \@ref(fig:diff-plot)), which also indicated no differences between the two groups on any of the academic performance measures. 238 | 239 | (ref:bootstrap-t) *t*-tests for difference in mean performance on each academic measure between males and females 240 | 241 | ```{r bootstrap-t} 242 | t_tests %>% 243 | mutate(df = round(df, digits = 0)) %>% 244 | kable(align = c("l", "r", "r", "r"), booktabs = TRUE, digits = 2, 245 | format.args = list(big.mark = ","), 246 | caption = "(ref:bootstrap-t)") 247 | ``` 248 | 249 | ### Modeling the Effect of Gender 250 | 251 | ```{r calc-vfold, cache = TRUE, dependson = "rsample-params"} 252 | # define the formulas for each model 253 | empty <- as.formula(admit ~ 1) 254 | academics <- as.formula(admit ~ gre_v * gre_q + gre_w + gpa) 255 | full <- as.formula(admit ~ gre_v * gre_q + gre_w + gpa + gender) 256 | 257 | # define function for fitting model and applying to assessment data 258 | holdout_results <- function(splits, ...) { 259 | # Fit the model to the 90% 260 | mod <- glm(..., data = analysis(splits), family = binomial) 261 | 262 | # Save the 10% 263 | holdout <- assessment(splits) 264 | 265 | # `augment` will save the predictions with the holdout data set 266 | res <- broom::augment(mod, newdata = holdout, type.predict = "response") %>% 267 | mutate(prediction = ifelse(.fitted > 0.5, 1L, 0L), 268 | correct = prediction == admit) 269 | 270 | # Return the assessment data set with the additional columns 271 | res 272 | } 273 | 274 | # set random seed for reproducibility 275 | set.seed(32011) 276 | 277 | # create v-fold samples 278 | vfold_results <- admission %>% 279 | vfold_cv(v = folds, repeats = repeats) %>% 280 | mutate(empty_mod = map(splits, holdout_results, empty), 281 | acadm_mod = map(splits, holdout_results, academics), 282 | compl_mod = map(splits, holdout_results, full)) %>% 283 | ungroup() %>% 284 | select(-splits) %>% 285 | pivot_longer(contains("mod"), names_to = "model", values_to = "results") %>% 286 | unnest(results) %>% 287 | group_by(id, id2, model) %>% 288 | summarize(pct_cor = mean(correct), 289 | logloss = -1 * mean((admit * log(.fitted)) + ((1 - admit) * log(1 - .fitted)))) 290 | ``` 291 | 292 | The `r prettyNum(folds, big.mark = ",")`-fold cross validation procedure was repeated `r prettyNum(repeats, big.mark = ",")` times for a total of `r prettyNum(folds * repeats, big.mark = ",")` resamples that were used to estimate and then evaluate the predictive accuracy of each of the three models. The first measure of predictive accuracy of the models is the correct classification rate. For this analysis, an applicant was considered correctly classified if their model-predicted probability of admission was greater than .5 and they were admitted, or their model-predicted probability was less than .5 and they were not admitted. Figure \@ref(fig:ccr-dist) shows this distribution of correct classification rates across all resamples for each of the investigated models. The academics only and full models both have distinctly higher correct classification rates than the empty model. The full model has a slightly higher correct classification rate the than academics only model on average, but there is a great deal of overlap between the two distributions. 293 | 294 | ```{r ccr-dist, fig.cap = "Distributions of applicant correct classification rate."} 295 | ggplot(vfold_results, aes(x = pct_cor)) + 296 | geom_density(aes(color = model, fill = model), alpha = 0.8) + 297 | scale_color_OkabeIto(limits = c("compl_mod", "acadm_mod", "empty_mod"), 298 | breaks = c("empty_mod", "acadm_mod", "compl_mod"), 299 | labels = c("Empty", "Academics", "Full")) + 300 | scale_fill_OkabeIto(limits = c("compl_mod", "acadm_mod", "empty_mod"), 301 | breaks = c("empty_mod", "acadm_mod", "compl_mod"), 302 | labels = c("Empty", "Academics", "Full")) + 303 | expand_limits(x = c(0.6, 0.9)) + 304 | scale_x_percent() + 305 | labs(x = "Correct Classification Rate", y = "Density", color = "Model", 306 | fill = "Model") + 307 | theme_ipsum_ps() + 308 | theme(legend.position = "bottom") + 309 | guides(fill = guide_legend(override.aes = list(alpha = 1))) 310 | ``` 311 | 312 | The second measure of predictive accuracy to be evaluated was the Log Loss, as defined in equation \@ref(eq:log-loss). Figure \@ref(fig:logloss) shows the median Log Loss values for call models, along with 80%, 95%, and 99% confidence intervals calculated from the empirical distribution of values estimated across all `r prettyNum(folds * repeats, big.mark = ",")` cross validation resamples. As with the correct classification rate, the academics and full models both outperform the empty model. Once again the full model show the best performance, as it has the lowest median Log Loss. However, there is a also a great deal of overlap in the confidence intervals for the Log Loss of the academics only and full models. 313 | 314 | ```{r logloss, fig.cap = "Log Loss of competing models."} 315 | vfold_results %>% 316 | group_by(model) %>% 317 | summarize(med = median(logloss), 318 | lb_99 = quantile(logloss, prob = 0.005), 319 | ub_99 = quantile(logloss, prob = 0.995), 320 | lb_95 = quantile(logloss, prob = 0.025), 321 | ub_95 = quantile(logloss, prob = 0.975), 322 | lb_80 = quantile(logloss, prob = 0.100), 323 | ub_80 = quantile(logloss, prob = 0.900)) %>% 324 | pivot_longer(contains("_"), names_to = "boundary", values_to = "value") %>% 325 | separate(boundary, into = c("bound", "level")) %>% 326 | pivot_wider(names_from = bound, values_from = value) %>% 327 | mutate(level = paste0(level, "%")) %>% 328 | ggplot() + 329 | geom_errorbarh( 330 | aes(y = model, xmin = lb, xmax = ub, color = level, size = level), 331 | height = 0 332 | ) + 333 | geom_point(aes(x = med, y = model), color = "#E69F00", size = 3) + 334 | expand_limits(x = c(0.2, 0.7)) + 335 | scale_y_discrete(limits = c("compl_mod", "acadm_mod", "empty_mod"), 336 | labels = c("Full", "Academics", "Empty")) + 337 | scale_color_manual(values = c( 338 | `80%` = darken("#56B4E9", .2), 339 | `95%` = "#56B4E9", 340 | `99%` = lighten("#56B4E9", .4) 341 | )) + 342 | scale_size_manual(values = c(`80%` = 4, `95%` = 3, `99%` = 2)) + 343 | labs(x = "Median Log Loss", y = NULL, size = "Confidence Level", 344 | color = "Confidence Level") + 345 | theme_ipsum_ps() + 346 | theme(legend.position = "bottom") 347 | ``` 348 | 349 | ## Discussion 350 | 351 | In this analysis, the effect of gender on admission into a graduate program was examined. The descriptive statistics show a difference in proportion of applicants admitted by gender, with `r male_rate`% of males and `r female_rate`% of females being accepted. Further, the analysis of the bootstrapped resampling showed no meaningful differences on any of the academic measures. Given this information, it would be expected that males and females would have the same rates of acceptance. However, when acceptance into the program is modeled parametrically, the addition of gender to the model did not significantly improve the predictive ability of the model over what was acheived with academic indicators alone. Thus, the evidence from the cross validation analyses does not support the theory that gender has a meaningful impact on an applicant's admission status. 352 | 353 | Given the conflicting evidence, further investigation is warranted. Notably, this investigation did not inlcude many variables that factor into an admission decision including interviews, personal statements, and letters of reference. All of these variables play an important role in the review and admission process, and thus would be important to include in a more thorough analysis. 354 | 355 | ### Colophon 356 | 357 | This report was written in R Markdown using the rmarkdown [@R-rmarkdown] and bookdown [@R-bookdown] packages. All graphics were created using the ggplot2 package [@R-ggplot2], with theming and coloring provided by the hrbrthemes [@R-hrbrthemes] and colorblindr [@R-colorblindr] packages respectively. Tables were created with the knitr package [@R-knitr]. Analyses were completed using the dplyr [@R-dplyr], purrr [@R-purrr], stats [@R-base], tibble [@R-tibble], and tidyr [@R-tidyr] packages. 358 | 359 | ## References 360 | 361 | ```{r write-packages, include = FALSE} 362 | if (!file.exists("bib/packages.bib")) file.create("bib/packages.bib") 363 | if (!file.exists("bib/knit.bib")) file.create("bib/knit.bib") 364 | suppressWarnings( 365 | knitr::write_bib(c("rmarkdown", "bookdown"), "bib/knit.bib") 366 | ) 367 | suppressWarnings( 368 | knitr::write_bib(c(.packages()), "bib/packages.bib") 369 | ) 370 | ``` 371 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/__packages: -------------------------------------------------------------------------------- 1 | base 2 | tidyverse 3 | ggplot2 4 | tibble 5 | tidyr 6 | readr 7 | purrr 8 | dplyr 9 | stringr 10 | forcats 11 | broom 12 | rsample 13 | tidydscompanion 14 | here 15 | knitr 16 | hrbrthemes 17 | colorspace 18 | colorblindr 19 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.RData -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.rdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.rdb -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.rdx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-bootstrap_ba608ce52d3b8498a83e9ee0e900bec5.rdx -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.RData -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.rdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.rdb -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.rdx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/calc-vfold_9cb0ac5ec5a1b5d90ac491c57c4adc29.rdx -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.RData -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.rdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.rdb -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.rdx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/case-study-2-report-Solutions_cache/html/rsample-params_ba3fec9f7a2a8b96ec8db3419cdaa4e7.rdx -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/ccr-dist-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/ccr-dist-1.png -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/diff-plot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/diff-plot-1.png -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/logloss-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/logloss-1.png -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/logloss-exm-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wjakethompson/tidyds-2019/2bc6a07d913a2e8aa27c17e5d65b9f47f529595d/solutions/11-Communicate-Solutions/case-study-2-report-Solutions/figures/logloss-exm-1.png -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/chunk-basics-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "R in Markdown" 3 | author: "Jake Thompson" 4 | date: "`r Sys.Date()`" 5 | output: 6 | html_document: 7 | highlight: pygments 8 | theme: cosmo 9 | --- 10 | 11 | ```{r setup, include = FALSE} 12 | library(tidyverse) 13 | ``` 14 | 15 | ## Preliminary tasks 16 | 17 | 1. It's a good practice to load the major packages for a document in a "setup" or "load packages" chunk. But the output from that chunk is a poor way for a reader to start off with a document. 18 | * Add a chunk option to `setup` to suppress the output. (Hint: the option begins with `i`.) 19 | 2. Add an inline R chunk to your document so that the current date/time show up here: *`r Sys.time()`*. Try to put the date in italics. 20 | 21 | ### Add a plot chunk 22 | 23 | 3. Make chunk producing a simple plot using the `mtcars` data frame built into R. 24 | 25 | ```{r make-plot, echo = FALSE} 26 | ggplot(mtcars, aes(mpg, disp)) + 27 | geom_point() 28 | ``` 29 | 30 | 4. Add a label to the chunk in (3). 31 | 5. Change the chunk options (echo, eval, include, message, warning) to explore what changes in the output. Then, decide on an appropriate option for each of the chunks. Compare your choices to your neighbors'. 32 | 6. Turn the following into a proper chunk for R evaluation rather than just display of code. 33 | 34 | ```{r summarize-mtcars, collapse = TRUE} 35 | names(mtcars) 36 | mtcars %>% 37 | summarize_all(median) 38 | ``` 39 | 40 | 7. Returning to the chunk you made in (6), what does the option collapse (set to TRUE or FALSE) do? What is the default setting for this option? 41 | 42 | ## Inline code 43 | 44 | Typical uses of inline code ... 45 | 46 | 8. Avoiding hard-coding of numbers. (They become out of date.) 47 | - Bad: Our analysis involved 51 cars. 48 | - Better: Our analysis involved `r nrow(mtcars)` cars. 49 | 50 | ```{r car_t_test, echo = FALSE} 51 | mod <- lm(mpg ~ disp + cyl, data = mtcars) 52 | ``` 53 | 54 | 9. Reporting of results calculated elsewhere. 55 | - Bad: Keeping displacement constant, an additional cylinder is associated with a loss of about 1.6 miles-per-gallon. 56 | - Better: ...with a `r ifelse(coef(mod)["cyl"] > 0, "gain", "loss")` of about `r round(abs(coef(mod)["cyl"]), 1)` miles-per-gallon. 57 | 58 | **Stretch goal**: Update the date field in the YAML so that the date at the time of knitting the document is printed. (Hint: You can put YAML strings in quotation marks.) 59 | -------------------------------------------------------------------------------- /solutions/11-Communicate-Solutions/my-first-rmd-Solutions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Communicate - Solution" 3 | author: "Jake Thompson" 4 | date: "`r Sys.Date()`" 5 | output: 6 | html_document: 7 | toc: true 8 | theme: "darkly" 9 | --- 10 | 11 | ```{r setup, include=FALSE} 12 | knitr::opts_chunk$set(echo = TRUE) 13 | ``` 14 | 15 | # R Markdown 16 | 17 | This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see . 18 | 19 | When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this: 20 | 21 | ```{r cars} 22 | summary(cars) 23 | ``` 24 | 25 | # Including Plots 26 | 27 | You can also embed plots, for example: 28 | 29 | ```{r pressure, echo=FALSE} 30 | plot(pressure) 31 | ``` 32 | 33 | Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot. 34 | 35 | # Including Equations 36 | 37 | Include equations by using `$`. LaTeX equations surrounded by `$$` will be centered on their own line. Single `$` will be rendered inline ($a^2 + b^2 = c^2$). 38 | 39 | $$ 40 | e = mc^2 41 | $$ 42 | 43 | # Including Images 44 | 45 | ![GIFs work too!](https://media.giphy.com/media/5GoVLqeAOo6PK/giphy.gif) 46 | -------------------------------------------------------------------------------- /solutions/12-reprex.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(glue) 3 | 4 | num_var <- 3 5 | 6 | my_data <- rep(list(c(0L, 1L)), num_var) %>% 7 | set_names(glue("var_{seq_len(num_var)}")) %>% 8 | expand.grid() 9 | 10 | # Works, but not generalizable to cases where `num_var` isn't 3 11 | my_data %>% 12 | mutate(total = rowSums(.)) %>% 13 | arrange(total, desc(var_1, var_2, var_3)) 14 | 15 | # Errors 16 | my_data %>% 17 | mutate(total = rowSums(.)) %>% 18 | arrange(total, desc(everything())) 19 | 20 | 21 | reprex::reprex(venue = "so", si = TRUE, style = TRUE) 22 | -------------------------------------------------------------------------------- /tidyds-2019.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | --------------------------------------------------------------------------------