Intro

If dplyr package is not installed then install it first by running the command install.packages('dplyr').
Then import the package:

> library(dplyr)

dplyr has some cool and useful functions-

  • filter() filters rows based on their values.
  • mutate() adds new variables/columns or change existing variables.
  • select() selects variables/columns.
  • summarize() reduces multiple values down to a single summary.
  • group_by() groups variable according to its values.
  • arrange() changes the ordering of the rows.

To know the structure of the data set, dplyr has the function glimpse() which is faster than the base R’s function str().

Filter

Let’s take the built in data set mtcars for examples:

> 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

To filter out rows where cyl is equal to 4:

> filter(mtcars, cyl == 4)
                mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Datsun 710     22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
Merc 240D      24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
Merc 230       22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
Fiat 128       32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
Honda Civic    30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
Toyota Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
Toyota Corona  21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
Fiat X1-9      27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
Porsche 914-2  26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
Lotus Europa   30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
Volvo 142E     21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2

Using pipe operator the above code can be written in the form:

> mtcars %>% filter(cyl == 4) 

To know no of observations where cyl = 4:

> length(filter(mtcars, cyl == 4)) 
[1] 11

Filtering with multiple conditions:

> filter(mtcars, cyl == 4, hp > 96)
               mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Toyota Corona 21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
Lotus Europa  30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
Volvo 142E    21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2

Using pipe operator the above code can be written in the form:

> mtcars %>% 
+   filter(cyl == 4, hp > 96) 
               mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Toyota Corona 21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
Lotus Europa  30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
Volvo 142E    21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2

between

> mtcars %>% filter(hp>=90, hp<=100)
               mpg cyl  disp hp drat    wt  qsec vs am gear carb
Datsun 710    22.8   4 108.0 93 3.85 2.320 18.61  1  1    4    1
Merc 230      22.8   4 140.8 95 3.92 3.150 22.90  1  0    4    2
Toyota Corona 21.5   4 120.1 97 3.70 2.465 20.01  1  0    3    1
Porsche 914-2 26.0   4 120.3 91 4.43 2.140 16.70  0  1    5    2
> mtcars %>% filter(between(hp, 90, 100)) # same as above
               mpg cyl  disp hp drat    wt  qsec vs am gear carb
Datsun 710    22.8   4 108.0 93 3.85 2.320 18.61  1  1    4    1
Merc 230      22.8   4 140.8 95 3.92 3.150 22.90  1  0    4    2
Toyota Corona 21.5   4 120.1 97 3.70 2.465 20.01  1  0    3    1
Porsche 914-2 26.0   4 120.3 91 4.43 2.140 16.70  0  1    5    2

is.na

While filtering, sometime we may need to omit the rows with NA values. In those cases is.na() can be useful:

> starwars %>% 
+   filter(!is.na(hair_color)) %>% 
+   head(4)
# A tibble: 4 × 14
  name      height  mass hair_color skin_color eye_color birth_year sex   gender
  <chr>      <int> <dbl> <chr>      <chr>      <chr>          <dbl> <chr> <chr> 
1 Luke Sky…    172    77 blond      fair       blue            19   male  mascu…
2 Darth Va…    202   136 none       white      yellow          41.9 male  mascu…
3 Leia Org…    150    49 brown      light      brown           19   fema… femin…
4 Owen Lars    178   120 brown, gr… light      blue            52   male  mascu…
# ℹ 5 more variables: homeworld <chr>, species <chr>, films <list>,
#   vehicles <list>, starships <list>

Now in the column hair_color, there is no NA values. Note: In this process the data set is not replaced. We actually need to store it by assigning into a variable:

> starwars_noNA <- starwars %>% 
+   filter(!is.na(hair_color)) %>% 
+   head(4)

slice

slice() filters rows by position:

> esoph %>% 
+   slice(3:7) #Shows rows from 3rd to 7th position
  agegp     alcgp    tobgp ncases ncontrols
1 25-34 0-39g/day    20-29      0         6
2 25-34 0-39g/day      30+      0         5
3 25-34     40-79 0-9g/day      0        27
4 25-34     40-79    10-19      0         7
5 25-34     40-79    20-29      0         4

Draw random samples from the data:

> esoph2 <- esoph %>% 
+   slice_sample(n = 10)

Select

Let’s see the structure of the mtcars data set first:

> glimpse(mtcars)
Rows: 32
Columns: 11
$ mpg  <dbl> 21.0, 21.0, 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 22.8, 19.2, 17.8,…
$ cyl  <dbl> 6, 6, 4, 6, 8, 6, 8, 4, 4, 6, 6, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4, 8,…
$ disp <dbl> 160.0, 160.0, 108.0, 258.0, 360.0, 225.0, 360.0, 146.7, 140.8, 16…
$ hp   <dbl> 110, 110, 93, 110, 175, 105, 245, 62, 95, 123, 123, 180, 180, 180…
$ drat <dbl> 3.90, 3.90, 3.85, 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3.92,…
$ wt   <dbl> 2.620, 2.875, 2.320, 3.215, 3.440, 3.460, 3.570, 3.190, 3.150, 3.…
$ qsec <dbl> 16.46, 17.02, 18.61, 19.44, 17.02, 20.22, 15.84, 20.00, 22.90, 18…
$ vs   <dbl> 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0,…
$ am   <dbl> 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0,…
$ gear <dbl> 4, 4, 4, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3, 3,…
$ carb <dbl> 4, 4, 1, 1, 2, 1, 4, 2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 1, 2,…

To select columns mpg, cyl and hp:

> select(mtcars, mpg, cyl, hp) %>% 
+   head(8)  # to show first 8 observations
                   mpg cyl  hp
Mazda RX4         21.0   6 110
Mazda RX4 Wag     21.0   6 110
Datsun 710        22.8   4  93
Hornet 4 Drive    21.4   6 110
Hornet Sportabout 18.7   8 175
Valiant           18.1   6 105
Duster 360        14.3   8 245
Merc 240D         24.4   4  62

Or,

> mtcars %>% 
+   select(mpg, cyl, hp) %>% 
+   head(8)
                   mpg cyl  hp
Mazda RX4         21.0   6 110
Mazda RX4 Wag     21.0   6 110
Datsun 710        22.8   4  93
Hornet 4 Drive    21.4   6 110
Hornet Sportabout 18.7   8 175
Valiant           18.1   6 105
Duster 360        14.3   8 245
Merc 240D         24.4   4  62

Using filter and select:

> mtcars %>% 
+   select(mpg, cyl, hp) %>% 
+   filter(cyl==4)
                mpg cyl  hp
Datsun 710     22.8   4  93
Merc 240D      24.4   4  62
Merc 230       22.8   4  95
Fiat 128       32.4   4  66
Honda Civic    30.4   4  52
Toyota Corolla 33.9   4  65
Toyota Corona  21.5   4  97
Fiat X1-9      27.3   4  66
Porsche 914-2  26.0   4  91
Lotus Europa   30.4   4 113
Volvo 142E     21.4   4 109

Deleting column

We can delete any columns using the select function by putting minus (-) before the column name:

Let’s use the esoph data set for this:

> glimpse(esoph)
Rows: 88
Columns: 5
$ agegp     <ord> 25-34, 25-34, 25-34, 25-34, 25-34, 25-34, 25-34, 25-34, 25-3…
$ alcgp     <ord> 0-39g/day, 0-39g/day, 0-39g/day, 0-39g/day, 40-79, 40-79, 40…
$ tobgp     <ord> 0-9g/day, 10-19, 20-29, 30+, 0-9g/day, 10-19, 20-29, 30+, 0-…
$ ncases    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, …
$ ncontrols <dbl> 40, 10, 6, 5, 27, 7, 4, 7, 2, 1, 2, 1, 0, 1, 2, 60, 13, 7, 8…

The following code will hide alcgp and ncontrols from the data set:

> select(esoph, -alcgp, -ncontrols) %>% 
+   sample_n(5)  # takes 5 random rows from the data set
  agegp    tobgp ncases
1 55-64    20-29      3
2 25-34 0-9g/day      0
3 65-74 0-9g/day      3
4 45-54    10-19      3
5 65-74      30+      1

Renaming Column - rename()

select() can be used to rename columns. But the problem is all columns that are not mentioned are dropped:

> esoph %>% 
+   select(age_group = agegp) %>% 
+   head(5)
  age_group
1     25-34
2     25-34
3     25-34
4     25-34
5     25-34

rename() does the same thing, but in this case all other columns are not dropped:

> esoph %>% 
+   rename(age_group = agegp) %>% 
+   head(5)
  age_group     alcgp    tobgp ncases ncontrols
1     25-34 0-39g/day 0-9g/day      0        40
2     25-34 0-39g/day    10-19      0        10
3     25-34 0-39g/day    20-29      0         6
4     25-34 0-39g/day      30+      0         5
5     25-34     40-79 0-9g/day      0        27

Selecting specific types of column

Factor variable columns:

> select_if(esoph, is.factor) %>% 
+   head()
  agegp     alcgp    tobgp
1 25-34 0-39g/day 0-9g/day
2 25-34 0-39g/day    10-19
3 25-34 0-39g/day    20-29
4 25-34 0-39g/day      30+
5 25-34     40-79 0-9g/day
6 25-34     40-79    10-19

Numeric variable columns:

> esoph %>% 
+   select_if(is.numeric) %>% 
+   head()
  ncases ncontrols
1      0        40
2      0        10
3      0         6
4      0         5
5      0        27
6      0         7

__Note:__ Although the select_if method works fine, the base R’s Filter() (Notice: not filter() from dplyr, it’s Filter() with capital F) is way much faster than this. Following is an example:

> library(microbenchmark)
> microbenchmark(
+     dplyr::select_if(esoph, is.factor),
+     Filter(is.factor, esoph)
+ )
Unit: microseconds
                               expr    min     lq     mean  median      uq
 dplyr::select_if(esoph, is.factor) 4027.4 4172.3 4627.727 4385.30 4801.60
           Filter(is.factor, esoph)   24.3   28.9   39.782   39.75   42.85
    max neval cld
 6535.7   100  a 
  144.2   100   b

Mutate

Let’s use starwars data set for now:

> head(starwars)
# A tibble: 6 × 14
  name      height  mass hair_color skin_color eye_color birth_year sex   gender
  <chr>      <int> <dbl> <chr>      <chr>      <chr>          <dbl> <chr> <chr> 
1 Luke Sky…    172    77 blond      fair       blue            19   male  mascu…
2 C-3PO        167    75 <NA>       gold       yellow         112   none  mascu…
3 R2-D2         96    32 <NA>       white, bl… red             33   none  mascu…
4 Darth Va…    202   136 none       white      yellow          41.9 male  mascu…
5 Leia Org…    150    49 brown      light      brown           19   fema… femin…
6 Owen Lars    178   120 brown, gr… light      blue            52   male  mascu…
# ℹ 5 more variables: homeworld <chr>, species <chr>, films <list>,
#   vehicles <list>, starships <list>

Here we will use the columns height and mass to calculate bmi and add this variable to the data set:

> starwars %>% 
+   mutate(bmi= mass/((height/100)^2)) %>% 
+   select(name, height, mass, bmi) %>% 
+   filter(bmi<22, bmi>18)
# A tibble: 8 × 4
  name            height  mass   bmi
  <chr>            <int> <dbl> <dbl>
1 Leia Organa        150  49    21.8
2 Chewbacca          228 112    21.5
3 Ki-Adi-Mundi       198  82    20.9
4 Luminara Unduli    170  56.2  19.4
5 Barriss Offee      166  50    18.1
6 Dooku              193  80    21.5
7 Zam Wesell         168  55    19.5
8 Tion Medon         206  80    18.9

Transmute

It only keeps the new variables and the given variables given inside the function unlike the mutate function:

> starwars %>% 
+   transmute(name, bmi= mass/((height/100)^2))
# A tibble: 87 × 2
   name                 bmi
   <chr>              <dbl>
 1 Luke Skywalker      26.0
 2 C-3PO               26.9
 3 R2-D2               34.7
 4 Darth Vader         33.3
 5 Leia Organa         21.8
 6 Owen Lars           37.9
 7 Beru Whitesun Lars  27.5
 8 R5-D4               34.0
 9 Biggs Darklighter   25.1
10 Obi-Wan Kenobi      23.2
# ℹ 77 more rows

replace

To replace something based on conditions in columns -

> starwars %>% 
+   transmute(name, 
+             bmi= mass/((height/100)^2),
+             out_of_range = replace(bmi, bmi > 30, NA))
# A tibble: 87 × 3
   name                 bmi out_of_range
   <chr>              <dbl>        <dbl>
 1 Luke Skywalker      26.0         26.0
 2 C-3PO               26.9         26.9
 3 R2-D2               34.7         NA  
 4 Darth Vader         33.3         NA  
 5 Leia Organa         21.8         21.8
 6 Owen Lars           37.9         NA  
 7 Beru Whitesun Lars  27.5         27.5
 8 R5-D4               34.0         NA  
 9 Biggs Darklighter   25.1         25.1
10 Obi-Wan Kenobi      23.2         23.2
# ℹ 77 more rows

Arrange

Ascending order of disp -

> mtcars %>% 
+   arrange(disp) 
                     mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4

Descending order of disp -

> mtcars %>% 
+   arrange(desc(disp)) 
                     mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1

Ascending order of cyl, then descending order of disp -

> mtcars %>% 
+   arrange(cyl, desc(disp)) 
                     mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3

Group_by and Summarise

From the mtcars data set, if we want to know how many groups of cyl are there in the data set and the no of cars in each group along with their average mpg, then the code can be written as follows:

> mtcars %>% 
+   group_by(cyl) %>% 
+   summarise(Freq_cyl = n(),
+             Mean_mpg = mean(mpg))
# A tibble: 3 × 3
    cyl Freq_cyl Mean_mpg
  <dbl>    <int>    <dbl>
1     4       11     26.7
2     6        7     19.7
3     8       14     15.1

Here we have found that there is 3 groups in cyl and each group has different no. of cars in it.

Another example can be:

> starwars %>% 
+   group_by(hair_color) %>% 
+   summarise(Average_height = round(mean(height, na.rm=T),2)) %>%
+   arrange(desc(Average_height))
# A tibble: 12 × 2
   hair_color    Average_height
   <chr>                  <dbl>
 1 auburn, white           182 
 2 none                    181.
 3 auburn, grey            180 
 4 brown, grey             178 
 5 blond                   177.
 6 brown                   177.
 7 black                   174.
 8 grey                    170 
 9 blonde                  168 
10 white                   156 
11 auburn                  150 
12 <NA>                    142.
> starwars %>% 
+   group_by(hair_color) %>% 
+   summarise(Average_height = round(mean(height, na.rm=T),2),
+             Count = n())
# A tibble: 12 × 3
   hair_color    Average_height Count
   <chr>                  <dbl> <int>
 1 auburn                  150      1
 2 auburn, grey            180      1
 3 auburn, white           182      1
 4 black                   174.    13
 5 blond                   177.     3
 6 blonde                  168      1
 7 brown                   177.    18
 8 brown, grey             178      1
 9 grey                    170      1
10 none                    181.    38
11 white                   156      4
12 <NA>                    142.     5

Some other functions used in summarize are: sum(), mean(), median(),sd(),IQR(),min(),max(),first(),last(),nth() etc.

Another example of using only group_by():

Let’s use the esoph data set for this:

> head(esoph)
  agegp     alcgp    tobgp ncases ncontrols
1 25-34 0-39g/day 0-9g/day      0        40
2 25-34 0-39g/day    10-19      0        10
3 25-34 0-39g/day    20-29      0         6
4 25-34 0-39g/day      30+      0         5
5 25-34     40-79 0-9g/day      0        27
6 25-34     40-79    10-19      0         7

Here is a code that creates two way table:

> esoph %>% 
+   group_by(agegp) %>% 
+   select(agegp, alcgp) %>% 
+   table()
       alcgp
agegp   0-39g/day 40-79 80-119 120+
  25-34         4     4      3    4
  35-44         4     4      4    3
  45-54         4     4      4    4
  55-64         4     4      4    4
  65-74         4     3      4    4
  75+           3     4      2    2

Across

Same summary statistics on multiple columns -

> mtcars %>%
+   group_by(gear) %>%
+   summarize(across(c(count_hp = hp, count_disp = disp),
+                    ~ n()))
# A tibble: 3 × 3
   gear count_hp count_disp
  <dbl>    <int>      <int>
1     3       15         15
2     4       12         12
3     5        5          5

Functions can be passed in across as purrr-style lambda, e.g. ~ mean(.x, na.rm = TRUE):

> mtcars %>%
+   group_by(gear) %>%
+   summarize(across(c(hp, disp),
+                    c(Freq = ~ n(), Mean = ~mean(., na.rm=TRUE))))
# A tibble: 3 × 5
   gear hp_Freq hp_Mean disp_Freq disp_Mean
  <dbl>   <int>   <dbl>     <int>     <dbl>
1     3      15   176.         15      326.
2     4      12    89.5        12      123.
3     5       5   196.          5      202.

Functions can be passed in across as a list of functions/lambdas, e.g. list(mean = mean, n_miss = ~ sum(is.na(.x)):

> mtcars %>%
+   group_by(gear) %>%
+   summarize(across(c(hp, disp),
+                    list(Mean = mean, SD = sd)))
# A tibble: 3 × 5
   gear hp_Mean hp_SD disp_Mean disp_SD
  <dbl>   <dbl> <dbl>     <dbl>   <dbl>
1     3   176.   47.7      326.    94.9
2     4    89.5  25.9      123.    38.9
3     5   196.  103.       202.   115. 

If list of functins is passed, the the functions inside it can be written as just the name of function or in purrr-style lambda:

> mtcars %>%
+   group_by(gear) %>%
+   summarize(across(c(hp, disp),
+                    list(Mean = ~ mean(., na.rm = TRUE), SD = sd)))
# A tibble: 3 × 5
   gear hp_Mean hp_SD disp_Mean disp_SD
  <dbl>   <dbl> <dbl>     <dbl>   <dbl>
1     3   176.   47.7      326.    94.9
2     4    89.5  25.9      123.    38.9
3     5   196.  103.       202.   115. 

Column names can be specified too:

> mtcars %>% 
+   group_by(gear) %>% 
+   summarize(across(c(hp, disp),
+                    list(Mean = ~ mean(.), SD = ~ sd(.)),
+                    .names = "{.fn} of {.col}"))
# A tibble: 3 × 5
   gear `Mean of hp` `SD of hp` `Mean of disp` `SD of disp`
  <dbl>        <dbl>      <dbl>          <dbl>        <dbl>
1     3        176.        47.7           326.         94.9
2     4         89.5       25.9           123.         38.9
3     5        196.       103.            202.        115. 

More example:

> esoph %>%
+   group_by(agegp) %>% 
+   summarize(across(where(is.numeric), 
+                    list(Mean = ~mean(.), 
+                         Variance = ~var(.)),
+            .names = "{.fn}_{.col}"))
# A tibble: 6 × 5
  agegp Mean_ncases Variance_ncases Mean_ncontrols Variance_ncontrols
  <ord>       <dbl>           <dbl>          <dbl>              <dbl>
1 25-34      0.0667          0.0667           7.67              124. 
2 35-44      0.6             0.971           12.7               251. 
3 45-54      2.88            4.38            10.4               160. 
4 55-64      4.75            5.27            10.4               164. 
5 65-74      3.67           16.8              7.07              121. 
6 75+        1.18            0.364            2.82               24.4

tips: matches("string") function selects columns whose column name matches the given “string”.

The function tally() can be used to count instead of n():

> mtcars %>% 
+   group_by(cyl) %>% 
+   tally(sort=T, name='Count') 
# A tibble: 3 × 2
    cyl Count
  <dbl> <int>
1     8    14
2     4    11
3     6     7
> # sort = TRUE, will show the largest groups at the top

n_distinct(vector) counts the no. of unique items in the vector:

> mtcars %>% 
+   group_by(cyl) %>% 
+   summarise(no_of_cars_in_group=n(),
+             unique_hp_cars=n_distinct(hp))
# A tibble: 3 × 3
    cyl no_of_cars_in_group unique_hp_cars
  <dbl>               <int>          <int>
1     4                  11             10
2     6                   7              4
3     8                  14              9

top_n

The following example keeps top 4 cars according to mpg from each group of cyl:

> mtcars %>% 
+   add_rownames("CarName") %>% 
+   group_by(cyl) %>% 
+   top_n(2, mpg) %>% 
+   arrange(desc(mpg)) %>% 
+   select(CarName,gear,mpg)
# A tibble: 7 × 4
# Groups:   cyl [3]
    cyl CarName            gear   mpg
  <dbl> <chr>             <dbl> <dbl>
1     4 Toyota Corolla        4  33.9
2     4 Fiat 128              4  32.4
3     6 Hornet 4 Drive        3  21.4
4     6 Mazda RX4             4  21  
5     6 Mazda RX4 Wag         4  21  
6     8 Pontiac Firebird      3  19.2
7     8 Hornet Sportabout     3  18.7

Tips: add_rownames() actually turns the row names into a column with given variable name. Also, add_rownames() was deprecated in dplyr 1.0.0. Please use tibble::rownames_to_column() instead.

> mtcars %>% 
+   tibble::rownames_to_column("CarName") %>% 
+   group_by(cyl) %>% 
+   top_n(2, mpg) %>% 
+   arrange(desc(mpg)) %>%
+   select(CarName,gear,mpg)
# A tibble: 7 × 4
# Groups:   cyl [3]
    cyl CarName            gear   mpg
  <dbl> <chr>             <dbl> <dbl>
1     4 Toyota Corolla        4  33.9
2     4 Fiat 128              4  32.4
3     6 Hornet 4 Drive        3  21.4
4     6 Mazda RX4             4  21  
5     6 Mazda RX4 Wag         4  21  
6     8 Pontiac Firebird      3  19.2
7     8 Hornet Sportabout     3  18.7

ungroup

Notice: Although the cyl column was not selected, since it was the grouping variable, dplyr is showing the column. To prevent this from happening, ungroup() is used.

> mtcars %>% 
+   tibble::rownames_to_column("CarName") %>% 
+   group_by(cyl) %>% 
+   top_n(2, mpg) %>% 
+   arrange(desc(mpg)) %>% 
+   ungroup() %>% 
+   select(CarName,gear,mpg)
# A tibble: 7 × 3
  CarName            gear   mpg
  <chr>             <dbl> <dbl>
1 Toyota Corolla        4  33.9
2 Fiat 128              4  32.4
3 Hornet 4 Drive        3  21.4
4 Mazda RX4             4  21  
5 Mazda RX4 Wag         4  21  
6 Pontiac Firebird      3  19.2
7 Hornet Sportabout     3  18.7

Separate

> mtcars %>% 
+   tibble::rownames_to_column("CarName") %>% 
+   tidyr::separate(col = CarName, 
+                   into = c("Car Name","Model"), # separate into these variables
+                   sep = " ", # separator
+                   extra = "merge",  # if more parts than the length of `into`
+                   fill = "right"   # fill to the right
+                   )
   Car Name       Model  mpg cyl  disp  hp drat    wt  qsec vs am gear carb
1     Mazda         RX4 21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
2     Mazda     RX4 Wag 21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
3    Datsun         710 22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
4    Hornet     4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
5    Hornet  Sportabout 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
6   Valiant        <NA> 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
7    Duster         360 14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
8      Merc        240D 24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
9      Merc         230 22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
10     Merc         280 19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
11     Merc        280C 17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
12     Merc       450SE 16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
13     Merc       450SL 17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
14     Merc      450SLC 15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
15 Cadillac   Fleetwood 10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
16  Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
17 Chrysler    Imperial 14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
18     Fiat         128 32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
19    Honda       Civic 30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
20   Toyota     Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
21   Toyota      Corona 21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
22    Dodge  Challenger 15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
23      AMC     Javelin 15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
24   Camaro         Z28 13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
25  Pontiac    Firebird 19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
26     Fiat        X1-9 27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
27  Porsche       914-2 26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
28    Lotus      Europa 30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
29     Ford   Pantera L 15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
30  Ferrari        Dino 19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
31 Maserati        Bora 15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
32    Volvo        142E 21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2

Mutating Joins

Let’s create two data frames:

> (a <- data.frame(color=c("Blue","Red","Yellow","Megenda","White"),
+                 taka1=c(10,10,15,20,30)))
    color taka1
1    Blue    10
2     Red    10
3  Yellow    15
4 Megenda    20
5   White    30
> (b <- data.frame(color=c("Black","Red","Yellow","Pink","Green"),
+                 taka2=c(20,10,15,10,30)))
   color taka2
1  Black    20
2    Red    10
3 Yellow    15
4   Pink    10
5  Green    30

inner join

Only include observations found in both “a” and “b” (A intersect B):

> inner_join(a,b)
   color taka1 taka2
1    Red    10    10
2 Yellow    15    15

full join

Include observations found in either “a” or “b” (A U B):

> full_join(a,b)
    color taka1 taka2
1    Blue    10    NA
2     Red    10    10
3  Yellow    15    15
4 Megenda    20    NA
5   White    30    NA
6   Black    NA    20
7    Pink    NA    10
8   Green    NA    30

semi join

Shows those values of “a” that matches the values of “b”:

> semi_join(a,b)
   color taka1
1    Red    10
2 Yellow    15

anti join

Shows those values of “a” that does not match the values of “b”:

> anti_join(a,b)
    color taka1
1    Blue    10
2 Megenda    20
3   White    30

left and right join

> left_join(a,b) # include all observations found in a
    color taka1 taka2
1    Blue    10    NA
2     Red    10    10
3  Yellow    15    15
4 Megenda    20    NA
5   White    30    NA
> right_join(a,b) # include all observations found in b
   color taka1 taka2
1    Red    10    10
2 Yellow    15    15
3  Black    NA    20
4   Pink    NA    10
5  Green    NA    30

Learn More

Run the following code to learn more about dplyr.

> # vignette("programming", package = "dplyr")
LS0tDQp0aXRsZTogIkludHJvZHVjdGlvbiB0byBkcGx5ciINCmF1dGhvcjogJ01EIEFIU0FOVUwgSVNMQU0nDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogdHJ1ZQ0KICAgIHRvY19mbG9hdDogdHJ1ZQ0KICAgIHRvY19kZXB0aDogNA0KICAgIHRoZW1lOiBjZXJ1bGVhbg0KICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCi0tLQ0KDQpgYGB7ciwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldCgNCiAgY29tbWVudCA9ICIiLCBwcm9tcHQgPSBUUlVFLCBtZXNzYWdlPUYsIHdhcm5pbmc9Rg0KKQ0KYGBgDQoNCi0tLS0NCg0KIyMgSW50cm8NCg0KSWYgYGRwbHlyYCBwYWNrYWdlIGlzIG5vdCBpbnN0YWxsZWQgdGhlbiBpbnN0YWxsIGl0IGZpcnN0IGJ5IHJ1bm5pbmcgdGhlIGNvbW1hbmQgYGluc3RhbGwucGFja2FnZXMoJ2RwbHlyJylgLiAgIA0KVGhlbiBpbXBvcnQgdGhlIHBhY2thZ2U6DQpgYGB7ciBtZXNzYWdlPUZ9DQpsaWJyYXJ5KGRwbHlyKQ0KYGBgDQpgZHBseXJgIGhhcyBzb21lIGNvb2wgYW5kIHVzZWZ1bCBmdW5jdGlvbnMtIA0KICANCiogZmlsdGVyKCkgZmlsdGVycyByb3dzIGJhc2VkIG9uIHRoZWlyIHZhbHVlcy4gIA0KKiBtdXRhdGUoKSBhZGRzIG5ldyB2YXJpYWJsZXMvY29sdW1ucyBvciBjaGFuZ2UgZXhpc3RpbmcgdmFyaWFibGVzLiAgIA0KKiBzZWxlY3QoKSBzZWxlY3RzIHZhcmlhYmxlcy9jb2x1bW5zLiAgICAgIA0KKiBzdW1tYXJpemUoKSByZWR1Y2VzIG11bHRpcGxlIHZhbHVlcyBkb3duIHRvIGEgc2luZ2xlIHN1bW1hcnkuICANCiogZ3JvdXBfYnkoKSBncm91cHMgdmFyaWFibGUgYWNjb3JkaW5nIHRvIGl0cyB2YWx1ZXMuICANCiogYXJyYW5nZSgpIGNoYW5nZXMgdGhlIG9yZGVyaW5nIG9mIHRoZSByb3dzLiAgIA0KDQpUbyBrbm93IHRoZSBzdHJ1Y3R1cmUgb2YgdGhlIGRhdGEgc2V0LCBkcGx5ciBoYXMgdGhlIGZ1bmN0aW9uIGBnbGltcHNlKClgIHdoaWNoIGlzIGZhc3RlciB0aGFuIHRoZSBiYXNlIFIncyBmdW5jdGlvbiBgc3RyKClgLiAgIA0KDQojIyBGaWx0ZXINCg0KTGV0J3MgdGFrZSB0aGUgYnVpbHQgaW4gZGF0YSBzZXQgYG10Y2Fyc2AgZm9yIGV4YW1wbGVzOg0KYGBge3J9DQpoZWFkKG10Y2FycykNCmBgYA0KDQpUbyBmaWx0ZXIgb3V0IHJvd3Mgd2hlcmUgY3lsIGlzIGVxdWFsIHRvIDQ6DQpgYGB7cn0NCmZpbHRlcihtdGNhcnMsIGN5bCA9PSA0KQ0KYGBgDQoNClVzaW5nIHBpcGUgb3BlcmF0b3IgdGhlIGFib3ZlIGNvZGUgY2FuIGJlIHdyaXR0ZW4gaW4gdGhlIGZvcm06DQpgYGB7ciByZXN1bHRzID0gJ2hpZGUnfQ0KbXRjYXJzICU+JSBmaWx0ZXIoY3lsID09IDQpIA0KYGBgDQoNClRvIGtub3cgbm8gb2Ygb2JzZXJ2YXRpb25zIHdoZXJlIGN5bCA9IDQ6DQpgYGB7cn0NCmxlbmd0aChmaWx0ZXIobXRjYXJzLCBjeWwgPT0gNCkpIA0KYGBgDQoNCkZpbHRlcmluZyB3aXRoIG11bHRpcGxlIGNvbmRpdGlvbnM6DQpgYGB7cn0NCmZpbHRlcihtdGNhcnMsIGN5bCA9PSA0LCBocCA+IDk2KQ0KYGBgDQoNClVzaW5nIHBpcGUgb3BlcmF0b3IgdGhlIGFib3ZlIGNvZGUgY2FuIGJlIHdyaXR0ZW4gaW4gdGhlIGZvcm06DQpgYGB7cn0NCm10Y2FycyAlPiUgDQogIGZpbHRlcihjeWwgPT0gNCwgaHAgPiA5NikgDQpgYGANCg0KIyMjIGJldHdlZW4NCg0KYGBge3J9DQptdGNhcnMgJT4lIGZpbHRlcihocD49OTAsIGhwPD0xMDApDQptdGNhcnMgJT4lIGZpbHRlcihiZXR3ZWVuKGhwLCA5MCwgMTAwKSkgIyBzYW1lIGFzIGFib3ZlDQpgYGANCg0KIyMjIGlzLm5hDQoNCldoaWxlIGZpbHRlcmluZywgc29tZXRpbWUgd2UgbWF5IG5lZWQgdG8gb21pdCB0aGUgcm93cyB3aXRoIE5BIHZhbHVlcy4gSW4gdGhvc2UgY2FzZXMgYGlzLm5hKClgIGNhbiBiZSB1c2VmdWw6DQpgYGB7cn0NCnN0YXJ3YXJzICU+JSANCiAgZmlsdGVyKCFpcy5uYShoYWlyX2NvbG9yKSkgJT4lIA0KICBoZWFkKDQpDQpgYGANCg0KTm93IGluIHRoZSBjb2x1bW4gaGFpcl9jb2xvciwgdGhlcmUgaXMgbm8gTkEgdmFsdWVzLg0KX19Ob3RlOl9fIEluIHRoaXMgcHJvY2VzcyB0aGUgZGF0YSBzZXQgaXMgbm90IHJlcGxhY2VkLiBXZSBhY3R1YWxseSBuZWVkIHRvIHN0b3JlIGl0IGJ5IGFzc2lnbmluZyBpbnRvIGEgdmFyaWFibGU6DQpgYGB7cn0NCnN0YXJ3YXJzX25vTkEgPC0gc3RhcndhcnMgJT4lIA0KICBmaWx0ZXIoIWlzLm5hKGhhaXJfY29sb3IpKSAlPiUgDQogIGhlYWQoNCkNCmBgYA0KDQojIyMgc2xpY2UNCg0Kc2xpY2UoKSBmaWx0ZXJzIHJvd3MgYnkgcG9zaXRpb246DQpgYGB7cn0NCmVzb3BoICU+JSANCiAgc2xpY2UoMzo3KSAjU2hvd3Mgcm93cyBmcm9tIDNyZCB0byA3dGggcG9zaXRpb24NCmBgYA0KDQpEcmF3IHJhbmRvbSBzYW1wbGVzIGZyb20gdGhlIGRhdGE6IA0KYGBge3J9DQplc29waDIgPC0gZXNvcGggJT4lIA0KICBzbGljZV9zYW1wbGUobiA9IDEwKQ0KYGBgDQoNCi0tLQ0KDQojIyBTZWxlY3QNCg0KTGV0J3Mgc2VlIHRoZSBzdHJ1Y3R1cmUgb2YgdGhlIG10Y2FycyBkYXRhIHNldCBmaXJzdDoNCmBgYHtyfQ0KZ2xpbXBzZShtdGNhcnMpDQpgYGANCg0KVG8gc2VsZWN0IGNvbHVtbnMgbXBnLCBjeWwgYW5kIGhwOg0KYGBge3J9DQpzZWxlY3QobXRjYXJzLCBtcGcsIGN5bCwgaHApICU+JSANCiAgaGVhZCg4KSAgIyB0byBzaG93IGZpcnN0IDggb2JzZXJ2YXRpb25zDQpgYGANCg0KT3IsDQpgYGB7cn0NCm10Y2FycyAlPiUgDQogIHNlbGVjdChtcGcsIGN5bCwgaHApICU+JSANCiAgaGVhZCg4KQ0KYGBgDQoNClVzaW5nIGZpbHRlciBhbmQgc2VsZWN0Og0KYGBge3J9DQptdGNhcnMgJT4lIA0KICBzZWxlY3QobXBnLCBjeWwsIGhwKSAlPiUgDQogIGZpbHRlcihjeWw9PTQpDQpgYGANCg0KDQojIyMgRGVsZXRpbmcgY29sdW1uDQoNCldlIGNhbiBkZWxldGUgYW55IGNvbHVtbnMgdXNpbmcgdGhlIHNlbGVjdCBmdW5jdGlvbiBieSBwdXR0aW5nIG1pbnVzICgtKSBiZWZvcmUgdGhlIGNvbHVtbiBuYW1lOg0KDQpMZXQncyB1c2UgdGhlIGVzb3BoIGRhdGEgc2V0IGZvciB0aGlzOg0KYGBge3J9DQpnbGltcHNlKGVzb3BoKQ0KYGBgDQoNClRoZSBmb2xsb3dpbmcgY29kZSB3aWxsIGhpZGUgYWxjZ3AgYW5kIG5jb250cm9scyBmcm9tIHRoZSBkYXRhIHNldDoNCmBgYHtyfQ0Kc2VsZWN0KGVzb3BoLCAtYWxjZ3AsIC1uY29udHJvbHMpICU+JSANCiAgc2FtcGxlX24oNSkgICMgdGFrZXMgNSByYW5kb20gcm93cyBmcm9tIHRoZSBkYXRhIHNldA0KYGBgDQoNCiMjIyBSZW5hbWluZyBDb2x1bW4gLSByZW5hbWUoKQ0KDQpgc2VsZWN0KClgIGNhbiBiZSB1c2VkIHRvIHJlbmFtZSBjb2x1bW5zLiBCdXQgdGhlIHByb2JsZW0gaXMgYWxsIGNvbHVtbnMgdGhhdCBhcmUgbm90IG1lbnRpb25lZCBhcmUgZHJvcHBlZDoNCmBgYHtyfQ0KZXNvcGggJT4lIA0KICBzZWxlY3QoYWdlX2dyb3VwID0gYWdlZ3ApICU+JSANCiAgaGVhZCg1KQ0KYGBgDQoNCmByZW5hbWUoKWAgZG9lcyB0aGUgc2FtZSB0aGluZywgYnV0IGluIHRoaXMgY2FzZSBhbGwgb3RoZXIgY29sdW1ucyBhcmUgbm90IGRyb3BwZWQ6DQpgYGB7cn0NCmVzb3BoICU+JSANCiAgcmVuYW1lKGFnZV9ncm91cCA9IGFnZWdwKSAlPiUgDQogIGhlYWQoNSkNCmBgYA0KDQojIyMgU2VsZWN0aW5nIHNwZWNpZmljIHR5cGVzIG9mIGNvbHVtbg0KDQpGYWN0b3IgdmFyaWFibGUgY29sdW1uczoNCmBgYHtyfQ0Kc2VsZWN0X2lmKGVzb3BoLCBpcy5mYWN0b3IpICU+JSANCiAgaGVhZCgpDQpgYGANCg0KTnVtZXJpYyB2YXJpYWJsZSBjb2x1bW5zOg0KYGBge3J9DQplc29waCAlPiUgDQogIHNlbGVjdF9pZihpcy5udW1lcmljKSAlPiUgDQogIGhlYWQoKQ0KYGBgDQoNCmBfX05vdGU6X19gIEFsdGhvdWdoIHRoZSBzZWxlY3RfaWYgbWV0aG9kIHdvcmtzIGZpbmUsIHRoZSBiYXNlIFIncyBGaWx0ZXIoKSAoTm90aWNlOiBub3QgZmlsdGVyKCkgZnJvbSBkcGx5ciwgaXQncyBGaWx0ZXIoKSB3aXRoIGNhcGl0YWwgRikgaXMgd2F5IG11Y2ggZmFzdGVyIHRoYW4gdGhpcy4gRm9sbG93aW5nIGlzIGFuIGV4YW1wbGU6DQpgYGB7cn0NCmxpYnJhcnkobWljcm9iZW5jaG1hcmspDQptaWNyb2JlbmNobWFyaygNCiAgICBkcGx5cjo6c2VsZWN0X2lmKGVzb3BoLCBpcy5mYWN0b3IpLA0KICAgIEZpbHRlcihpcy5mYWN0b3IsIGVzb3BoKQ0KKQ0KYGBgDQoNCi0tLQ0KDQojIyBNdXRhdGUNCg0KTGV0J3MgdXNlIGBzdGFyd2Fyc2AgZGF0YSBzZXQgZm9yIG5vdzoNCmBgYHtyfQ0KaGVhZChzdGFyd2FycykNCmBgYA0KDQpIZXJlIHdlIHdpbGwgdXNlIHRoZSBjb2x1bW5zIGhlaWdodCBhbmQgbWFzcyB0byBjYWxjdWxhdGUgYm1pIGFuZCBhZGQgdGhpcyB2YXJpYWJsZSB0byB0aGUgZGF0YSBzZXQ6DQpgYGB7cn0NCnN0YXJ3YXJzICU+JSANCiAgbXV0YXRlKGJtaT0gbWFzcy8oKGhlaWdodC8xMDApXjIpKSAlPiUgDQogIHNlbGVjdChuYW1lLCBoZWlnaHQsIG1hc3MsIGJtaSkgJT4lIA0KICBmaWx0ZXIoYm1pPDIyLCBibWk+MTgpDQpgYGANCg0KIyMjIFRyYW5zbXV0ZQ0KDQpJdCBvbmx5IGtlZXBzIHRoZSBuZXcgdmFyaWFibGVzIGFuZCB0aGUgZ2l2ZW4gdmFyaWFibGVzIGdpdmVuIGluc2lkZSB0aGUgZnVuY3Rpb24gdW5saWtlIHRoZSBtdXRhdGUgZnVuY3Rpb246DQpgYGB7cn0NCnN0YXJ3YXJzICU+JSANCiAgdHJhbnNtdXRlKG5hbWUsIGJtaT0gbWFzcy8oKGhlaWdodC8xMDApXjIpKQ0KYGBgDQoNCiMjIyByZXBsYWNlDQoNClRvIHJlcGxhY2Ugc29tZXRoaW5nIGJhc2VkIG9uIGNvbmRpdGlvbnMgaW4gY29sdW1ucyAtDQpgYGB7cn0NCnN0YXJ3YXJzICU+JSANCiAgdHJhbnNtdXRlKG5hbWUsIA0KICAgICAgICAgICAgYm1pPSBtYXNzLygoaGVpZ2h0LzEwMCleMiksDQogICAgICAgICAgICBvdXRfb2ZfcmFuZ2UgPSByZXBsYWNlKGJtaSwgYm1pID4gMzAsIE5BKSkNCmBgYA0KDQojIyBBcnJhbmdlIA0KDQpBc2NlbmRpbmcgb3JkZXIgb2YgZGlzcCAtDQpgYGB7cn0NCm10Y2FycyAlPiUgDQogIGFycmFuZ2UoZGlzcCkgDQpgYGANCg0KRGVzY2VuZGluZyBvcmRlciBvZiBkaXNwIC0NCmBgYHtyfQ0KbXRjYXJzICU+JSANCiAgYXJyYW5nZShkZXNjKGRpc3ApKSANCmBgYA0KDQpBc2NlbmRpbmcgb3JkZXIgb2YgY3lsLCB0aGVuIGRlc2NlbmRpbmcgb3JkZXIgb2YgZGlzcCAtDQpgYGB7cn0NCm10Y2FycyAlPiUgDQogIGFycmFuZ2UoY3lsLCBkZXNjKGRpc3ApKSANCmBgYA0KDQotLS0NCg0KIyMgR3JvdXBfYnkgYW5kIFN1bW1hcmlzZQ0KDQpGcm9tIHRoZSBgbXRjYXJzYCBkYXRhIHNldCwgaWYgd2Ugd2FudCB0byBrbm93IGhvdyBtYW55IGdyb3VwcyBvZiBjeWwgYXJlIHRoZXJlIGluIHRoZSBkYXRhIHNldCBhbmQgdGhlIG5vIG9mIGNhcnMgaW4gZWFjaCBncm91cCBhbG9uZyB3aXRoIHRoZWlyIGF2ZXJhZ2UgbXBnLCB0aGVuIHRoZSBjb2RlIGNhbiBiZSB3cml0dGVuIGFzIGZvbGxvd3M6DQpgYGB7cn0NCm10Y2FycyAlPiUgDQogIGdyb3VwX2J5KGN5bCkgJT4lIA0KICBzdW1tYXJpc2UoRnJlcV9jeWwgPSBuKCksDQogICAgICAgICAgICBNZWFuX21wZyA9IG1lYW4obXBnKSkNCmBgYA0KDQpIZXJlIHdlIGhhdmUgZm91bmQgdGhhdCB0aGVyZSBpcyAzIGdyb3VwcyBpbiBjeWwgYW5kIGVhY2ggZ3JvdXAgaGFzIGRpZmZlcmVudCBuby4gb2YgY2FycyBpbiBpdC4NCg0KQW5vdGhlciBleGFtcGxlIGNhbiBiZToNCmBgYHtyfQ0Kc3RhcndhcnMgJT4lIA0KICBncm91cF9ieShoYWlyX2NvbG9yKSAlPiUgDQogIHN1bW1hcmlzZShBdmVyYWdlX2hlaWdodCA9IHJvdW5kKG1lYW4oaGVpZ2h0LCBuYS5ybT1UKSwyKSkgJT4lDQogIGFycmFuZ2UoZGVzYyhBdmVyYWdlX2hlaWdodCkpDQpgYGANCg0KDQpgYGB7cn0NCnN0YXJ3YXJzICU+JSANCiAgZ3JvdXBfYnkoaGFpcl9jb2xvcikgJT4lIA0KICBzdW1tYXJpc2UoQXZlcmFnZV9oZWlnaHQgPSByb3VuZChtZWFuKGhlaWdodCwgbmEucm09VCksMiksDQogICAgICAgICAgICBDb3VudCA9IG4oKSkNCmBgYA0KDQoNClNvbWUgb3RoZXIgZnVuY3Rpb25zIHVzZWQgaW4gc3VtbWFyaXplIGFyZTogc3VtKCksIG1lYW4oKSwgbWVkaWFuKCksc2QoKSxJUVIoKSxtaW4oKSxtYXgoKSxmaXJzdCgpLGxhc3QoKSxudGgoKSBldGMuDQoNCkFub3RoZXIgZXhhbXBsZSBvZiB1c2luZyBvbmx5IGdyb3VwX2J5KCk6ICAgDQogICANCkxldCdzIHVzZSB0aGUgYGVzb3BoYCBkYXRhIHNldCBmb3IgdGhpczoNCmBgYHtyfQ0KaGVhZChlc29waCkNCmBgYA0KDQpIZXJlIGlzIGEgY29kZSB0aGF0IGNyZWF0ZXMgdHdvIHdheSB0YWJsZToNCmBgYHtyfQ0KZXNvcGggJT4lIA0KICBncm91cF9ieShhZ2VncCkgJT4lIA0KICBzZWxlY3QoYWdlZ3AsIGFsY2dwKSAlPiUgDQogIHRhYmxlKCkNCmBgYA0KDQojIyMgQWNyb3NzDQoNClNhbWUgc3VtbWFyeSBzdGF0aXN0aWNzIG9uIG11bHRpcGxlIGNvbHVtbnMgLSANCmBgYHtyfQ0KbXRjYXJzICU+JQ0KICBncm91cF9ieShnZWFyKSAlPiUNCiAgc3VtbWFyaXplKGFjcm9zcyhjKGNvdW50X2hwID0gaHAsIGNvdW50X2Rpc3AgPSBkaXNwKSwNCiAgICAgICAgICAgICAgICAgICB+IG4oKSkpDQpgYGANCg0KRnVuY3Rpb25zIGNhbiBiZSBwYXNzZWQgaW4gYWNyb3NzIGFzIHB1cnJyLXN0eWxlIGxhbWJkYSwgZS5nLiB+IG1lYW4oLngsIG5hLnJtID0gVFJVRSk6DQpgYGB7cn0NCm10Y2FycyAlPiUNCiAgZ3JvdXBfYnkoZ2VhcikgJT4lDQogIHN1bW1hcml6ZShhY3Jvc3MoYyhocCwgZGlzcCksDQogICAgICAgICAgICAgICAgICAgYyhGcmVxID0gfiBuKCksIE1lYW4gPSB+bWVhbiguLCBuYS5ybT1UUlVFKSkpKQ0KYGBgDQoNCkZ1bmN0aW9ucyBjYW4gYmUgcGFzc2VkIGluIGFjcm9zcyBhcyBhIGxpc3Qgb2YgZnVuY3Rpb25zL2xhbWJkYXMsIGUuZy4gbGlzdChtZWFuID0gbWVhbiwgbl9taXNzID0gfiBzdW0oaXMubmEoLngpKToNCmBgYHtyfQ0KbXRjYXJzICU+JQ0KICBncm91cF9ieShnZWFyKSAlPiUNCiAgc3VtbWFyaXplKGFjcm9zcyhjKGhwLCBkaXNwKSwNCiAgICAgICAgICAgICAgICAgICBsaXN0KE1lYW4gPSBtZWFuLCBTRCA9IHNkKSkpDQpgYGANCg0KSWYgbGlzdCBvZiBmdW5jdGlucyBpcyBwYXNzZWQsIHRoZSB0aGUgZnVuY3Rpb25zIGluc2lkZSBpdCBjYW4gYmUgd3JpdHRlbiBhcyBqdXN0IHRoZSBuYW1lIG9mIGZ1bmN0aW9uIG9yIGluIHB1cnJyLXN0eWxlIGxhbWJkYToNCmBgYHtyfQ0KbXRjYXJzICU+JQ0KICBncm91cF9ieShnZWFyKSAlPiUNCiAgc3VtbWFyaXplKGFjcm9zcyhjKGhwLCBkaXNwKSwNCiAgICAgICAgICAgICAgICAgICBsaXN0KE1lYW4gPSB+IG1lYW4oLiwgbmEucm0gPSBUUlVFKSwgU0QgPSBzZCkpKQ0KYGBgDQoNCkNvbHVtbiBuYW1lcyBjYW4gYmUgc3BlY2lmaWVkIHRvbzoNCg0KYGBge3J9DQptdGNhcnMgJT4lIA0KICBncm91cF9ieShnZWFyKSAlPiUgDQogIHN1bW1hcml6ZShhY3Jvc3MoYyhocCwgZGlzcCksDQogICAgICAgICAgICAgICAgICAgbGlzdChNZWFuID0gfiBtZWFuKC4pLCBTRCA9IH4gc2QoLikpLA0KICAgICAgICAgICAgICAgICAgIC5uYW1lcyA9ICJ7LmZufSBvZiB7LmNvbH0iKSkNCmBgYA0KDQpNb3JlIGV4YW1wbGU6DQpgYGB7cn0NCmVzb3BoICU+JQ0KICBncm91cF9ieShhZ2VncCkgJT4lIA0KICBzdW1tYXJpemUoYWNyb3NzKHdoZXJlKGlzLm51bWVyaWMpLCANCiAgICAgICAgICAgICAgICAgICBsaXN0KE1lYW4gPSB+bWVhbiguKSwgDQogICAgICAgICAgICAgICAgICAgICAgICBWYXJpYW5jZSA9IH52YXIoLikpLA0KICAgICAgICAgICAubmFtZXMgPSAiey5mbn1fey5jb2x9IikpDQpgYGANCg0KX190aXBzOl9fDQpgbWF0Y2hlcygic3RyaW5nIilgIGZ1bmN0aW9uIHNlbGVjdHMgY29sdW1ucyB3aG9zZSBjb2x1bW4gbmFtZSBtYXRjaGVzIHRoZSBnaXZlbiAic3RyaW5nIi4gICANCg0KVGhlIGZ1bmN0aW9uIGB0YWxseSgpYCBjYW4gYmUgdXNlZCB0byBjb3VudCBpbnN0ZWFkIG9mIGBuKClgOg0KYGBge3J9DQptdGNhcnMgJT4lIA0KICBncm91cF9ieShjeWwpICU+JSANCiAgdGFsbHkoc29ydD1ULCBuYW1lPSdDb3VudCcpIA0KIyBzb3J0ID0gVFJVRSwgd2lsbCBzaG93IHRoZSBsYXJnZXN0IGdyb3VwcyBhdCB0aGUgdG9wDQpgYGANCg0KYG5fZGlzdGluY3QodmVjdG9yKWAgY291bnRzIHRoZSBuby4gb2YgdW5pcXVlIGl0ZW1zIGluIHRoZSB2ZWN0b3I6DQpgYGB7cn0NCm10Y2FycyAlPiUgDQogIGdyb3VwX2J5KGN5bCkgJT4lIA0KICBzdW1tYXJpc2Uobm9fb2ZfY2Fyc19pbl9ncm91cD1uKCksDQogICAgICAgICAgICB1bmlxdWVfaHBfY2Fycz1uX2Rpc3RpbmN0KGhwKSkNCmBgYA0KDQojIyMgdG9wX24NCg0KVGhlIGZvbGxvd2luZyBleGFtcGxlIGtlZXBzIHRvcCA0IGNhcnMgYWNjb3JkaW5nIHRvIG1wZyBmcm9tIGVhY2ggZ3JvdXAgb2YgY3lsOg0KYGBge3J9DQptdGNhcnMgJT4lIA0KICBhZGRfcm93bmFtZXMoIkNhck5hbWUiKSAlPiUgDQogIGdyb3VwX2J5KGN5bCkgJT4lIA0KICB0b3BfbigyLCBtcGcpICU+JSANCiAgYXJyYW5nZShkZXNjKG1wZykpICU+JSANCiAgc2VsZWN0KENhck5hbWUsZ2VhcixtcGcpDQpgYGANCl9fVGlwczpfXyBgYWRkX3Jvd25hbWVzKClgIGFjdHVhbGx5IHR1cm5zIHRoZSByb3cgbmFtZXMgaW50byBhIGNvbHVtbiB3aXRoIGdpdmVuIHZhcmlhYmxlIG5hbWUuIEFsc28sIGBhZGRfcm93bmFtZXMoKWAgd2FzIGRlcHJlY2F0ZWQgaW4gZHBseXIgMS4wLjAuDQpQbGVhc2UgdXNlIGB0aWJibGU6OnJvd25hbWVzX3RvX2NvbHVtbigpYCBpbnN0ZWFkLg0KYGBge3J9DQptdGNhcnMgJT4lIA0KICB0aWJibGU6OnJvd25hbWVzX3RvX2NvbHVtbigiQ2FyTmFtZSIpICU+JSANCiAgZ3JvdXBfYnkoY3lsKSAlPiUgDQogIHRvcF9uKDIsIG1wZykgJT4lIA0KICBhcnJhbmdlKGRlc2MobXBnKSkgJT4lDQogIHNlbGVjdChDYXJOYW1lLGdlYXIsbXBnKQ0KYGBgDQoNCiMjIyMgdW5ncm91cA0KDQoqKk5vdGljZToqKiBBbHRob3VnaCB0aGUgYGN5bGAgY29sdW1uIHdhcyBub3Qgc2VsZWN0ZWQsIHNpbmNlIGl0IHdhcyB0aGUgZ3JvdXBpbmcgdmFyaWFibGUsIGRwbHlyIGlzIHNob3dpbmcgdGhlIGNvbHVtbi4gVG8gcHJldmVudCB0aGlzIGZyb20gaGFwcGVuaW5nLCBgdW5ncm91cCgpYCBpcyB1c2VkLg0KYGBge3J9DQptdGNhcnMgJT4lIA0KICB0aWJibGU6OnJvd25hbWVzX3RvX2NvbHVtbigiQ2FyTmFtZSIpICU+JSANCiAgZ3JvdXBfYnkoY3lsKSAlPiUgDQogIHRvcF9uKDIsIG1wZykgJT4lIA0KICBhcnJhbmdlKGRlc2MobXBnKSkgJT4lIA0KICB1bmdyb3VwKCkgJT4lIA0KICBzZWxlY3QoQ2FyTmFtZSxnZWFyLG1wZykNCmBgYA0KDQojIyMgU2VwYXJhdGUgDQoNCmBgYHtyfQ0KbXRjYXJzICU+JSANCiAgdGliYmxlOjpyb3duYW1lc190b19jb2x1bW4oIkNhck5hbWUiKSAlPiUgDQogIHRpZHlyOjpzZXBhcmF0ZShjb2wgPSBDYXJOYW1lLCANCiAgICAgICAgICAgICAgICAgIGludG8gPSBjKCJDYXIgTmFtZSIsIk1vZGVsIiksICMgc2VwYXJhdGUgaW50byB0aGVzZSB2YXJpYWJsZXMNCiAgICAgICAgICAgICAgICAgIHNlcCA9ICIgIiwgIyBzZXBhcmF0b3INCiAgICAgICAgICAgICAgICAgIGV4dHJhID0gIm1lcmdlIiwgICMgaWYgbW9yZSBwYXJ0cyB0aGFuIHRoZSBsZW5ndGggb2YgYGludG9gDQogICAgICAgICAgICAgICAgICBmaWxsID0gInJpZ2h0IiAgICMgZmlsbCB0byB0aGUgcmlnaHQNCiAgICAgICAgICAgICAgICAgICkNCmBgYA0KDQoNCi0tLQ0KDQojIyBNdXRhdGluZyBKb2lucw0KDQpMZXQncyBjcmVhdGUgdHdvIGRhdGEgZnJhbWVzOg0KYGBge3J9DQooYSA8LSBkYXRhLmZyYW1lKGNvbG9yPWMoIkJsdWUiLCJSZWQiLCJZZWxsb3ciLCJNZWdlbmRhIiwiV2hpdGUiKSwNCiAgICAgICAgICAgICAgICB0YWthMT1jKDEwLDEwLDE1LDIwLDMwKSkpDQooYiA8LSBkYXRhLmZyYW1lKGNvbG9yPWMoIkJsYWNrIiwiUmVkIiwiWWVsbG93IiwiUGluayIsIkdyZWVuIiksDQogICAgICAgICAgICAgICAgdGFrYTI9YygyMCwxMCwxNSwxMCwzMCkpKQ0KYGBgDQoNCiMjIyBpbm5lciBqb2luDQoNCk9ubHkgaW5jbHVkZSBvYnNlcnZhdGlvbnMgZm91bmQgaW4gYm90aCAiYSIgYW5kICJiIiAoQSBpbnRlcnNlY3QgQik6DQpgYGB7cn0NCmlubmVyX2pvaW4oYSxiKQ0KYGBgDQoNCiMjIyBmdWxsIGpvaW4NCg0KSW5jbHVkZSBvYnNlcnZhdGlvbnMgZm91bmQgaW4gZWl0aGVyICJhIiBvciAiYiIgKEEgVSBCKToNCmBgYHtyfQ0KZnVsbF9qb2luKGEsYikNCmBgYA0KDQojIyMgc2VtaSBqb2luDQoNClNob3dzIHRob3NlIHZhbHVlcyBvZiAiYSIgdGhhdCBtYXRjaGVzIHRoZSB2YWx1ZXMgb2YgImIiOg0KYGBge3J9DQpzZW1pX2pvaW4oYSxiKQ0KYGBgDQoNCiMjIyBhbnRpIGpvaW4NCg0KU2hvd3MgdGhvc2UgdmFsdWVzIG9mICJhIiB0aGF0IGRvZXMgbm90IG1hdGNoIHRoZSB2YWx1ZXMgb2YgImIiOg0KDQpgYGB7cn0NCmFudGlfam9pbihhLGIpDQpgYGANCg0KIyMjIGxlZnQgYW5kIHJpZ2h0IGpvaW4NCg0KYGBge3J9DQpsZWZ0X2pvaW4oYSxiKSAjIGluY2x1ZGUgYWxsIG9ic2VydmF0aW9ucyBmb3VuZCBpbiBhDQpyaWdodF9qb2luKGEsYikgIyBpbmNsdWRlIGFsbCBvYnNlcnZhdGlvbnMgZm91bmQgaW4gYg0KYGBgDQoNCiMjIExlYXJuIE1vcmUNCg0KUnVuIHRoZSBmb2xsb3dpbmcgY29kZSB0byBsZWFybiBtb3JlIGFib3V0IGRwbHlyLg0KYGBge3J9DQojIHZpZ25ldHRlKCJwcm9ncmFtbWluZyIsIHBhY2thZ2UgPSAiZHBseXIiKQ0KYGBgDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQo=