<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="https://www.r-bloggers.com/running-a-model-on-separate-groups/"></div></div><div><a data-url="https://www.r-bloggers.com/running-a-model-on-separate-groups/" data-counturl="https://www.r-bloggers.com/running-a-model-on-separate-groups/" data-count="horizontal" data-text="Running a model on separate groups" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups"> blogR</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p>Ever wanted to run a model on separate groups of data? Read on!</p>
<p>Here’s an example of a regression model fitted to separate groups: predicting a car’s Miles per Gallon with various attributes, but spearately for automatic and manual cars.</p>
<pre><code>library(tidyverse)
library(broom)
mtcars %>% 
  nest(-am) %>% 
  mutate(am = factor(am, levels = c(0, 1), labels = c(&quot;automatic&quot;, &quot;manual&quot;)),
         fit = map(data, ~ lm(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, augment)) %>% 
  unnest(results) %>% 
  ggplot(aes(x = mpg, y = .fitted)) +
    geom_abline(intercept = 0, slope = 1, alpha = .2) +  # Line of perfect fit
    geom_point() +
    facet_grid(am ~ .) +
    labs(x = &quot;Miles Per Gallon&quot;, y = &quot;Predicted Value&quot;) +
    theme_bw()
</code></pre>
<p><a target="_blank" href="https://i2.wp.com/svbtleusercontent.com/8h5v6htdfn3g5q.png?ssl=1"><img alt="init-example-1.png" src="https://i0.wp.com/svbtleusercontent.com/8h5v6htdfn3g5q_small.png?w=456&ssl=1" data-recalc-dims="1"></a></p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#getting-started_2"> </a>Getting Started</h2>
<p>A few things to do/keep in mind before getting started…</p>
<h3><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#a-lot-of-detail-for-novices_3"> </a>A lot of detail for novices</h3>
<p>I started this post after working on a larger problem for which I couldn’t add detail about lower-level aspects. So this post is very detailed about a particular aspect of a larger problem and, thus, best suited for novice to intermediate R users.</p>
<h3><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#one-of-many-approaches_3"> </a>One of many approaches</h3>
<p>There are many ways to tackle this problem. We’ll cover a particular approach that I like, but be mindful that there are plenty of alternatives out there.</p>
<h3><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#the-tidyverse_3"> </a>The Tidyverse</h3>
<p>We’ll be using functions from many tidyverse packages like dplyr and ggplot2, as well as the tidy modelling package <a target="_blank" href="https://cran.r-project.org/web/packages/broom/index.html">broom</a>. If you’re unfamiliar with these and want to learn more, a good place to get started is Hadley Wickham’s <a target="_blank" href="http://r4ds.had.co.nz/">R for Data Science</a>. Let’s load these as follows (making use of the new <a target="_blank" href="https://cran.r-project.org/web/packages/tidyverse/index.html">tidyverse</a> package):</p>
<pre><code>library(tidyverse)
library(broom)
</code></pre>
<h3><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#mtcars_3"> </a>mtcars</h3>
<p>Ah, <code>mtcars</code>. My favourite data set. We’re gong to use this data set for most examples. Be sure to check it out if you’re unfamiliar with it! Run <code>?mtcars</code>, or here’s a quick reminder:</p>
<pre><code>head(mtcars)
#>                    mpg cyl disp  hp drat    wt  qsec vs am gear carb
#> Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
#> Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
#> Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
#> Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
#> Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
#> Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1
</code></pre>
<p>Let’s get to it.</p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#nesting-tibbles_2"> </a>Nesting Tibbles</h2>
<p>Nested tibbles – sounds like some rare bird! For those who aren’t familiar with them, “<a target="_blank" href="https://cran.r-project.org/web/packages/tibble/vignettes/tibble.html">tibbles are a modern take on data frames</a>”. For our purposes here, you can think of a tibble like a data frame. It just prints to the console a little differently. Click the quote to learn more from the tibble vignette.</p>
<p>So what do I mean by nested tibbles? Well, this is when we take sets of columns and rows from one data frame/tibble, and save (nest) them as cells in a new tibble. Make sense? No? Not to worry. An example will likley explain better.</p>
<p>We do this with <code>nest()</code> from the tidyr package (which is loaded with <code>library(tidyverse)</code>). Perhaps the most common use of this function, and exactly how we’ll use it, is to pipe in a tibble or data frame, and drop one or more categorical variables using <code>-</code>. For example, let’s <code>nest()</code> the <code>mtcars</code> data set and drop the cylinder (<code>cyl</code>) column:</p>
<pre><code>mtcars %>% nest(-cyl)
#> # A tibble: 3 × 2
#>     cyl               data
#>   &lt;dbl>             &lt;list>
#> 1     6  &lt;tibble [7 × 10]>
#> 2     4 &lt;tibble [11 × 10]>
#> 3     8 &lt;tibble [14 × 10]>
</code></pre>
<p>This looks interesting. We have one column that makes sense: <code>cyl</code> lists each of the levels of the cylinder variable. But what’s that <code>data</code> colum? Looks like tibbles. Let’s look into the tibble in the row where <code>cyl == 4</code> to learn more:</p>
<pre><code>d &lt;- mtcars %>% nest(-cyl)
d$data[d$cyl == 4]
#> [[1]]
#> # A tibble: 11 × 10
#>      mpg  disp    hp  drat    wt  qsec    vs    am  gear  carb
#>    &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl>
#> 1   22.8 108.0    93  3.85 2.320 18.61     1     1     4     1
#> 2   24.4 146.7    62  3.69 3.190 20.00     1     0     4     2
#> 3   22.8 140.8    95  3.92 3.150 22.90     1     0     4     2
#> 4   32.4  78.7    66  4.08 2.200 19.47     1     1     4     1
#> 5   30.4  75.7    52  4.93 1.615 18.52     1     1     4     2
#> 6   33.9  71.1    65  4.22 1.835 19.90     1     1     4     1
#> 7   21.5 120.1    97  3.70 2.465 20.01     1     0     3     1
#> 8   27.3  79.0    66  4.08 1.935 18.90     1     1     4     1
#> 9   26.0 120.3    91  4.43 2.140 16.70     0     1     5     2
#> 10  30.4  95.1   113  3.77 1.513 16.90     1     1     5     2
#> 11  21.4 121.0   109  4.11 2.780 18.60     1     1     4     2
</code></pre>
<p>This looks a bit like the <code>mtcars</code> data, but did you notice that the <code>cyl</code> column isn’t there and that there’s only 11 rows? This is because we see a subset of the complete <code>mtcars</code> data set where <code>cyl == 4</code>. By using <code>nest(-cyl)</code>, we’ve collapsed the entire <code>mtcars</code> data set into two columns and three rows (one for each category in <code>cyl</code>).</p>
<p>Aside, it’s easy to dissect data by multiple categorical variables further by dropping them in <code>nest()</code>. For example, we can nest our data by the number of cylinders AND whether the car is automatic or manual (<code>am</code>) as follows:</p>
<pre><code>mtcars %>% nest(-cyl, -am)
#> # A tibble: 6 × 3
#>     cyl    am              data
#>   &lt;dbl> &lt;dbl>            &lt;list>
#> 1     6     1  &lt;tibble [3 × 9]>
#> 2     4     1  &lt;tibble [8 × 9]>
#> 3     6     0  &lt;tibble [4 × 9]>
#> 4     8     0 &lt;tibble [12 × 9]>
#> 5     4     0  &lt;tibble [3 × 9]>
#> 6     8     1  &lt;tibble [2 × 9]>
</code></pre>
<p>If you compare carefully to the above, you’ll notice that each tibble in <code>data</code> has 9 columns instead of 10. This is because we’ve now extracted <code>am</code>. Also, there are far fewer rows in each tibble. This is because each tibble contains a much smaller subset of the data. E.g., instead of all the data for cars with 4 cylinders being in one cell, this data is further split into two cells – one for automatic, and one for manual cars.</p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#fitting-models-to-nested-data_2"> </a>Fitting models to nested data</h2>
<p>Now that we can separate data for each group(s), we can fit a model to each tibble in <code>data</code> using <code>map()</code> from the purrr package (also <code>tidyverse</code>). We’re going to add the results to our existing tibble using <code>mutate()</code> from the dplyr package (again, <code>tidyverse</code>). Here’s a generic version of our pipe with adjustable parts in caps:</p>
<pre><code>DATA_SET %>% 
  nest(-CATEGORICAL_VARIABLE) %>% 
  mutate(fit = map(data, ~ MODEL_FUNCTION(...)))
</code></pre>
<p>Where you see <code>...</code>, using a single dot (<code>.</code>) will represent each nested tibble</p>
<p>Let’s start with a silly but simple example: a student <em>t</em>-test examining whether <code>mpg</code> is significantly greater than 0 for each group of cars with different cylinders:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ t.test(.$mpg)))
#> # A tibble: 3 × 3
#>     cyl               data         fit
#>   &lt;dbl>             &lt;list>      &lt;list>
#> 1     6  &lt;tibble [7 × 10]> &lt;S3: htest>
#> 2     4 &lt;tibble [11 × 10]> &lt;S3: htest>
#> 3     8 &lt;tibble [14 × 10]> &lt;S3: htest>
</code></pre>
<p>We’ll talk about the new <code>fit</code> column in a moment. First, let’s discuss the new line, <code>mutate(fit = map(data, ~ t.test(.$mpg)))</code>:</p>
<ul>
<li> <code>mutate(fit = ...)</code> is a dplyr function that will add a new column to our tibble called <code>fit</code>.</li>
<li> <code>map(data, ...)</code> is a purrr function that iterates through each cell of the <code>data</code> column (which has our nested tibbles).</li>
<li> <code>~ t.test(.$mpg)</code> is running the t.test for each cell. Because this takes place within <code>map()</code>, we must start with <code>~</code>, and use <code>.</code> whenever we want to reference the nested tibble that is being iterated on.</li>
</ul>
<p>What’s each <code>&lt;S3: htest></code> in the <code>fit</code> column? It’s the fitted <code>t.test()</code> model for each nested tibble. Just like we peeked into a single <code>data</code> cell, let’s look into a single <code>fit</code> cell – for cars with 4 cylinders:</p>
<pre><code>d &lt;- mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ t.test(.$mpg)))
d$fit[d$cyl == 4]
#> [[1]]
#> 
#>  One Sample t-test
#> 
#> data:  .$mpg
#> t = 19.609, df = 10, p-value = 2.603e-09
#> alternative hypothesis: true mean is not equal to 0
#> 95 percent confidence interval:
#>  23.63389 29.69338
#> sample estimates:
#> mean of x 
#>  26.66364
</code></pre>
<p>Looking good. So we now know how to <code>nest()</code> a data set by one or more groups, and fit a statistical model to the data corresponding to each group.</p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#extracting-fit-information_2"> </a>Extracting fit information</h2>
<p>Our final goal is to obtain useful information from the fitted models. We could manually look into each <code>fit</code> cell, but this is tedious. Instead, we’ll extract information from our fitted models by adding one or more lines to <code>mutate()</code>, and using <code>map_*(fit, ...)</code> to iterate through each fitted model. For example, the following extracts the <code>p.values</code> from each t.test into a new column called <code>p</code>:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ t.test(.$mpg)),
         p   = map_dbl(fit, &quot;p.value&quot;))
#> # A tibble: 3 × 4
#>     cyl               data         fit            p
#>   &lt;dbl>             &lt;list>      &lt;list>        &lt;dbl>
#> 1     6  &lt;tibble [7 × 10]> &lt;S3: htest> 3.096529e-08
#> 2     4 &lt;tibble [11 × 10]> &lt;S3: htest> 2.602733e-09
#> 3     8 &lt;tibble [14 × 10]> &lt;S3: htest> 1.092804e-11
</code></pre>
<p><code>map_dbl()</code> is used because we want to return a number (a “double”) rather than a list of objects (which is what <code>map()</code> does). Explaining the variants of <code>map()</code> and how to use them is well beyond the scope of this post. The important point here is that we can iterate through our fitted models in the <code>fit</code> column to extract information for each group of data. For more details, I recommend reading the <a target="_blank" href="http://r4ds.had.co.nz/iteration.html#the-map-functions">“The Map Functions” in R for Data Science</a>.</p>
<h3><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#broom-and-unnest_3"> </a>broom and unnest()</h3>
<p>In addition to extracting a single value like above, we can extract entire data frames of information generated via functions from the broom package (which are available for most of the common models in R). For example, the <code>glance()</code> function returns a one-row data frame of model information. Let’s extract this information into a new column called <code>results</code>:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ t.test(.$mpg)),
         results = map(fit, glance))
#> # A tibble: 3 × 4
#>     cyl               data         fit              results
#>   &lt;dbl>             &lt;list>      &lt;list>               &lt;list>
#> 1     6  &lt;tibble [7 × 10]> &lt;S3: htest> &lt;data.frame [1 × 8]>
#> 2     4 &lt;tibble [11 × 10]> &lt;S3: htest> &lt;data.frame [1 × 8]>
#> 3     8 &lt;tibble [14 × 10]> &lt;S3: htest> &lt;data.frame [1 × 8]>
</code></pre>
<p>If you extract information like this, the next thing you’re likely to want to do is <code>unnest()</code> it as follows:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ t.test(.$mpg)),
         results = map(fit, glance)) %>% 
  unnest(results)
#> # A tibble: 3 × 11
#>     cyl               data         fit estimate statistic      p.value
#>   &lt;dbl>             &lt;list>      &lt;list>    &lt;dbl>     &lt;dbl>        &lt;dbl>
#> 1     6  &lt;tibble [7 × 10]> &lt;S3: htest> 19.74286  35.93552 3.096529e-08
#> 2     4 &lt;tibble [11 × 10]> &lt;S3: htest> 26.66364  19.60901 2.602733e-09
#> 3     8 &lt;tibble [14 × 10]> &lt;S3: htest> 15.10000  22.06952 1.092804e-11
#> # ... with 5 more variables: parameter &lt;dbl>, conf.low &lt;dbl>,
#> #   conf.high &lt;dbl>, method &lt;fctr>, alternative &lt;fctr>
</code></pre>
<p>We’ve now unnested all of the model information, which includes the <em>t</em> value (<code>statistic</code>), the <em>p</em> value (<code>p.value</code>), and many others.</p>
<p>We can do whatever we want with this information. For example, the below plots the group <code>mpg</code> means with confidence intervals generated by the t.test:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ t.test(.$mpg)),
         results = map(fit, glance)) %>% 
  unnest(results) %>% 
  ggplot(aes(x = factor(cyl), y = estimate)) +
    geom_bar(stat = &quot;identity&quot;) +
    geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = .2) +
    labs(x = &quot;Cylinders (cyl)&quot;, y = &quot;Miles Per Gallon (mpg)&quot;)
</code></pre>
<p><a target="_blank" href="https://i2.wp.com/svbtleusercontent.com/vnxwfwn1un7dya.png?ssl=1"><img alt="unnamed-chunk-13-1.png" src="https://i2.wp.com/svbtleusercontent.com/vnxwfwn1un7dya_small.png?w=456&ssl=1" data-recalc-dims="1"></a></p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#regression_2"> </a>Regression</h2>
<p>Let’s push ourselves and see if we can do the same sort of thing for liner regression. Say we want to examine whether the prediction of <code>mpg</code> by <code>hp</code>, <code>wt</code> and <code>disp</code>, differs for cars with different numbers of cylinders. The first significant change will be our <code>fit</code> variable, created as follows:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ lm(mpg ~ hp + wt + disp, data = .)))
#> # A tibble: 3 × 3
#>     cyl               data      fit
#>   &lt;dbl>             &lt;list>   &lt;list>
#> 1     6  &lt;tibble [7 × 10]> &lt;S3: lm>
#> 2     4 &lt;tibble [11 × 10]> &lt;S3: lm>
#> 3     8 &lt;tibble [14 × 10]> &lt;S3: lm>
</code></pre>
<p>That’s it! Notice how everything else is the same. All we’ve done is swapped out a <code>t.test()</code> for <code>lm()</code>, using our variables and data in the appropriate places. Let’s <code>glance()</code> at the model:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ lm(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, glance)) %>% 
  unnest(results)
#> # A tibble: 3 × 14
#>     cyl               data      fit r.squared adj.r.squared    sigma
#>   &lt;dbl>             &lt;list>   &lt;list>     &lt;dbl>         &lt;dbl>    &lt;dbl>
#> 1     6  &lt;tibble [7 × 10]> &lt;S3: lm> 0.7217114     0.4434228 1.084421
#> 2     4 &lt;tibble [11 × 10]> &lt;S3: lm> 0.7080702     0.5829574 2.912394
#> 3     8 &lt;tibble [14 × 10]> &lt;S3: lm> 0.4970692     0.3461900 2.070017
#> # ... with 8 more variables: statistic &lt;dbl>, p.value &lt;dbl>, df &lt;int>,
#> #   logLik &lt;dbl>, AIC &lt;dbl>, BIC &lt;dbl>, deviance &lt;dbl>, df.residual &lt;int>
</code></pre>
<p>We haven’t added anything we haven’t seen already. Let’s go and plot the R-squared values to see just how much variance is accounted for in each model:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ lm(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, glance)) %>% 
  unnest(results) %>% 
  ggplot(aes(x = factor(cyl), y = r.squared)) +
    geom_bar(stat = &quot;identity&quot;) +
    labs(x = &quot;Cylinders&quot;, y = expression(R^{2}))
</code></pre>
<p><a target="_blank" href="https://i2.wp.com/svbtleusercontent.com/y2vrxfwkgd079g.png?ssl=1"><img alt="unnamed-chunk-16-1.png" src="https://i0.wp.com/svbtleusercontent.com/y2vrxfwkgd079g_small.png?w=456&ssl=1" data-recalc-dims="1"></a></p>
<p>It looks to me like the model performs poorer for cars with 8 cylinders than cars with 4 or 6 cylinders.</p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#rowwise-values-and-code-classprettyprintaugme_2"> </a>Row-wise values and <code>augment()</code></h2>
<p>We’ll cover one final addition: extracting row-wise data with broom’s <code>augment()</code> function. Unlike <code>glance()</code>, <code>augment()</code> extracts information that matches every row of the original data such as the predicted and residual values. If we have a model that <code>augment()</code> works with, we can add it to our mutate call just as we added <code>glance()</code>. Let’s swap out <code>glance()</code> for <code>augment()</code> in the regression model above:</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ lm(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, augment))
#> # A tibble: 3 × 4
#>     cyl               data      fit                results
#>   &lt;dbl>             &lt;list>   &lt;list>                 &lt;list>
#> 1     6  &lt;tibble [7 × 10]> &lt;S3: lm>  &lt;data.frame [7 × 11]>
#> 2     4 &lt;tibble [11 × 10]> &lt;S3: lm> &lt;data.frame [11 × 11]>
#> 3     8 &lt;tibble [14 × 10]> &lt;S3: lm> &lt;data.frame [14 × 11]>
</code></pre>
<p>Our <code>results</code> column again contains data frames, but each has as many rows as the original nested tibbles in the <code>data</code> columns. What happens when we <code>unnest()</code> it?</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ lm(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, augment)) %>% 
  unnest(results)
#> # A tibble: 32 × 12
#>      cyl   mpg    hp    wt  disp  .fitted   .se.fit     .resid      .hat
#>    &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl> &lt;dbl>    &lt;dbl>     &lt;dbl>      &lt;dbl>     &lt;dbl>
#> 1      6  21.0   110 2.620 160.0 21.43923 0.8734029 -0.4392256 0.6486848
#> 2      6  21.0   110 2.875 160.0 20.44570 0.6760327  0.5543010 0.3886332
#> 3      6  21.4   110 3.215 258.0 20.69886 0.9595681  0.7011436 0.7829898
#> 4      6  18.1   105 3.460 225.0 19.26783 0.6572258 -1.1678250 0.3673108
#> 5      6  19.2   123 3.440 167.6 18.22410 0.7031674  0.9758992 0.4204573
#> 6      6  17.8   123 3.440 167.6 18.22410 0.7031674 -0.4241008 0.4204573
#> 7      6  19.7   175 2.770 145.0 19.90019 1.0688377 -0.2001924 0.9714668
#> 8      4  22.8    93 2.320 108.0 25.71625 1.0106110 -2.9162542 0.1204114
#> 9      4  24.4    62 3.190 146.7 22.89906 2.4068779  1.5009358 0.6829797
#> 10     4  22.8    95 3.150 140.8 21.26402 1.6910426  1.5359798 0.3371389
#> # ... with 22 more rows, and 3 more variables: .sigma &lt;dbl>,
#> #   .cooksd &lt;dbl>, .std.resid &lt;dbl>
</code></pre>
<p>Wow, there’s a lot going on here! We’ve unnested the entire data set related to the fitted regression models, complete with information like predicted (<code>.fitted</code>) and residual (<code>.resid</code>) values. Below is a plot of these predicted values against the actual values. For more details on this, see my previous post on <a target="_blank" href="https://drsimonj.svbtle.com/visualising-residuals">plotting residuals</a>.</p>
<pre><code>mtcars %>% 
  nest(-cyl) %>% 
  mutate(fit = map(data, ~ lm(mpg ~ hp + wt + disp, data = .)),
         results = map(fit, augment)) %>% 
  unnest(results) %>% 
  ggplot(aes(x = mpg, y = .fitted)) +
    geom_abline(intercept = 0, slope = 1, alpha = .2) +  # Line of perfect fit
    geom_point() +
    facet_grid(cyl ~ .) +
    theme_bw()
</code></pre>
<p><a target="_blank" href="https://i0.wp.com/svbtleusercontent.com/c76felf8qhoybg.png?ssl=1"><img alt="unnamed-chunk-19-1.png" src="https://i1.wp.com/svbtleusercontent.com/c76felf8qhoybg_small.png?w=456&ssl=1" data-recalc-dims="1"></a></p>
<p>This figure is showing us the fitted results of three separate regression analyses: one for each subset of the <code>mtcars</code> data corresponding to cars with 4, 6, or 8 cylinders. As we know from above, the <em>R</em><sup>2</sup> value for cars with 8 cylinders is lowest, and it’s somewhat evident from this plot (though the small sample sizes make it difficult to feel confident).</p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#randomforest-example_2"> </a>randomForest example</h2>
<p>For anyone looking to sink their teeth into something a little more complex, below is a fully worked example of examining the relative importance of variables in a <code>randomForest()</code> model. The model predicts the arrival delay of flights using time-related variables (departure time, year, month and day). Relevant to this post, we fit this model to the data separately for each of three airline carriers.</p>
<p>Notice that this implements the same code we’ve been using so far, with just a few tweaks to select an appropriate data set and obtain information from the fitted models.</p>
<p>The resulting plot suggests to us that the importance of a flight’s <code>day</code> for predicting it’s arrival delay varies depending on the carrier. Specifically, it is reasonably informative for predicting the arrival delay of Pinnacle Airlines (<code>9E</code>), not so useful for Virgin America (<code>VX</code>), and practically useless for Alaska Airlines (<code>AS</code>).</p>
<pre><code>library(randomForest)
library(nycflights13)

# Convenience function to get importance information from a randomForest fit
# into a data frame
imp_df &lt;- function(rf_fit) {
  imp &lt;- randomForest::importance(rf_fit)
  vars &lt;- rownames(imp)
  imp %>% 
    tibble::as_tibble() %>% 
    dplyr::mutate(var = vars)
}

set.seed(123)
flights %>% 
  # Selecting data to work with
  na.omit() %>% 
  select(carrier, arr_delay, year, month, day, dep_time) %>% 
  filter(carrier %in% c(&quot;9E&quot;, &quot;AS&quot;, &quot;VX&quot;)) %>% 
  # Nesting data and fitting model
  nest(-carrier) %>% 
  mutate(fit = map(data, ~ randomForest(arr_delay ~ ., data = .,
                                        importance = TRUE,
                                        ntree = 100)),
         importance = map(fit, imp_df)) %>% 
  # Unnesting and plotting
  unnest(importance) %>% 
  ggplot(aes(x = `%IncMSE`, y = var, color = `%IncMSE`)) +
  geom_segment(aes(xend = min(`%IncMSE`), yend = var), alpha = .2) +
    geom_point(size = 3) +
    facet_grid(. ~ carrier) +
    guides(color = &quot;none&quot;) +
    theme_bw()
</code></pre>
<p><a target="_blank" href="https://i0.wp.com/svbtleusercontent.com/dkmzyco2hejx3a.png?ssl=1"><img alt="unnamed-chunk-20-1.png" src="https://i0.wp.com/svbtleusercontent.com/dkmzyco2hejx3a_small.png?w=456&ssl=1" data-recalc-dims="1"></a></p>
<h2><a target="_blank" href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups#sign-off_2"> </a>Sign off</h2>
<p>Thanks for reading and I hope this was useful for you.</p>
<p>For updates of recent blog posts, follow <a target="_blank" href="https://twitter.com/drsimonj">@drsimonj</a> on Twitter, or email me at <a target="_blank" href="mailto:drsimonjackson@gmail.com">drsimonjackson@gmail.com</a> to get in touch.</p>
<p>If you’d like the code that produced this blog, check out the <a target="_blank" href="https://github.com/drsimonj/blogR">blogR GitHub repository</a>.</p>
<p><div><div><div><div data-width="55" data-show-faces="false" data-send="true" data-layout="box_count" data-height="62" data-href="https://www.r-bloggers.com/running-a-model-on-separate-groups/"></div></div><div><a data-url="https://www.r-bloggers.com/running-a-model-on-separate-groups/" data-counturl="https://www.r-bloggers.com/running-a-model-on-separate-groups/" data-count="vertical" data-text="Running a model on separate groups" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="http://drsimonj.svbtle.com/running-a-model-on-separate-groups"> blogR</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="https://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="https://www.r-bloggers.com/?s=data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="https://www.r-bloggers.com/?s=Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="https://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="https://www.r-bloggers.com/?s=map">maps</a>, <a title="Animation in R" rel="nofollow" href="https://www.r-bloggers.com/?s=animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="https://www.r-bloggers.com/?s=RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="https://www.r-bloggers.com/?s=sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="https://www.r-bloggers.com/?s=LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="https://www.r-bloggers.com/?s=SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="https://www.r-bloggers.com/?s=eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="https://www.r-bloggers.com/?s=git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="https://www.r-bloggers.com/?s=hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="https://www.r-bloggers.com/?s=Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="https://www.r-bloggers.com/?s=PCA">PCA</a>, <a title="Time series" rel="nofollow" href="https://www.r-bloggers.com/?s=time+series">time series</a>, <a title="finance trading" rel="nofollow" href="https://www.r-bloggers.com/?s=trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/yfC1O5zYFV0"></a></div>