Random R Ramblings

{poorman}: Version 0.2.5 Release

Mon, 29 Mar 2021 20:12:00 -0500

{poorman} 0.2.5

Yesterday I released the ninth version of {poorman} to CRAN.

This update has added the following new features:

summarise() can now revise grouping structures with the .groups argument (#57).
group_by() can now drop groups formed by factor levels that don’t appear in the data with the .drop parameter (#63).
New cumulative functions have been added: cumall(), cumany() and cummean() (#64).
Additional tools for working with rownames have been added: has_rownames(), remove_rownames(), column_to_rownames(), rowid_to_column() (#66).
filter() gains the .preserve parameters (#81).
if_any() and if_all() were added (#80).

The following fixes were also implemented:

mutate() now successfully evaluates functions defined in the scope of a parent function (#68).
select_positions() now works if passed a combination of positive and negative values (#71).
transmute() now keeps unnamed columns that it creates (#72).

The following refactorisations took place:

When grouping data with group_by(), it will now create an object of class grouped_df and not grouped_data which keeps it consistent with the {dplyr} method name (#70). This should hopefully make transitioning packages from {dplyr} to {poorman} a little easier.

Filling NA Values Using the Last Observation Carried Forward with {dplyr}, {dbplyr} and {sparklyr}

Sun, 21 Mar 2021 20:12:00 -0500

The Problem

Real life data is often riddled with missing values - or NAs - where no data value are stored for the variable in observation. Missing data such as this can have a significant effect on the conclusions which can be drawn from the data. For example individuals dropping out of a study or subjects not properly reporting responses. A common solution to this problem is to fill those NA values with the most recent non-NA value prior to it - this is called the Last Observation Carried Forward (LOCF) method.

This blog post will look at how to implement this particular solution using a combination of {dplyr}, {dbplyr} and {sparklyr}.

Solving the Problem with {dbplyr}

For this problem we will be using the following temperature data.

# # Source: spark<temperature> [?? x 3]
#     year month  temp
#    <int> <int> <dbl>
#  1  2016     1   6.9
#  2  2016     2  NA  
#  3  2016     3  10.1
#  4  2016     4  11.5
#  5  2016     5  16.3
#  6  2016     6  19.1
#  7  2016     7  NA  
#  8  2016     8  NA  
#  9  2016     9  17.6
# 10  2016    10  13.6
# # … with more rows

It might be reasonable to assume that we can fill the NA values of the temp column with the previous month’s data.

The strategy to forward fill in Spark is to use what’s known as a window function. A window function performs a calculation across a set of table rows that are somehow related to the current row. This is comparable to the type of calculation that can be done with an aggregate function. But unlike regular aggregate functions, use of a window function does not cause rows to become grouped into a single output row — the rows retain their separate identities. Behind the scenes, the window function is able to access more than just the current row of the query result.

We can perform window functions in Spark using dbplyr::win_over(). In this function we define the window frame which - for the LOCF method - includes all rows from the beginning of time up to the current row, i.e. -Inf to 0. We need to specify that our data follow a particular order which is the month in ascending order. We also need to partition the data by the year which can be thought of as acting like dplyr::group_by(). Finally we define the expression to perform on the data which, since we need the last non-NA value, can be obtained using the Spark SQL function last().

last(expr[, isIgnoreNull]) - Returns the last value of expr for a group of rows. If isIgnoreNull is true, returns only non-null values.

Putting this all together, we have the following operation.

temperature <- dplyr::mutate(
  .data = temperature,
  tempLOCF = dbplyr::win_over(
    expr = dplyr::sql("last(temp, true)"),
    partition = "year",
    order = "month",
    frame = c(-Inf, 0),
    con = sc
  )
)
temperature
# # Source: spark<?> [?? x 4]
#     year month  temp tempLOCF
#    <int> <int> <dbl>    <dbl>
#  1  2016     1   6.9      6.9
#  2  2016     2  NA        6.9
#  3  2016     3  10.1     10.1
#  4  2016     4  11.5     11.5
#  5  2016     5  16.3     16.3
#  6  2016     6  19.1     19.1
#  7  2016     7  NA       19.1
#  8  2016     8  NA       19.1
#  9  2016     9  17.6     17.6
# 10  2016    10  13.6     13.6
# # … with more rows

So now we can see that we have filled the values as expected. The way this works is that {dbplyr} takes our regular {dplyr} code and translates it to SQL code. We can see the SQL that {dbplyr} generates for us with dbplyr::sql_render().

dbplyr::sql_render(query = temperature)
# <SQL> SELECT `year`, `month`, `temp`, last(temp, true) OVER (PARTITION BY `year` ORDER BY `month` ROWS UNBOUNDED PRECEDING) AS `tempLOCF`
# FROM `temperature`

Note that the con = sc here is required such that {dbplyr} can set up the SQL for the particular database engine you are working with - in this case, Spark.

Bonus - Next Observation Carried Backwards

The Next Observation Carried Backwards method is very similar to LOCF except, you guessed it, we carry the next non-NA value backwards. This can be achieved with the exact same code expect the frame changes to be from the current row to the end of the partition (or group) and we take the first() non-NA value from the window frame.

dplyr::mutate(
  .data = temperature,
  tempNOCB = dbplyr::win_over(
    expr = dplyr::sql("first(temp, true)"),
    partition = "year",
    order = "month",
    frame = c(0, Inf),
    con = sc
  )
)
# # Source: spark<?> [?? x 5]
#     year month  temp tempLOCF tempNOCB
#    <int> <int> <dbl>    <dbl>    <dbl>
#  1  2016     1   6.9      6.9      6.9
#  2  2016     2  NA        6.9     10.1
#  3  2016     3  10.1     10.1     10.1
#  4  2016     4  11.5     11.5     11.5
#  5  2016     5  16.3     16.3     16.3
#  6  2016     6  19.1     19.1     19.1
#  7  2016     7  NA       19.1     17.6
#  8  2016     8  NA       19.1     17.6
#  9  2016     9  17.6     17.6     17.6
# 10  2016    10  13.6     13.6     13.6
# # … with more rows

For what it’s worth, this functionality very recently became available via the tidyr::fill(), for which there is now a tbl_lazy method in {dbplyr}.

Using Functions As An Input To Functions With {dbplyr}

Thu, 18 Feb 2021 20:12:00 -0500

The Problem

I wish to write a function that can mutate a column of my data using a function which is passed as an input. For example, I want to write a function which can modify an existing tbl_spark using dplyr::mutate() by adding a column that is the mean() of a column. To do this, we will see that we require a different solution depending on whether we are working with a data.frame or a tbl_spark. For this reason, I am going to define an S3 generic, mutate_with(), for which I am going to define two methods, one for data.frames and one for tbl_sparks.

Solution For `data.frame`s

First of all, let us define our generic. If you are not familiar with S3 generics and how they work, I would recommend checking out the S3 section in the freely available Advanced R book.

mutate_with <- function(data, fn, col_in, col_out = "output") {
  UseMethod(generic = "mutate_with", object = data)
}

Now that we have our generic in place, we can add our first method for data.frames. This is actually relatively simple as seen below.

mutate_with.data.frame <- function(data, fn, col_in, col_out = "output") {
  dplyr::mutate(.data = data, !!col_out := fn(!!rlang::sym(col_in)))
}
head(
  mutate_with(data = mtcars, fn = mean, col_in = "mpg", col_out = "mean_mpg")
)
#    mpg cyl disp  hp drat    wt  qsec vs am gear carb mean_mpg
# 1 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4 20.09062
# 2 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4 20.09062
# 3 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1 20.09062
# 4 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1 20.09062
# 5 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2 20.09062
# 6 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1 20.09062

This works because what we are essentially doing is assigning the function mean() to the object fn.

mean
# function (x, ...) 
# UseMethod("mean")
# <bytecode: 0x7fd5f69a3590>
# <environment: namespace:base>
fn <- mean
fn
# function (x, ...) 
# UseMethod("mean")
# <bytecode: 0x7fd5f69a3590>
# <environment: namespace:base>

This means that we can call fn() as if we were calling mean().

fn(rnorm(100))
# [1] 0.01109211

Solution For `tbl_spark`s

Unfortunately the above solution does not work for tbl_sparks. To show this, I will first create a Spark connection and upload the mtcars data.

sc <- sparklyr::spark_connect(master = "local")
mtcars_spark <- dplyr::copy_to(sc, mtcars, "mtcars")

Now let’s try calling our function with the mtcars_spark object.

mutate_with.tbl_spark <- mutate_with.data.frame
mutate_with(
  data = mtcars_spark, fn = mean, col_in = "mpg", col_out = "mean_mpg"
)
# Error: org.apache.spark.sql.AnalysisException: Undefined function: 'fn'.
# This function is neither a registered temporary function nor a permanent
# function registered in the database 'default'.; line 1 pos 85
# ... (additional output has been removed)

So we get an error here telling us that we have passed an underfined function, fn. This is because in the background, the package {dbplyr} is attempting to translate our code to Spark SQL code to be executed by Spark. To do this, {dbplyr} parses our {dplyr} code, for which there are two parts.

Firstly there is the translation of {dplyr} verbs, e.g. select(), filter(), arrange(), etc. form the basic structure of a SQL query, SELECT, WHERE, ORDER BY, etc.

Secondly there is the translation of the expressions within those verbs. This is the part that is interesting to us for this blog post. First of all we have “known functions” where {dbplyr} takes the functionality that you pass to it and tries to convert it to a SQL equivalent. As a simple example, {dbplyr} will convert the mean() function to AVG. However {dbplyr} cannot always produce a perfect translation because there are functions which exist in R that do not exist in the varying flavours of SQL, we will refer to these as “unknown functions”.

As a note, there is even functionality in both that cannot be translated, for example the trim parameter of the mean() function is not available in SQL.

What {dbplyr} does with these unknown functions, therefore, is to leave them “as-is”. This means that database functions that are not covered by {dbplyr} can be used directly. For example in Spark we can access and use Hive UDFs.

So what does this all mean? And why does this mean that our function failed? Well it’s because when {dbplyr} parses our code, it “sees” the fn parameter and it treats it “as-is” since there is no direct conversion to a SQL function defined in {dbplyr}. Equally, there is no function in Spark SQL called fn() which is why, when our converted code is sent to Spark, we see the failure. We can see this in action by rendering the translated output that {dbplyr} gives us.

out <- mutate_with(
  data = mtcars_spark, fn = mean, col_in = "mpg", col_out = "mean_mpg"
)
dbplyr::sql_render(out)

<SQL> SELECT `mpg`, `cyl`, `disp`, `hp`, `drat`, `wt`, `qsec`, `vs`, `am`,
`gear`, `carb`, fn(`mpg`) AS `mean_mpg`
FROM `mtcars`

This means that we must pass the actual function name, i.e. mean, in place of fn at the time that {dbplyr} “sees” our code and attempts to parse and translate it into SQL. For this, we need to use non-standard evaluation semantics.

mutate_with.tbl_spark <- function(data, fn, col_in, col_out = "output") {
  fn <- rlang::enquo(fn)
  dplyr::mutate(
    .data = data, !!col_out := rlang::call2(.fn = !!fn, rlang::sym(col_in))
  )
}
mutate_with(
  data = mtcars_spark, fn = mean, col_in = "mpg", col_out = "mean_mpg"
)
# # Source: spark<?> [?? x 12]
#      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb mean_mpg
#    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
#  1  21       6  160    110  3.9   2.62  16.5     0     1     4     4     20.1
#  2  21       6  160    110  3.9   2.88  17.0     0     1     4     4     20.1
#  3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1     20.1
#  4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1     20.1
#  5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2     20.1
#  6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1     20.1
#  7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4     20.1
#  8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2     20.1
#  9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2     20.1
# 10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4     20.1
# # … with more rows

So why does this work? Well what we are doing here is “quoting” the parameter fn which is the same as saying preventing the evaluation of fn. rlang::enquo() is used to quote function arguments such as fn and returns what is known as a “quosure”. A “quosure” is an object containing both the expression and the environment which that expression comes from. We can “unquote” the “quosure”, fn, with the !! or “bang-bang” operator.

In English this means that we can evaluate and replace inline the captured expression. So what !!fn actually reads as is mean. The !!fn works because it is evaluated before any R code is evaluated. In other words, before the code is parsed by {dbplyr}, {rlang} is able to evaluate !!fn, replacing it with mean. You will sometimes see this being referred to as partial evaluation.

That’s a lot of information in two short paragraphs and I’d highly recommend reading the help file (?rlang::quosure) if you’d like to know more. Another great resource for learning more about {rlang} is Brodie Gaslam’s On Quosures.

We use rlang::call2() to build a quoted function call which can be interpreted by {dbplyr}. What this all boils down to is that rlang::call2(.fn = !!fn, rlang::sym(col_in)) is used to create the following, unevaluated, expression.

mean(mpg)

So the execution order is as follows:

!!fn is translated to mean, inline.
rlang::call2() is evaluated, giving mean(mpg) (note that we convert our string input to a symbol using rlang::sym(col_in)).
{dbplyr} translates the code to SQL code and sends it to Spark to be executed.

Note that we can achieve a similar result using base::bquote() and base::eval(). bquote() is base R’s equivalent of partial evaluation which creates a quoted expression that we can then evaulate with eval(). The difference in syntax is that the parts to be partially evaluated are surrounded by .() instead of !! as in {rlang}.

mutate_with_bquote <- function(data, fn, col_in, col_out = "output") {
  eval(bquote(
    dplyr::mutate(.data = data, !!col_out := .(fn)(rlang::sym(col_in)))
  ))
}
mutate_with_bquote(
  data = mtcars_spark, fn = mean, col_in = "mpg", col_out = "mean_mpg"
)
# # Source: spark<?> [?? x 12]
#      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb mean_mpg
#    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
#  1  21       6  160    110  3.9   2.62  16.5     0     1     4     4     20.1
#  2  21       6  160    110  3.9   2.88  17.0     0     1     4     4     20.1
#  3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1     20.1
#  4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1     20.1
#  5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2     20.1
#  6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1     20.1
#  7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4     20.1
#  8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2     20.1
#  9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2     20.1
# 10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4     20.1
# # … with more rows

Quoted Function Name

The above could have all been made much simpler by passing a quoted function name, however you may well have reasons you don’t wish to do this. For completeness, I present an example of how this can be done.

mutate_with.tbl_spark <- function(data, fn, col_in, col_out = "output") {
  condition <- paste0(fn, "(", col_in, ")")
  dplyr::mutate(.data = data, !!col_out := !!rlang::parse_expr(condition))
}
mutate_with(
  data = mtcars_spark, fn = "mean", col_in = "mpg", col_out = "mean_mpg"
)
# # Source: spark<?> [?? x 12]
#      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb mean_mpg
#    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
#  1  21       6  160    110  3.9   2.62  16.5     0     1     4     4     20.1
#  2  21       6  160    110  3.9   2.88  17.0     0     1     4     4     20.1
#  3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1     20.1
#  4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1     20.1
#  5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2     20.1
#  6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1     20.1
#  7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4     20.1
#  8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2     20.1
#  9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2     20.1
# 10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4     20.1
# # … with more rows

So we build the expression as a string which we then parse ourselves using rlang::parse_expr().

It is also worth noting that this version works with regular data.frames too.

mutate_with.data.frame <- function(data, fn, col_in, col_out = "output") {
  condition <- paste0(fn, "(", col_in, ")")
  dplyr::mutate(.data = data, !!col_out := !!rlang::parse_expr(condition))
}
head(mutate_with(
  data = mtcars, fn = "mean", col_in = "mpg", col_out = "mean_mpg"
))
#    mpg cyl disp  hp drat    wt  qsec vs am gear carb mean_mpg
# 1 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4 20.09062
# 2 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4 20.09062
# 3 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1 20.09062
# 4 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1 20.09062
# 5 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2 20.09062
# 6 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1 20.09062

Additional Comments

What is nice about the solution presented in this blog post is that we can still pass any user defined functions. Let’s say we have a function written in Scala code and exposed to the Spark cluster. We can still call this function. For example below I am using the Hive UDF, reverse(), to return a column with my last name spelt backwards.

data <- data.frame(first_name = "nathan", last_name = "eastwood")
data <- dplyr::copy_to(sc, data, "data")
mutate_with(data = data, fn = reverse, col_in = "last_name")
# # Source: spark<?> [?? x 3]
#   first_name last_name output  
#   <chr>      <chr>     <chr>   
# 1 nathan     eastwood  doowtsae

In addition it can be a nice way to get around R CMD check issues. Let’s say we wanted to use the Spark function sequence().

add_sequence <- function(data, length_to, col_out = "seq") {
  dplyr::mutate(.data = data, !!col_out := sequence(1, length_to))
}

If we have the above function defined in an R package, we may see the following R CMD check NOTE.

checking R code for possible problems ... NOTE
add_sequence: possible error in sequence(1,
  length_to): unused argument (length_to)

Whereas using the trick shown in this blog, we no longer see this issue.

add_sequence <- function(data, fn = sequence, from, to, col_out = "seq") {
  fun <- rlang::enquo(fn)
  dplyr::mutate(.data = data, !!col_out := rlang::call2(.fn = !!fun, from, to))
}

Of course, I wouldn’t recommend defining such a function this way.

Conclusion

To keep things short and sweet, if you wish to pass a function as-is to another function which you then wish to have parsed by dbplyr into SQL code, you must first quote the function with rlang::enquo() and then unquote it with !!. You can then build your expression with rlang::call2() and have this parsed by {dbplyr}.

poorman: Versions 0.2.2 and 0.2.3 Releases

Sat, 14 Nov 2020 20:12:00 -0500

Introduction

Welcome to my series of blog posts about my data manipulation package, {poorman}. For those of you that don’t know, {poorman} is aiming to be a replication of {dplyr} but using only {base} R, and therefore be completely dependency free. What’s nice about this series is that if you would rather just use {dplyr}, then that’s absolutely OK! By highlighting {poorman} functionality, this series of blog posts simultaneously highlights {dplyr} functionality too! However I sometimes also describe how I developed the internals of {poorman}, often highlighting useful {base} R tips and tricks.

Since my last blog post about {poorman}, versions 0.2.2 and 0.2.3 have been released, bringing with them a whole host of new functions and features. In today’s blog post we will be taking a look at some of these new features. Given the sheer amount of features this release brings, we won’t be focusing on the internals of any of these functions. Instead, we will simply be taking a look at what some of them can do.

`across()`

One of the newer features in {dplyr}, across() is intended to eventually replace the scoped variants (_if, _at, _all) of the “single table” verb functions which have now been superseded. These functions will supposedly remain within {dplyr} for “several years” still, giving developers plenty of time to update their code.

across() makes it easy to apply the same transformation to multiple columns, allowing you to use poor-select (or tidy-select) semantics inside of summarise() and mutate(). Let’s take a look at the function in action.

library(poorman, warn.conflicts = FALSE)
iris %>%
  group_by(Species) %>%
  summarise(across(.cols = starts_with("Sepal"), .fn = mean))
#      Species Sepal.Length Sepal.Width
# 1     setosa        5.006       3.428
# 2 versicolor        5.936       2.770
# 3  virginica        6.588       2.974

In the above code chunk, we take the iris dataset and group it by the Species column; then we look to summarise across all columns which start with the string "Sepal" (Sepal.Length and Sepal.Width) by taking the mean of those columns within each Species group. Let’s take a look at a more complex example.

iris %>%
  group_by(Species) %>%
  summarise(across(.cols = contains("Width"), .fn = list(mean, sd)))
#      Species Sepal.Width_1 Sepal.Width_2 Petal.Width_1 Petal.Width_2
# 1     setosa         3.428     0.3790644         0.246     0.1053856
# 2 versicolor         2.770     0.3137983         1.326     0.1977527
# 3  virginica         2.974     0.3224966         2.026     0.2746501

So here, we are saying give me the mean and standard devitaion across all columns containing the string "Width" for each Species of iris flower. Notice how the output is named, the function will give the columns numbers to represent the functional output, i.e. here _1 represents the mean and _2 represents the standard deviation. You can control the names yourself but providing them to the .names argument.

iris %>%
  group_by(Species) %>%
  summarise(across(
    .cols = contains("Width"),
    .fn = list(mean, sd),
    .names = c(
      "sepal_width_mean", "sepal_width_sd", "petal_width_mean", "petal_width_sd"
    )
  ))
#      Species sepal_width_mean sepal_width_sd petal_width_mean petal_width_sd
# 1     setosa            3.428      0.3790644            0.246      0.1053856
# 2 versicolor            2.770      0.3137983            1.326      0.1977527
# 3  virginica            2.974      0.3224966            2.026      0.2746501

This is slightly different to how {dplyr} works since it imports {glue}, but remember, {poorman} aims to be dependency free. This functionality will be expanded upon in future releases of {poorman}.

`case_when()`

This function allows you to vectorise multiple if_else() statements. It is an R equivalent of the SQL CASE WHEN statement. If no cases match, NA is returned. The syntax for the function is a sequence of two-sided formulas. The left hand side determines which values match the particular case whereas the right hand side provides the replacement value.

x <- 1:50
case_when(
  x %% 35 == 0 ~ "fizz buzz",
  x %% 5 == 0 ~ "fizz",
  x %% 7 == 0 ~ "buzz",
  TRUE ~ as.character(x)
)
#  [1] "1"         "2"         "3"         "4"         "fizz"      "6"         "buzz"     
#  [8] "8"         "9"         "fizz"      "11"        "12"        "13"        "buzz"     
# [15] "fizz"      "16"        "17"        "18"        "19"        "fizz"      "buzz"     
# [22] "22"        "23"        "24"        "fizz"      "26"        "27"        "buzz"     
# [29] "29"        "fizz"      "31"        "32"        "33"        "34"        "fizz buzz"
# [36] "36"        "37"        "38"        "39"        "fizz"      "41"        "buzz"     
# [43] "43"        "44"        "fizz"      "46"        "47"        "48"        "buzz"     
# [50] "fizz"

Like an if statement, the arguments are evaluated in order, so you must proceed from the most specific to the most general. case_when() is particularly useful inside mutate() when you want to create a new variable that relies on a complex combination of existing variables.

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

`rename_with()`

rename_with() acts like rename(), only it allows you to rename columns with a function. In the below example, we rename the columns of iris to be upper case.

rename_with(iris, toupper) %>% head()
#   SEPAL.LENGTH SEPAL.WIDTH PETAL.LENGTH PETAL.WIDTH SPECIES
# 1          5.1         3.5          1.4         0.2  setosa
# 2          4.9         3.0          1.4         0.2  setosa
# 3          4.7         3.2          1.3         0.2  setosa
# 4          4.6         3.1          1.5         0.2  setosa
# 5          5.0         3.6          1.4         0.2  setosa
# 6          5.4         3.9          1.7         0.4  setosa

However we can have more control over which columns we rename by making use of the .cols parameter and poor-select selection semantics.

rename_with(iris, toupper, contains("Petal")) %>% head()
#   Sepal.Length Sepal.Width PETAL.LENGTH PETAL.WIDTH Species
# 1          5.1         3.5          1.4         0.2  setosa
# 2          4.9         3.0          1.4         0.2  setosa
# 3          4.7         3.2          1.3         0.2  setosa
# 4          4.6         3.1          1.5         0.2  setosa
# 5          5.0         3.6          1.4         0.2  setosa
# 6          5.4         3.9          1.7         0.4  setosa

Conclusion

This post has demonstrated some of the capabilities of the {poorman} (and therefore {dplyr}) package. The v0.2.2 and v0.2.3 releases actually includes plenty more features and functions so be sure to check out the release page.

If you are interested in taking a closer look at how have coded these functions, you can see the code on the relevant {poorman} GitHub page.

If you’d like to show your support for {poorman}, please consider giving the package a Star on Github as it gives me that boost of dopamine needed to continue development.

poorman: Version 0.2.1 Release

Wed, 01 Jul 2020 20:12:00 -0500

Introduction

Welcome to my series of blog posts about my data manipulation package, {poorman}. For those of you that don’t know, {poorman} is aiming to be a replication of {dplyr} but using only {base} R, and therefore be completely dependency free. What’s nice about this series is that if you would rather just use {dplyr}, then that’s absolutely OK! By highlighting {poorman} functionality, this series of blog posts simultaneously highlights {dplyr} functionality too! However I sometimes also describe how I developed the internals of {poorman}, often highlighting useful {base} R tips and tricks.

Today marks the release of v0.2.1 of {poorman} and with it a whole host of new functions and features. In today’s blog post we will be taking a look at some of these new features. Given the sheer amount of features this release brings, we won’t be focusing on the internals of any of these functions; the internals will be saved for another post. In stead, we will simply be taking a look at what some of them can do.

Selecting Distinct Rows

The first function we will take a look at is distinct(). Let’s say you want to select only the distinct, or unique, rows from your data.frame, distinct() will help you do that. Let’s create some fake data; some are duplicated.

df <- data.frame(
  id = c(1, 2, 3, 4, 5, 6, 1, 2, 7, 1, 4, 6),
  age = c(26, 24, 26, 22, 23, 24, 26, 24, 22, 26, 22, 25),
  score = c(85, 63, 55, 74, 31, 77, 85, 63, 42, 85, 74, 78)
)
df
#    id age score
# 1   1  26    85
# 2   2  24    63
# 3   3  26    55
# 4   4  22    74
# 5   5  23    31
# 6   6  24    77
# 7   1  26    85
# 8   2  24    63
# 9   7  22    42
# 10  1  26    85
# 11  4  22    74
# 12  6  25    78

Now we wish to see the distinct records from this data.

library(poorman, warn.conflicts = FALSE)
df %>% distinct()
#    id age score
# 1   1  26    85
# 2   2  24    63
# 3   3  26    55
# 4   4  22    74
# 5   5  23    31
# 6   6  24    77
# 9   7  22    42
# 12  6  25    78

So we see that we now only have 8 records out of the original 12 because the duplicates have been removed. We can actually obtain the distinct rows for a particular column, returning just that column.

df %>% distinct(age)
#    age
# 1   26
# 2   24
# 4   22
# 5   23
# 12  25

But if you need the other variables still, you can choose to keep those too.

df %>% distinct(age, .keep_all = TRUE)
#    id age score
# 1   1  26    85
# 2   2  24    63
# 4   4  22    74
# 5   5  23    31
# 12  6  25    78

Slicing Data

{dplyr} provides a couple of ways to selecting a subset of rows. It has the functions top_n() and top_frac() as well as the slice_*() family of functions. The former functions have now been superseded by the latter and so {poorman} skipped the implementation of the former. So what exactly do they do? Let’s take a look at some examples using the mtcars dataset.

slice_head() returns the first n rows (defaults to 1). slice_tail() returns the last n rows (not shown here).

slice_head(mtcars, n = 3)
#                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

slice_sample() randomly selects rows with or without replacement.

slice_sample(mtcars, n = 3, replace = TRUE)
#                mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# 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
# Merc 280C     17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4

slice_min() and slice_max() select rows with highest or lowest values of a variable.

mtcars %>% slice_min(mpg, n = 3)
#                      mpg cyl disp  hp drat    wt  qsec vs am gear carb
# Cadillac Fleetwood  10.4   8  472 205 2.93 5.250 17.98  0  0    3    4
# Lincoln Continental 10.4   8  460 215 3.00 5.424 17.82  0  0    3    4
# Camaro Z28          13.3   8  350 245 3.73 3.840 15.41  0  0    3    4

Selecting With Predicates

It is now possible to select columns in your data.frame which match a predicate such as is.numeric(). where() takes a function and returns all variables for which the function returns TRUE.

df <- data.frame(
  col1 = c(1, 2, 3),
  col2 = c("x", "y", "z"),
  col3 = c(TRUE, FALSE, TRUE)
)
df %>% select(where(is.numeric))
#   col1
# 1    1
# 2    2
# 3    3

Working With NA Values

Finding the First Non-Missing Element

Given a set of vectors, the coalesce() function finds the first non-missing value at each position.

# Use a single value to replace all missing values
x <- sample(c(1:5, NA, NA, NA))
coalesce(x, 0L)
# [1] 4 0 5 0 1 2 0 3

# Or match together a complete vector from missing pieces
y <- c(1, 2, NA, NA, 5)
z <- c(NA, NA, 3, 4, 5)
coalesce(y, z)
# [1] 1 2 3 4 5

Convert Values To NA

We can convert values in a vector x if they match values in a second vector y.

na_if(1:5, 5:1)
# [1]  1  2 NA  4  5

This is particularly useful in a data.frame if you need to replace a particular value.

df <- data.frame(a = c("a", "b", "c", "BAD_VALUE"))
df %>% mutate(a = na_if(a, "BAD_VALUE"))
#      a
# 1    a
# 2    b
# 3    c
# 4 <NA>

Replacing NA Values

Within a data.frame we often have missing values in multiple columns. We sometimes wish to replace these values which is where replace_na() comes in. replace_na() is actually a function from the {tidyr} package but I decided to add it to {poorman} as it is extremely useful. Let’s take a look.

df <- data.frame(x = c(1, 2, NA), y = c("a", NA, "b"))
df %>% replace_na(list(x = 0, y = "unknown"))
#   x       y
# 1 1       a
# 2 2 unknown
# 3 0       b

Recoding Values

If we wish to replace values within a vector or a column of a data.frame, we can use recode(). This is a vectorised version of base::switch(): you can replace numeric values based on their position or their name, and character or factor values only by their name.

char_vec <- sample(c("a", "b", "c"), 10, replace = TRUE)
recode(char_vec, a = "Apple")
#  [1] "b"     "c"     "b"     "c"     "Apple" "Apple" "Apple" "c"     "Apple" "b"
recode(char_vec, a = "Apple", b = "Banana")
#  [1] "Banana" "c"      "Banana" "c"      "Apple"  "Apple"  "Apple"  "c"      "Apple" 
# [10] "Banana"

Group Details

The final group (no pun intended) of features are focussed solely on grouped data. Given how many there are, I am not going to go into detail and instead I provide a brief overview here for the reader. The plan is to detail these functions in a separate blog post since a lot of work went on under the hood that may be interesting to discuss.

Functions for splitting data.frames: group_split(), group_keys()
Extract grouping metadata: group_data(), group_indices(), group_vars(), group_rows(), group_size(), n_groups(), groups()
Extract information about the current group: cur_data(), cur_group(), cur_group_id(), cur_group_rows(), cur_column()

Conclusion

You made it this far, great! I won’t keep you much longer. This post has demonstrated some of the capabilities of the {poorman} (and therefore {dplyr}) package. The v0.2.1 release actually includes a sleuth of other features and functions so be sure to check out the release page for a full list.

As this blog post is quite long, I haven’t gone into any further details of the internals of {poorman} however if you are interested in taking a closer look at how I handle the different input types, you can see the code on the relevant {poorman} GitHub page. {poorman} is still a work in progress but as you can see, it already has a lot of functionality you know and love from {dplyr} so if you are working on a new project and don’t want to have to deal with dependency management, especially if you are sharing work with colleagues, why not give {poorman} a try?

If you’d like to show your support for {poorman}, please consider giving the package a Star on Github as it gives me that boost of dopamine needed to continue development.

poorman: The Selectificator 2000!

Sun, 17 May 2020 20:12:00 -0500

Introduction

Welcome to my series of blog posts about my data manipulation package, {poorman}. For those of you that don’t know, {poorman} is aiming to be a replication of {dplyr} but using only {base} R, and therefore be completely dependency free. What’s nice about this series is that if you’re not into {poorman} and would prefer just to use {dplyr}, then that’s absolutely OK! By highlighting {poorman} functionality, this series of blog posts simultaneously highlights {dplyr} functionality too! However I also describe how I developed the internals of {poorman}, often highlighting useful {base} R tips and tricks.

I recently released v0.2.0 of {poorman} which you can install from CRAN and so today I am going to talk about my progress in expanding the flexibility of the select() function. But I’m not just going to show you what it can do, I am going to show you how. If you’re interested in learning a little bit about non-standard evaluation in R then be sure to read on.

The Selectificator 1000

Before v0.2.0, {poorman} was using a form of non-standard evaluation which converts function inputs to character strings and then uses those to figure out which columns to select. Specifically, {poorman} includes the following helper function.

deparse_dots <- function(...) {
  vapply(substitute(...()), deparse, NA_character_)
}

This is an unexported function since it is not user facing but you can find it in the code on GitHub here. Let’s dig into what this function does a little, but first we will define a temporary function to show by example.

dummy_select <- function(...) {
  deparse_dots(...)
}

Now of course in the real select() function, select() takes both data (passed to .data) and column names (passed to ...) as inputs and then returns a subset of the data object containing only those columns. In our temporary function, we are just interested in the evaluation of the column names. So let’s try it out.

dummy_select(x, y)
# [1] "x" "y"

Here we passed two objects, x and y which are intended to represent our column names. These objects are in fact symbols which we would expect to be evaluated, but they weren’t; they are instead turned into character strings. This is thanks to the deparse() and substitute() combination. deparse_dots() first uses substitute() to return the unevaluated expression (in our case ...()) and substitutes any variables bound in the environment (here x and y). deparse_dots() then loops over each of these inputs and deparses them. From the help page, ?deparse:

Turn unevaluated expressions into character strings.

So now we have our function column inputs as character strings. This is a good start as we can now match on those character strings with the column names of our data (match(deparse_dots(...), colnames(.data))) to get the integer column positions of x and y. But what if the user inputs, for example, an integer?

dummy_select(1, 3, 5)
# [1] "1" "3" "5"

This now poses a problem. Does the user here mean that they want the first, third and fifth columns returned? Or do they mean that there are columns within their data.frame called “1”, “3” and “5” - which aren’t necessarily in the first, third and fifth positions - and those are the columns they would like? So the problem with this approach is that when everything is converted to characters, it is almost impossible to know whether the user input to the function is a column name, a column integer position or a function like a select helper, with any degree of certainty. The function has to try() certain things by making certain assumptions and of course making an assumption makes…well, you’ve heard the saying.

The Selectificator 2000

This is where the upgrades to the poorman::select() function come in. As a user I want to be able to pass integers, numerics, character strings, symbols and even functions to be interpreted by the select() function correctly and return the columns I desire. This is where the next line of code - which is absolutely brilliant - comes in.

eval(substitute(alist(...)))

Let’s break this function down and see what it does. We will work with a function and build it up bit by bit.

dummy_select <- function(...) {
  alist(...)
}
dummy_select(x, y)
# [[1]]
# ...

Ok, not so exciting, right? What about if we wrap this in substitute?

dummy_select <- function(...) {
  substitute(alist(...))
}
dummy_select(x, y)
# alist(x, y)

Now we can see that we have managed to pass in our inputs but they seem to be wrapped in an unevaluated call to alist(), so let’s try and evaluate it.

dummy_select <- function(...) {
  eval(substitute(alist(...)))
}
dummy_select(x, y)
# [[1]]
# x
# 
# [[2]]
# y

Perfect! Now we have our unevaluated function inputs stored in a list. But what is so great about that? Well, let’s take a look at the structure of this output.

str(dummy_select(x, y))
# List of 2
#  $ : symbol x
#  $ : symbol y

So we can see that our inputs have been stored as their appropriate class; symbols! As a matter of fact, this occurs no matter what we use as our inputs.

str(dummy_select(1L, 2, "x", y, starts_with("R")))
# List of 5
#  $ : int 1
#  $ : num 2
#  $ : chr "x"
#  $ : symbol y
#  $ : language starts_with("R")

This is fantastic. What this means is that we can now define functionality that can handle each of the separate types we typically expect being used in a call to select(). All of this magic is owed to the alist() function, let’s take a look at the documentation.

alist handles its arguments as if they described function arguments. So the values are not evaluated, and tagged arguments with no value are allowed whereas list simply ignores them.

So if we had used the list() function, it would have attempted to evaluate our inputs to the dummy_select() function whereas alist() does not - it stores them as unevaluated objects.

Now, this starts to get really interesting when we start to take a look at the language inputs. When using dplyr::select(), the user is able to select columns in a number of ways. Let’s take a look at some of them and what the structure of those look like.

str(dummy_select(!w, x:y, -z))
# List of 3
#  $ : language !w
#  $ : language x:y
#  $ : language -z

So selecting columns through the use of an exclamation mark (negation), a colon or a minus sign actually gives us a language object. Ok, so what? What is so special about this? Well what makes this so useful to us is how we can interact with the objects. We can actually access parts of the language object, much in the same way we do with a list(). Let’s take a look.

obj <- dummy_select(x:y)
obj[[1]][1]
# `:`()

So operators are actually functions. In fact, in R, everything is an object and we interact with those objects using functions, so this makes sense. Let’s look a bit deeper into this object.

obj[[1]][[1]]
# `:`
obj[[1]][[2]]
# x
obj[[1]][[3]]
# y

So our function input, x:y, can be broken down into it’s individual components. We know that the components are made up of the colon function as well as x and y, but what is the structure of these final two components?

str(obj[[1]][[2]])
#  symbol x
str(obj[[1]][[3]])
#  symbol y

They are symbols! So now we can handle these much in the same way as we did with the symbol inputs in the first instance, because remember, just passing x or y to our dummy_select() function returned a symbol.

str(dummy_select(x, y))
# List of 2
#  $ : symbol x
#  $ : symbol y

So there you have it! This is how you, as the user, are now able to perform select() calls with {poorman} like this:

library(poorman, warn.conflicts = FALSE)
mtcars %>%
  select(drat, mpg:hp, starts_with("g"), everything()) %>%
  head()
#                   drat  mpg cyl disp  hp gear    wt  qsec vs am carb
# Mazda RX4         3.90 21.0   6  160 110    4 2.620 16.46  0  1    4
# Mazda RX4 Wag     3.90 21.0   6  160 110    4 2.875 17.02  0  1    4
# Datsun 710        3.85 22.8   4  108  93    4 2.320 18.61  1  1    1
# Hornet 4 Drive    3.08 21.4   6  258 110    3 3.215 19.44  1  0    1
# Hornet Sportabout 3.15 18.7   8  360 175    3 3.440 17.02  0  0    2
# Valiant           2.76 18.1   6  225 105    3 3.460 20.22  1  0    1

Conclusion

This post has taken a look at two separate non-standard evaluation approaches - using nothing but {base} - deployed within the {poorman} package. We have seen how to break down language objects to pick out key pieces of information from them. We also saw how to determine the object types of function inputs and why this is important to consider. In particular, this showed how I was able to transform the select() function into the omega selectificator function…of doom.

If you’d like to show your support for {poorman}, please consider giving the package a Star on Github as it gives me that boost of dopamine needed to continue development.

poorman: Select helpers, bug fixes and tests, tests, tests!

Mon, 13 Apr 2020 20:12:00 -0500

Introduction

Hello all and welcome to another edition of the poorman series of blog posts. In this series I am discussing my progress in writing a base R equivalent of dplyr. What’s nice about this series is that if you’re not into poorman and would prefer just to use dplyr, then that’s absolutely OK! By highlighting poorman functionality, this series of blog posts simultaneously highlights dplyr functionality too!

Today I want to showcase some column selection helper features from the tidyselect package - often used in conjunction with dplyr - which I have finished now replicated within poorman, of course using base only. I’ll also discuss a little bit about what is happening in the background of poorman’s development with regards to testing.

Select Helpers

The first official release version of poorman (v 0.1.9) was the first version that I considered to contain all of the “core” functionality of dplyr; everything from select() to group_by() and summarise(). Now that that functionality is nailed down, it gives me time to focus of some of the smaller features of dplyr and the wider tidyverse and so over the last couple of weeks I have been working on adding the tidyselect::select_helpers to poorman. For those that are unaware, select_helpers are a collection of functions that help the user to select variables based on their names. For example you may wish to select all columns which start with a certain prefix or maybe select columns matching a particular regular expression. Let’s take a look at some examples.

Selecting Columns Based On Partial Column Names

If your data contain lots of columns whose names share a similar structure, you can use partial matching by adding starts_with(), ends_with() or contains() in your select()/relocate() statement.

library(poorman, warn.conflicts = FALSE)
iris %>% select(starts_with("Petal"), ends_with("Width")) %>% head()
#   Petal.Length Petal.Width Sepal.Width
# 1          1.4         0.2         3.5
# 2          1.4         0.2         3.0
# 3          1.3         0.2         3.2
# 4          1.5         0.2         3.1
# 5          1.4         0.2         3.6
# 6          1.7         0.4         3.9

Reordering Columns

The columns of the iris dataset come in the following order.

colnames(iris)
# [1] "Sepal.Length" "Sepal.Width"  "Petal.Length" "Petal.Width"  "Species"

But what if we wanted all of the “Width” columns at the start of this data.frame? There are a couple of ways in which we can achieve this. Firstly, we can use select() in combination with the select helper everything().

iris %>% select("Petal.Width", "Sepal.Width", everything()) %>% head()
#   Petal.Width Sepal.Width Sepal.Length Petal.Length Species
# 1         0.2         3.5          5.1          1.4  setosa
# 2         0.2         3.0          4.9          1.4  setosa
# 3         0.2         3.2          4.7          1.3  setosa
# 4         0.2         3.1          4.6          1.5  setosa
# 5         0.2         3.6          5.0          1.4  setosa
# 6         0.4         3.9          5.4          1.7  setosa

poorman here first selects the columns “Petal.Width” and “Sepal.Width” before selecting everything else. This is great, but if your data contain a lot of columns containing “Width” then you will have to write out a lot of column names. Well this is where we can use relocate() and the select helper contains() to move those columns to the start of iris.

iris %>% relocate(contains("Width")) %>% head()
#   Sepal.Width Petal.Width Sepal.Length Petal.Length Species
# 1         3.5         0.2          5.1          1.4  setosa
# 2         3.0         0.2          4.9          1.4  setosa
# 3         3.2         0.2          4.7          1.3  setosa
# 4         3.1         0.2          4.6          1.5  setosa
# 5         3.6         0.2          5.0          1.4  setosa
# 6         3.9         0.4          5.4          1.7  setosa

By default, relocate() will move all selected columns to the start of the data.frame. You can adjust this behaviour with the .before and .after parameters. Let’s move the “Petal” columns to appear after the “Species” column.

iris %>% relocate(contains("Petal"), .after = Species) %>% head()
#   Sepal.Length Sepal.Width Species Petal.Length Petal.Width
# 1          5.1         3.5  setosa          1.4         0.2
# 2          4.9         3.0  setosa          1.4         0.2
# 3          4.7         3.2  setosa          1.3         0.2
# 4          4.6         3.1  setosa          1.5         0.2
# 5          5.0         3.6  setosa          1.4         0.2
# 6          5.4         3.9  setosa          1.7         0.4

Select Columns Using a Regular Expression

The previous helper functions work with exact pattern matches. Let’s say you have similar patterns within your column names that are not quite the same, you can use regular expressions with the matches() helper function to identify them. Here I will use the mtcars dataset and look to extract all columns which start with a “w” or a “d” and end with a “t”.

mtcars %>% select(matches("^[wd].*[t]$")) %>% head()
#                   drat    wt
# Mazda RX4         3.90 2.620
# Mazda RX4 Wag     3.90 2.875
# Datsun 710        3.85 2.320
# Hornet 4 Drive    3.08 3.215
# Hornet Sportabout 3.15 3.440
# Valiant           2.76 3.460

The Select Helper List

We have seen a few examples of select helpers now available in poorman. There are more, however, and the following list details each of them. Remember that these functions can be used to help users select() and relocate() columns within data.frames.

starts_with(): Starts with a prefix.
ends_with(): Ends with a suffix.
contains(): Contains a literal string.
matches(): Matches a regular expression.
num_range(): Matches a numerical range like x01, x02, x03.
all_of(): Matches variable names in a character vector. All names must be present, otherwise an out-of-bounds error is thrown.
any_of(): Same as all_of(), except that no error is thrown for names that don’t exist.
everything(): Matches all variables.
last_col(): Select last variable, possibly with an offset.

Docker

There was a request on Twitter to put together a Docker image for poorman. This has now been done and can be seen on Dockerhub. This means if you have Docker installed, you can run a containerised version of poorman easily with the following line of code.

docker run --rm -it nathaneastwood/poorman

Test, Test, Test!

Since the last release of poorman (v 0.1.9) to CRAN, I have been working on a few bugs that I and other users of the package had identified. I’m happy to say that these have now been squashed and the issues list is looking very empty. As a brief overview, the following problems are now fixed:

mutate() column creations are immediately available, e.g. mtcars %>% mutate(mpg2 = mpg * 2, mpg4 = mpg2 * 2) will create columns named mpg2 and mpg4
group_by() groups now persist in selections, e.g. mtcars %>% group_by(am) %>% select(mpg) will return am and mpg columns
slice() now duplicates rows, e.g. mtcars %>% slice(2, 2, 2) will return row 2 three times
summarize() is now exported

dplyr is a very well known and extremely well developed package. In order for poorman to have any credibility, it needs to work correctly. Therefore a large amount of effort and energy has gone into testing poorman to ensure it produces the results one would expect. Since adding all of the new features and bug fixes described in this blog, poorman has surpassed 100 tests!

tinytest::test_all()                                    
# Running test_arrange.R................    5 tests OK
# Running test_filter.R.................    6 tests OK
# Running test_groups.R.................    5 tests OK
# Running test_joins_filter.R...........    4 tests OK
# Running test_joins.R..................    7 tests OK
# Running test_mutate.R.................    6 tests OK
# Running test_pull.R...................    6 tests OK
# Running test_relocate.R...............    6 tests OK
# Running test_rename.R.................    4 tests OK
# Running test_rownames.R...............    2 tests OK
# Running test_select_helpers.R.........   25 tests OK
# Running test_select.R.................   13 tests OK
# Running test_slice.R..................    5 tests OK
# Running test_summarise.R..............    6 tests OK
# Running test_transmute.R..............    3 tests OK
# Running test_utils.R..................    1 tests OK
# [1] "All ok, 104 results"

This also means that the package coverage is extremely high.

covr::package_coverage()                                                                                        #
# poorman Coverage: 97.87%
# R/utils.R: 80.00%
# R/group.R: 90.91%
# R/joins.R: 92.86%
# R/arrange.R: 100.00%
# R/filter.R: 100.00%
# R/init.R: 100.00%
# R/joins_filtering.R: 100.00%
# R/mutate.R: 100.00%
# R/pipe.R: 100.00%
# R/pull.R: 100.00%
# R/relocate.R: 100.00%
# R/rename.R: 100.00%
# R/rownames.R: 100.00%
# R/select_helpers.R: 100.00%
# R/select.R: 100.00%
# R/slice.R: 100.00%
# R/summarise.R: 100.00%
# R/transmute.R: 100.00%

I hope this gives users of poorman that extra confidence when using the package. I have now submitted this updated version of poorman to CRAN and I am just waiting on their feedback so hopefully in the coming days it will be available. Watch this space!

poorman: First Release of a base R dplyr Clone

Wed, 01 Apr 2020 20:12:00 -0500

Introduction

The first official release of poorman (v 0.1.9) is now on CRAN! You can now install poorman directly from CRAN with the following code:

install.packages("poorman")

In this blog post I want to address some common questions that I have received since I started writing the package.

What is `poorman`?

poorman is a package that unapologetically attempts to recreate the dplyr API in a dependency free way using only base R. poorman is still under development and doesn’t have all of dplyr’s functionality but what I would consider the “core” functionality is included. The idea behind poorman is that a user should be able to take their dplyr based script and run it using poorman without any hiccups.

So what does `poorman` include?

In this first official release, poorman includes copies of the key dplyr functions.

select(), rename(), pull(), relocate(), mutate(), transmute(), arrange()
filter(), slice()
summarise() / summarize()
group_by(), ungroup()

poorman also includes the join functionality.

inner_join(), left_join(), right_join(), full_join()
anti_join(), semi_join()

Finally poorman also includes its own version of the pipe so you do not need to load or install magrittr.

%>%

More functionality is being developed and will be added in time.

Why develop `poorman`?

This is probably the most common question; why bother developing poorman when dplyr already exists. Well there are actually several reasons why I decided to develop it. The most important reason to me though is quite simply because I can. poorman started out as a personal challenge and a bit of fun. Also as a freelance R developer, it is good to build up my portfolio of open source code that I can show to potential clients.

Another reason for developing poorman is I wanted to challenge a common misconception that base R is not as powerful, or as good, or as useful as dplyr. Too often I see and hear comments belittling base R and as a user of the language for over 10 years now - well before the inception of dplyr - I find this idea very worrying. poorman’s package start up message is quite poignant in this regard.

I’d seen my father. He was a poor man, and I watched him do astonishing things. - Sidney Poitier

Finally, I have a natural joy of teaching. Writing poorman gives me a platform to hopefully show useRs two key aspects of R programming in base; common data manipulation tasks; and non-standard evaulation.

But why not just use `dplyr`?

Let’s be honest, the tidyverse is a fantastic set of packages which have transformed the face of data analysis in R, and dplyr is arguably one of the most important packages within the tidyverse. The API is in my opinion very easy to learn and use.

Being a part of the tidyverse, however, means that dplyr comes with a large number of dependencies that users must also install which is often seen as a disadvantage to using the tidyverse. Disadvantages of dependencies have been written about before and so I won’t go into detail here. However what I will say is that the user may not have a need for additional parts of the tidyverse and so may not wish to have to install multiple packages to use one or two functions.

Some of these dependencies are very useful of course, allowing expansion into other areas such as accessing Spark instances and databases using the same API the user already knows. This is great and if you are using these additional tools then I absolutely recommend that you choose dplyr over poorman. However if you don’t need the extra dependencies and functionality that comes with the wider tidyverse then maybe consider giving the lightweight poorman a go.

Finally a point on installation times, poorman takes roughly six seconds to install. If you’ve ever had to install or upgrade dplyr or the tidyverse, you’ll recognise that this is very fast.

Why the name `poorman`?

As I have already mentioned, I have seen comments in the past pertaining to R’s worthlessness without the tidyverse and so the name poorman is a subtle play on the the idea that you must be a “poor man” if you use base. The irony of course is that I have managed to recreate - quite easily - the key parts of the dplyr API using only base R.

Why not use `data.table` for the backend?

Because I wanted to build something that was completely dependency free and adding data.table as an Import adds a dependency.

But doesn’t `poorman` have dependencies?

To answer this, we need to define what we mean by “dependency free”. poorman does have some dependencies but they are for development purposes only and are therefore listed in the Suggests part of the DESCRIPTION file. Thus when a user installs the package, these dependencies are only ever installed if they are explicitly requested. However, poorman doesn’t have any dependencies that users of the package need to install in order to use its functionality. I use these dependency packages to help me develop more easily. Therefore poorman isn’t a truly “dependency free” like data.table is, but it is dependency free for its intended users.

Conclusion

So if you find yourself needing a dependency free data manipulation package that follows the dplyr API with short installation times then give poorman a try. Equally if you find any issues, please submit an issue to GitHub.

poorman: Replicating dplyr's Join and Filter Join Functions with base R

Sun, 08 Mar 2020 20:12:00 -0500

Introduction

In my last post I discussed performing split-apply-combine operations on R data.frames and how this functionality was used within poorman - a base R replica of dplyr. In this post I’d like to talk about replicating dplyr’s join and filter join functionality, again using nothing but base.

Joins

First of all, let’s set up some data to use for our examples. Here I create two data.frames; one containing heights associated with names and IDs; the second containing weights also associated with some names and IDs. Some of these ID and name combinations are common to both tables (e.g. c("id" = 5, "name" = "C")) but other IDs are unique to one table or the other (e.g. c("id" = 1, "name" = "A")).

Note that sometimes a list of elements (here name and ID) are somtimes referred to as a tuple.

table1 <- data.frame(
  id = c(1, 3, 5, 7, 9),
  name = LETTERS[1:5],
  height = c(1, 2, 2, 2, 2),
  stringsAsFactors = FALSE
)
table1
#   id name height
# 1  1    A      1
# 2  3    B      2
# 3  5    C      2
# 4  7    D      2
# 5  9    E      2
table2 <- data.frame(
  id = c(2, 4, 5, 7),
  name = LETTERS[1:4],
  weight = c(2, 3, 4, 5),
  stringsAsFactors = FALSE
)
table2
#   id name weight
# 1  2    A      2
# 2  4    B      3
# 3  5    C      4
# 4  7    D      5

When working with data such as this, we may wish to join these two tables together such that we can more easily use data from both. In base, the function we use for joining tables together is called merge(). We will see how we can use this one function to perform inner, left, right and full joins.

Inner Join

An inner join selects records that have matching values in both tables within the columns we are joining by, returning all columns. For table1 and table2, we will be joining the tables by "id" and "name" since these are the common columns between both tables.

Note that depending on your circumstance you may not wish to join on all common columns. For example you may have two tables that have columns with the same name but actually contain different data.

When we perform the inner join therefore, we will expect a data.frame containing the records c("id" = 5, "name" = "C") and c("id" = 7, "name" = "D") since these records exist in both tables.

To perform an inner join, we use the merge() function with no additional parameters, giving the two tables to merge.

merge(x = table1, y = table2)
#   id name height weight
# 1  5    C      2      4
# 2  7    D      2      5

When performing a join, we typically specify which columns we would like to join on. merge() is helpful in that it works out the common columns between the datasets with the following command.

by <- intersect(names(table1), names(table2))
by
# [1] "id"   "name"

If we wanted, we could pass the column names explicitly.

merge(x = table1, y = table2, by = c("id", "name"))
#   id name height weight
# 1  5    C      2      4
# 2  7    D      2      5

In poorman, we can use the inner_join() function to perform this type of join.

table1 %>% inner_join(table2)
# Joining, by = c("id", "name")
#   id name height weight
# 1  5    C      2      4
# 2  7    D      2      5

Left Join

A left join will include all rows from table1 regardless of whether or not there is a matching record in table2. For those records which do not have a match, the left join will leave the cells as NA values. In base, we perform this type of join with the merge() function, specifying all.x = TRUE.

merge(x = table1, y = table2, all.x = TRUE)
#   id name height weight
# 1  1    A      1     NA
# 2  3    B      2     NA
# 3  5    C      2      4
# 4  7    D      2      5
# 5  9    E      2     NA

In poorman, this type of join can be performed with left_join().

table1 %>% left_join(table2)
# Joining, by = c("id", "name")
#   id name height weight
# 1  1    A      1     NA
# 2  3    B      2     NA
# 3  5    C      2      4
# 4  7    D      2      5
# 5  9    E      2     NA

Right Join

A right join is the opposite of a left join. Here, the merge() function returns all rows from table2 and the matched rows from table1; again filling any blank cells with NA. This time, we specify all.y = TRUE.

merge(x = table1, y = table2, all.y = TRUE)
#   id name height weight
# 1  2    A     NA      2
# 2  4    B     NA      3
# 3  5    C      2      4
# 4  7    D      2      5

In poorman, this type of join can be performed with, you guessed it, right_join().

table1 %>% right_join(table2)
# Joining, by = c("id", "name")
#   id name height weight
# 1  2    A     NA      2
# 2  4    B     NA      3
# 3  5    C      2      4
# 4  7    D      2      5

Full Join

A full join will join together all rows from two tables. Like the left and right joins, any rows that do not contain a match will contain NA in the cells that are missing. Here we specify all = TRUE within merge() to represent a full join.

merge(x = table1, y = table2, all = TRUE)
#   id name height weight
# 1  1    A      1     NA
# 2  2    A     NA      2
# 3  3    B      2     NA
# 4  4    B     NA      3
# 5  5    C      2      4
# 6  7    D      2      5
# 7  9    E      2     NA

Finally poorman provides full_join() to do this type of join.

table1 %>% full_join(table2)
# Joining, by = c("id", "name")
#   id name height weight
# 1  1    A      1     NA
# 2  2    A     NA      2
# 3  3    B      2     NA
# 4  4    B     NA      3
# 5  5    C      2      4
# 6  7    D      2      5
# 7  9    E      2     NA

Filter Joins

For filter joins we will look at some slightly different data.

table1 <- data.frame(
  pupil = rep(1:3, each = 2),
  test = rep(c("A", "B"), 3),
  score = c(60, 70, 65, 80, 85, 70),
  stringsAsFactors = FALSE
)
table1
#   pupil test score
# 1     1    A    60
# 2     1    B    70
# 3     2    A    65
# 4     2    B    80
# 5     3    A    85
# 6     3    B    70
table2 <- table1[c(1, 3, 4), ]
table2
#   pupil test score
# 1     1    A    60
# 3     2    A    65
# 4     2    B    80

Semi-Join

A semi-join is slightly different to the other types of joins we have seen thus far. We describe a semi-join as a “filter join”, since a semi-join returns the rows in table1 where the join column tuples in table1 are also found in table2. So we still specify the column names that we wish to “join” by (in this example it’s c("pupil", "test")), which is why this is considered a join but we are actually performing a sort of filter on table1.

by <- c("pupil", "test")

Since we are looking for the rows in table1 that are also in table2, we will be using [.data.frame to filter table1 by the matching rows. To do this, we will take advantage of base::interaction().

interaction(table1[, by])
# [1] 1.A 1.B 2.A 2.B 3.A 3.B
# Levels: 1.A 2.A 3.A 1.B 2.B 3.B

As you can see, what this function does is compute a vector of factor levels which represents the interaction of the given columns. So the number before the . is the pupil and the letter after the . is the test they took. If we do this for both tables, we can figure out which levels are %in% both tables. As we can see below, the results of %in% returns a logical vector that we can use to filter table1.

interaction(table2[, by])
# [1] 1.A 2.A 2.B
# Levels: 1.A 2.A 1.B 2.B
rows <- interaction(table1[, by]) %in% interaction(table2[, by])
rows
# [1]  TRUE FALSE  TRUE  TRUE FALSE FALSE

So here we can see that levels 1.A, 2.A and 2.B appear in both table1 and table2. So now we can perform our filter.

table1[rows, ]
#   pupil test score
# 1     1    A    60
# 3     2    A    65
# 4     2    B    80

Semi-join functionality is afforded by poorman using the semi_join() function.

table1 %>% semi_join(table2)
# Joining, by = c("pupil", "test", "score")
#   pupil test score
# 1     1    A    60
# 2     2    A    65
# 3     2    B    80

Anti-Join

An anti-join is slightly different to a semi-join in that it returns all the rows from table1 that do not appear in table2 when “joining” on the join columns. Using our previously defined rows variable, we can take the inverse of this logical vector using !.

rows <- !rows
rows
# [1] FALSE  TRUE FALSE FALSE  TRUE  TRUE
table1[rows, ]
#   pupil test score
# 2     1    B    70
# 5     3    A    85
# 6     3    B    70

poorman provides a copy of anti-join functionality using anti_join().

table1 %>% anti_join(table2)
# Joining, by = c("pupil", "test", "score")
#   pupil test score
# 1     1    B    70
# 2     3    A    85
# 3     3    B    70

Conclusion

As we can see, the join and filter join functionality provided by dplyr is also available in base, you just need to know the parameter details or how to perform the filters efficiently. For your convenience, these functions are now available in poorman using the same dplyr API: inner_join(), left_join(), right_join(), full_join(), semi_join() and anti_join(). See poorman::joins or ?poorman::filter_joins for more details.

Building A base dplyr With Primitives: Grouped Operations, Pipes and More!

Thu, 27 Feb 2020 20:12:00 -0500

Introduction

In my last post we looked at how we can recreate base equivalents of the dplyr functions select(), filter(), mutate() and arrange(), amongst others. I wrote these functions and presented them in a new package called poorman. In this post I will be discussing new functionality that I have since added to poorman including grouped operations, renaming columns, summarising data and even poorman’s very own pipe operator!

Group By

The `base` Way

Typically in the past when I have performed grouped operations using base I have used the tried and tested split-apply-combine approach. That is, I split the data.frame on a grouping variable, I apply a function and then I combine the parts back together. Let’s take a look at what I mean using the mtcars dataset by splitting the data into groups representing each combination of transmission type and number of cylinders (see ?datasets::mtcars for more details about this dataset).

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

Note that here I unname() the list of data.frames to avoid rbind() prepending the row names with the group information. This is a really nice, flexible way to perform grouped operations using base. There are in fact many other ways that this type of operation can be achieved; the flexibility of base is what makes it so great.

The `poorman` Way

poorman aims to be a direct replacement for dplyr, the idea being that loading poorman and running your script written with dplyr code should return the same results. Therefore if you’re familiar with the dplyr API then the next piece of code should look very familiar.

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

In order to achieve this, I need to have a way to perform grouped operations for functions such as mutate() and filter(). The easiest solution I could think of therefore is an S3 class system. So the group_by() function simply applies a "grouped_data" class to the data and then the mutate() S3 generic knows to dispatch to the mutate.grouped_data() method. For more information on the S3 class system I recommend checking out Advanced R.

Ungrouping

poorman also offers a replica of the dplyr::ungroup() function. Let’s take a look.

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

We see here that the printing method tells us the remaining group: cyl.

Additional Functionality

The Pipe

You will have noticed that I am piping commands together in the above section, however I am not using the magrittr pipe. I implemented my own version which is a very small piece of code. This means users no longer need to load magrittr separately (previously poorman only had magrittr as a suggested package so as not to force the installation on users).

`%>%` <- function(lhs, rhs) {
  lhs <- substitute(lhs)
  rhs <- substitute(rhs)
  eval(as.call(c(rhs[[1L]], lhs, as.list(rhs[-1L]))), envir = parent.frame())
}

Rename

I also managed to add rename(). For this I took advantage of colnames<- in combination with the inset() function I defined in my last post ([<-). I don’t want to make this post too heavy on the code so feel free to take a look at the code yourself to see how exactly I achieved this.

Now I am able to pass key-value pairs of unquoted column names to rename columns. See below for an example.

mtcars %>%
  rename(MPG = mpg, numCyls = cyl)
#                      MPG numCyls  disp  hp drat    wt  qsec vs am gear carb
# 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
# Datsun 710          22.8       4 108.0  93 3.85 2.320 18.61  1  1    4    1
# Hornet 4 Drive      21.4       6 258.0 110 3.08 3.215 19.44  1  0    3    1
# Hornet Sportabout   18.7       8 360.0 175 3.15 3.440 17.02  0  0    3    2
# Valiant             18.1       6 225.0 105 2.76 3.460 20.22  1  0    3    1
# Duster 360          14.3       8 360.0 245 3.21 3.570 15.84  0  0    3    4
# 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
# 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
# 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
# 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
# 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
# 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
# Camaro Z28          13.3       8 350.0 245 3.73 3.840 15.41  0  0    3    4
# Pontiac Firebird    19.2       8 400.0 175 3.08 3.845 17.05  0  0    3    2
# 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
# Ford Pantera L      15.8       8 351.0 264 4.22 3.170 14.50  0  1    5    4
# Ferrari Dino        19.7       6 145.0 175 3.62 2.770 15.50  0  1    5    6
# Maserati Bora       15.0       8 301.0 335 3.54 3.570 14.60  0  1    5    8
# Volvo 142E          21.4       4 121.0 109 4.11 2.780 18.60  1  1    4    2

Using this function, I was able to implement key-value select() statements too!

mtcars %>%
  select(MPG = mpg, numCyls = cyl, numGears = gear)
#                      MPG numCyls numGears
# Mazda RX4           21.0       6        4
# Mazda RX4 Wag       21.0       6        4
# Datsun 710          22.8       4        4
# Hornet 4 Drive      21.4       6        3
# Hornet Sportabout   18.7       8        3
# Valiant             18.1       6        3
# Duster 360          14.3       8        3
# Merc 240D           24.4       4        4
# Merc 230            22.8       4        4
# Merc 280            19.2       6        4
# Merc 280C           17.8       6        4
# Merc 450SE          16.4       8        3
# Merc 450SL          17.3       8        3
# Merc 450SLC         15.2       8        3
# Cadillac Fleetwood  10.4       8        3
# Lincoln Continental 10.4       8        3
# Chrysler Imperial   14.7       8        3
# Fiat 128            32.4       4        4
# Honda Civic         30.4       4        4
# Toyota Corolla      33.9       4        4
# Toyota Corona       21.5       4        3
# Dodge Challenger    15.5       8        3
# AMC Javelin         15.2       8        3
# Camaro Z28          13.3       8        3
# Pontiac Firebird    19.2       8        3
# Fiat X1-9           27.3       4        4
# Porsche 914-2       26.0       4        5
# Lotus Europa        30.4       4        5
# Ford Pantera L      15.8       8        5
# Ferrari Dino        19.7       6        5
# Maserati Bora       15.0       8        5
# Volvo 142E          21.4       4        4

Summary

Finally I have added a copy of the summarise() function. This was probably the trickiest piece of code to write for the package and I am not completely satisfied with my solution although it works and is seemingly quite quick (on my 2016 MacBook Pro). If you’re interested in taking a look at the implementation and making suggestions then the code can be found here.

mtcars %>%
  group_by(am, cyl) %>%
  summarise(meanMpg = mean(mpg), sumDisp = sum(disp))
#   am cyl  meanMpg sumDisp
# 1  0   4     22.9   407.6
# 2  1   4   28.075   748.9
# 3  0   6   19.125   818.2
# 4  1   6 20.56667     465
# 5  0   8    15.05  4291.4
# 6  1   8     15.4     652

Recently there was a very interesting Twitter discussion on this topic which led to an comprehensive list of examples for performing this operation in base.

How would you write this in base R?

mtcars %>%
group_by(cyl) %>%
summarise(mean = mean(disp), n = n())

I've written up three approaches in https://t.co/BBnXSDSf67. Is there a better way? #rstats
— Hadley Wickham (@hadleywickham) February 22, 2020

Conclusion

I believe that poorman now offers the core of what dplyr has to offer using only base, therefore zero dependencies (not including development based dependencies such as roxygen2). I now need to really start writing some serious tests which I will endeavour to do using tinytest before adding any additional functionality. Without tests, any package is rather worthless in my opinion. If there is functionality you would like to see added to the package then please feel free to submit an issue or open a pull request.

Including Function Factories in an R Package: Using Collate

Tue, 25 Feb 2020 20:12:00 -0500

Introduction

This week I was working on a package which included a function factory. A function factory is a function which returns a function. The problem I faced was that when I was running R CMD check on my package, the check informed me my package had several issues which on first glance were confusing and seemingly shouldn’t have been reported. In this blog post, we’ll discover why.

Function Factory Example

Let’s write a function factory, here I shamelessly use the example from Advanced R. We will use a function factory called power1() to create two additional functions square() and cube().

power1 <- function(exp) {
  function(x) {
    x ^ exp
  }
}

square <- power1(2)
cube <- power1(3)

By assigning power1(2) to the object square, we have created a new function, square(), which when given a value for x will return the result of x to the power of two. Similarly the cube() function will return the result of x to the power of three. Let’s see this in action.

square(3)
# [1] 9
cube(3)
# [1] 27

To understand more about function factories, I strongly recommend reading the Advanced R chapter on function factories.

Could Not Find Function “power1”

I was working on a package which contained my function factory in file A and multiple “child” functions, which were generated by that function, in file B. Everything seemed to be working fine; locally I could install the package and the R CMD check ran without any ERRORs, WARNINGs or NOTEs. However when I ran the code within my CI/CD pipeline, the R CMD check gave me the following set of messages.

R CMD check results
1 error  | 3 warnings | 2 notes
checking for missing documentation entries ... ERROR
Error: cannot source package code:
could not find function "power1"
Execution halted

checking S3 generic/method consistency ... WARNING
Error: cannot source package code:
could not find function "power1"
Execution halted
See section 'Generic functions and methods' in the 'Writing R
Extensions' manual.

checking replacement functions ... WARNING
Error: cannot source package code:
could not find function "power1"
Execution halted
The argument of a replacement function which corresponds to the right
hand side must be named 'value'.

checking for code/documentation mismatches ... WARNING
Error: cannot source package code:
could not find function "power1"
Execution halted

checking R code for possible problems ... NOTE
Error: cannot source package code:
could not find function "power1"
Execution halted

checking Rd \usage sections ... NOTE
Error: cannot source package code:
could not find function "power1"
Execution halted
The \usage entries for S3 methods should use the \method markup and not
their full name.
See chapter 'Writing R documentation files' in the 'Writing R
Extensions' manual.

This had me really stumped for a while - especially as the messages given by R CMD check were talking about things that were unrelated to my code as I have no S3 methods in my package, my documentation was up to date and the function was definitely there and checked into my git repository. So why then was this not working within my CI/CD pipeline? Finally the penny dropped and I finally realised that it is because when R is checking the package, it must be sourcing square() and cube() before it has sourced power1(). Therefore it cannot assign the output of power1() to square and cube since it doesn’t “exist” at that point.

The Solution

The solution, it turns out, is very straight forward. We must tell R to collate the files in a particular order and we can do this by specifying the order in the Collate: field of the DESCRIPTION file. But even better, as I am using roxygen2, I can use the @include tag to state that one file needs another to work. Therefore as I need to make sure that file power1.R is loaded before square.R and cube.R, I simply include @include power1.R in the other files. roxygen2 takes care of ordering the Collate: field to satisfy these restrictions. As another handy tip, let’s say square() and cube() were defined in a file together which is separate from the power1.R file, we can include the following lines of code at the top of the child function file.

#' @include power1.R`
NULL

And roxygen2 will again take care of the Collate: field for us automatically.

As for why everything worked locally but not in my CI/CD pipeline, I can only assume that as the CI/CD pipeline runs on a different machine, R is using some different method to source and collate the files. So it is better to be safe than sorry and explicitly include the order of the files in the Collate: field.

Conclusion

To conclude, if you plan on including a function factory in your package where the factories’ child functions are in a different file, it is really important that you tell R the order in which it should source these files. You can achieve this simply with roxygen2 by using the @include tag - specifying the function factory file name - within the file(s) of the function(s) generated by the function factory. roxygen2 will then automatically fill and sort the Collate: field within your DESCRIPTION file.

Building A base dplyr With Primitives

Sat, 15 Feb 2020 20:12:00 -0500

Introduction

In one of my latest posts, I discussed the idea of turning base R’s get and set operators ([, [[, [<-, [[<-) into human readable and pipeable functions. It was kindly pointed out in the comments that the get() and set() functions I defined in that blog post are actually exported in the magrittr package as magrittr::extract2() ([[) and magrittr::inset2() ([[<-). In fact, there are a whole host of “alias” functions exported by magrittr, see ?magrittr::extract2 for more. However if we are developing a package, we may not necessarily want to Import: magrittr, we may only want to Suggest it as a package that complements our package. This is especially true when the functions we will be importing are simple aliases of other functions that we can just as easily create ourselves. Now sure, a lot of people already have and use magrittr, in which case they can use it, but not everyone wants it or uses it, so we shouldn’t enforce that dependency on users.

Take for example if we were to create a package that recreates dplyr’s main verbs, select(); filter(); mutate(); and arrange(), using base R only. Think of it as a “poor man’s” dplyr, of course I jest - base is awesome. Oftentimes the main complaint I hear about dplyr is the sheer number of dependencies it has and the installation times that come with that; not to mention APIs have changed a few times over the years. base on the other hand already comes pre-installed with R and the API is extremely stable. The reason people like dplyr, however, is because the API on offer is extremely flexible and easy to understand. This blog post will show how we can recreate these verbs using base R and aliases to R’s operator functions and use them in conjunction with magrittr.

Select

dplyr::select() allows the user to subset the columns of a data.frame and always return a data.frame. Thus to recreate this function we will need the operator for subsetting columns of a data.frame which is [, or more specifically, [.data.frame. Let’s take a look at the arguments for this function.

args(`[.data.frame`)
# function (x, i, j, drop = if (missing(i)) TRUE else length(cols) == 
#     1) 
# NULL

We see that it takes:

x - the data.frame
i - the rows to subset
j - the columns to subset
drop - whether to return a vector if only one column is left

We will define our wrapper for the [ function in the same way that magrittr does.

extract <- `[`

As this is an S3 generic, R will know to dispatch to [.data.frame when it is passed a data.frame. Hence, we can now define a select() function which is similar in functionality to that of dplyr::select(). Note that we tell R that we wish to subset all of the rows in the i position by leaving the argument blank.

select <- function(.data, ...) {
  cols <- vapply(substitute(...()), deparse, NA_character_)
  extract(.data, , cols, drop = FALSE)
}

This function uses a couple of tricks here, so I’ll break them down. To use non-standard evaluation in the same way that dplyr does, that is to pass non-quoted column names, we must deparse them. We loop over the columns passed via ... using a vapply(). The substitute(...()) gives us a list-like object of all the symbols we pass which we can loop over. Using this function, we can now select a single column.

mtcars %>% select(mpg)
#                      mpg
# Mazda RX4           21.0
# Mazda RX4 Wag       21.0
# Datsun 710          22.8
# Hornet 4 Drive      21.4
# Hornet Sportabout   18.7
# Valiant             18.1
# Duster 360          14.3
# Merc 240D           24.4
# Merc 230            22.8
# ... 23 rows omitted

Or multiple columns by passing a vector.

mtcars %>% select(mpg, cyl)
#                      mpg cyl
# Mazda RX4           21.0   6
# Mazda RX4 Wag       21.0   6
# Datsun 710          22.8   4
# Hornet 4 Drive      21.4   6
# Hornet Sportabout   18.7   8
# Valiant             18.1   6
# Duster 360          14.3   8
# Merc 240D           24.4   4
# Merc 230            22.8   4
# ... 23 rows omitted

And of course, this function works without magrittr.

select(mtcars, mpg, cyl)
#                      mpg cyl
# Mazda RX4           21.0   6
# Mazda RX4 Wag       21.0   6
# Datsun 710          22.8   4
# Hornet 4 Drive      21.4   6
# Hornet Sportabout   18.7   8
# Valiant             18.1   6
# Duster 360          14.3   8
# Merc 240D           24.4   4
# Merc 230            22.8   4
# ... 23 rows omitted

For bonus points, we can write an equivalent of dplyr::pull() by setting the drop = TRUE argument and removing the cols parameter since we are only dealing with one column.

pull <- function(.data, var) {
  var <- deparse(substitute(var))
  stopifnot(length(var) == 1)
  extract(.data, , var, drop = TRUE)
}
mtcars %>% pull(mpg)
#  [1] 21.0 21.0 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 17.8 16.4 17.3 15.2 10.4 10.4 14.7
# [18] 32.4 30.4 33.9 21.5 15.5 15.2 13.3 19.2 27.3 26.0 30.4 15.8 19.7 15.0 21.4

Filter

As we saw in the previous section, [.data.frame takes i as an argument which represents the rows to filter. Thus we can use a similar method to that used for select() only in this case, we must build the expressions by which to filter and separate them with an ampersand from which we can parse and evaluate.

filter <- function(.data, ...) {
  conditions <- paste(vapply(substitute(...()), deparse, NA_character_), collapse = " & ")
  extract(.data, with(.data, eval(parse(text = conditions))), )
}
mtcars %>% filter(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
# ... 2 rows omitted
mtcars %>% filter(cyl <= 5 & am > 0)
#                 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
# 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
# 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
mtcars %>% filter(cyl == 4 | cyl == 8)
#                      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
# 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
# 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
# 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
# Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
# ... 16 rows omitted
mtcars %>% filter(!(cyl %in% c(4, 6)), am != 0)
#                 mpg cyl disp  hp drat   wt qsec vs am gear carb
# Ford Pantera L 15.8   8  351 264 4.22 3.17 14.5  0  1    5    4
# Maserati Bora  15.0   8  301 335 3.54 3.57 14.6  0  1    5    8

We can also get a copy of dplyr::slice() really cheaply.

slice <- function(.data, ...) {
  stopifnot(is.numeric(...) || is.integer(...))
  extract(.data, ..., )
}
mtcars %>% slice(1:3)
#                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

Arrange

The final function using the extract() alias that I want to highlight is arrange(). I want to highlight this function because of the required trick with eval.parent() (note there are other ways we could achieve this).

arrange <- function(.data, ...) {
  rows <- eval.parent(substitute(with(.data, order(...))))
  extract(.data, rows, , drop = FALSE)
}

We use eval.parent() instead of eval(), because the eval()/substitute() combo doesn’t play well with nested functions. The eval.parent() trick has been proposed by @MoodyMudskipper as a way to address this problem and allows us to seamlessly use arrange() inside other functions, including magrittr pipes:

mtcars %>% arrange(mpg)
#                      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
# Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
# Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
# Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
# Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
# Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
# 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
# ... 23 rows omitted
mtcars %>% arrange(cyl, mpg)
#                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    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
# Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
# Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
# Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
# Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
# Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
# Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
# ... 23 rows omitted

Thanks go to Artem Sokolov for pointing this out.

Mutate

If we wish to create new columns in our dataset, particularly columns created using existing columns in the data, we must use the [<- operator, specifically, [<-.data.frame.

args(`[<-.data.frame`)
# function (x, i, j, value) 
# NULL

[<-.data.frame takes the arguments:

x - the data
i - the rows to create
j - the columns to create
value - the value to give to the rows/columns

We will assign this operator to inset - the same as magrittr does.

inset <- `[<-`

Here we lapply() over each of the conditions to return a list of vectored results of our expressions. We then use the inset() function to add these vectors as new columns to the data.frame.

mutate <- function(.data, ...) {
  conditions <- vapply(substitute(...()), deparse, NA_character_)
  new_data <- lapply(
    conditions,
    function(x, .data) with(.data, eval(parse(text = x))),
    .data
  )
  inset(.data, , names(conditions), new_data)
}
mtcars %>% mutate(mpg2 = mpg * 2)
#                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb mpg2
# Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4 42.0
# Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4 42.0
# Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1 45.6
# Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1 42.8
# Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2 37.4
# Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1 36.2
# Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4 28.6
# Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2 48.8
# Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2 45.6
# ... 23 rows omitted
mtcars %>% mutate(mpg2 = mpg * 2, cyl2 = cyl * 2)
#                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb mpg2 cyl2
# Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4 42.0   12
# Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4 42.0   12
# Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1 45.6    8
# Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1 42.8   12
# Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2 37.4   16
# Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1 36.2   12
# Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4 28.6   16
# Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2 48.8    8
# Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2 45.6    8
# ... 23 rows omitted

Note that unlike dplyr::mutate(), we cannot create columns based on expressions we pass, for example, the following would not work.

mtcars %>% mutate(mpg2 = mpg * 2, mpg3 = mpg2 * 3)
# Error in eval(parse(text = x)): object 'mpg2' not found

As a bonus, we can combine our mutate() function with extract() to create a copy of dplyr::transmute().

transmute <- function(.data, ...) {
  conditions <- vapply(substitute(...()), deparse, NA_character_)
  mutated <- mutate(.data, ...)
  extract(mutated, names(conditions))
}
mtcars %>% transmute(mpg2 = mpg * 2, cyl2 = cyl * 2)
#                     mpg2 cyl2
# Mazda RX4           42.0   12
# Mazda RX4 Wag       42.0   12
# Datsun 710          45.6    8
# Hornet 4 Drive      42.8   12
# Hornet Sportabout   37.4   16
# Valiant             36.2   12
# Duster 360          28.6   16
# Merc 240D           48.8    8
# Merc 230            45.6    8
# ... 23 rows omitted

Chaining

As a final note, it should be clear that due to the nature of magrittr, your standard chaining of functions will still work.

mtcars %>% 
  filter(cyl == 4) %>%
  select(mpg, cyl, wt, disp)
#                 mpg cyl    wt  disp
# Datsun 710     22.8   4 2.320 108.0
# Merc 240D      24.4   4 3.190 146.7
# Merc 230       22.8   4 3.150 140.8
# Fiat 128       32.4   4 2.200  78.7
# Honda Civic    30.4   4 1.615  75.7
# Toyota Corolla 33.9   4 1.835  71.1
# Toyota Corona  21.5   4 2.465 120.1
# Fiat X1-9      27.3   4 1.935  79.0
# Porsche 914-2  26.0   4 2.140 120.3
# ... 2 rows omitted

Conclusion

The idea behind this blog post was to highlight how we can use more human readable versions of R’s primitive operators to aid in pipeable data manipulation functions. Of course the solutions provided in this blog post are over-engineered and you would probably write them in a different way if you were seriously thinking about releasing them as a package. Also, whilst these functions are available via an import of magrittr, you may not wish to force the user to import magrittr and may wish to keep it as a suggestion instead. This reduces the number of dependencies on your package.

For what it’s worth, I have included all of the above code in a package called poorman on my GitHub account. These functions haven’t been thoroughly tested and there may well be bugs. There are, however, much more detailed and dedicated recreations of dplyr using base R. If you are interested, check out: bplyr (note this package uses rlang) and tbltools.

Primitive Functions List

Sat, 01 Feb 2020 20:13:14 -0500

Ever wondered which R functions are actually passed to internal C code? Well, wonder no more as it turns out there is an unexported named list within the methods package providing instructions for turning builtin and special functions into generic functions. Wrapping this list with names() gives us the list of all R functions which wrap calls to .Primitive().

names(methods:::.BasicFunsList)
#   [1] "$"                    "$<-"                  "["                   
#   [4] "[<-"                  "[["                   "[[<-"                
#   [7] "%*%"                  "xtfrm"                "c"                   
#  [10] "all"                  "any"                  "sum"                 
#  [13] "prod"                 "max"                  "min"                 
#  [16] "range"                "is.matrix"            ">="                  
#  [19] "cosh"                 "cummax"               "dimnames<-"          
#  [22] "as.raw"               "log2"                 "tan"                 
#  [25] "dim"                  "as.logical"           "^"                   
#  [28] "is.finite"            "sinh"                 "log10"               
#  [31] "as.numeric"           "dim<-"                "is.array"            
#  [34] "tanpi"                "gamma"                "atan"                
#  [37] "as.integer"           "Arg"                  "signif"              
#  [40] "cumprod"              "cos"                  "length"              
#  [43] "!="                   "digamma"              "exp"                 
#  [46] "floor"                "acos"                 "seq.int"             
#  [49] "abs"                  "length<-"             "sqrt"                
#  [52] "!"                    "acosh"                "is.nan"              
#  [55] "Re"                   "tanh"                 "names"               
#  [58] "cospi"                "&"                    "anyNA"               
#  [61] "trunc"                "cummin"               "levels<-"            
#  [64] "*"                    "Mod"                  "|"                   
#  [67] "names<-"              "+"                    "log"                 
#  [70] "lgamma"               "as.complex"           "asinh"               
#  [73] "-"                    "sin"                  "/"                   
#  [76] "as.environment"       "<="                   "as.double"           
#  [79] "is.infinite"          "is.numeric"           "rep"                 
#  [82] "round"                "sinpi"                "dimnames"            
#  [85] "asin"                 "as.character"         "%/%"                 
#  [88] "is.na"                "<"                    ">"                   
#  [91] "Im"                   "%%"                   "trigamma"            
#  [94] "=="                   "cumsum"               "atanh"               
#  [97] "sign"                 "ceiling"              "Conj"                
# [100] "as.call"              "log1p"                "expm1"               
# [103] "("                    ":"                    "="                   
# [106] "@"                    "{"                    "~"                   
# [109] "&&"                   ".C"                   "baseenv"             
# [112] "quote"                "<-"                   "is.name"             
# [115] "if"                   "||"                   "attr<-"              
# [118] "untracemem"           ".cache_class"         "substitute"          
# [121] "interactive"          "is.call"              "switch"              
# [124] "function"             "is.single"            "is.null"             
# [127] "is.language"          "is.pairlist"          ".External.graphics"  
# [130] "globalenv"            "class<-"              ".Primitive"          
# [133] "is.logical"           "enc2utf8"             "UseMethod"           
# [136] ".subset"              "proc.time"            "enc2native"          
# [139] "repeat"               "<<-"                  "@<-"                 
# [142] "missing"              "nargs"                "isS4"                
# [145] ".isMethodsDispatchOn" "forceAndCall"         ".primTrace"          
# [148] "storage.mode<-"       ".Call"                "unclass"             
# [151] "gc.time"              ".subset2"             "environment<-"       
# [154] "emptyenv"             "seq_len"              ".External2"          
# [157] "is.symbol"            "class"                "on.exit"             
# [160] "is.raw"               "for"                  "is.complex"          
# [163] "list"                 "invisible"            "is.character"        
# [166] "oldClass<-"           "is.environment"       "attributes"          
# [169] "break"                "return"               "attr"                
# [172] "tracemem"             "next"                 ".Call.graphics"      
# [175] "standardGeneric"      "is.atomic"            "retracemem"          
# [178] "expression"           "is.expression"        "call"                
# [181] "is.object"            "pos.to.env"           "attributes<-"        
# [184] ".primUntrace"         "...length"            ".External"           
# [187] "oldClass"             ".Internal"            ".Fortran"            
# [190] "browser"              "is.double"            "while"               
# [193] "nzchar"               "is.list"              "lazyLoadDBfetch"     
# [196] "...elt"               "is.integer"           "is.function"         
# [199] "is.recursive"         "seq_along"            "unlist"              
# [202] "as.vector"            "lengths"

Get and Set List Elements with magrittr

Sat, 01 Feb 2020 20:00:16 -0500

Introduction

Did you know that the magrittr pipe, %>%, can be used for more than just data.frames and tibbles? In this blog post, we look at how we can create get and set functions for list elements.

Getting List Elements

First, let’s create a simple list.

z1 <- list(a = pi, b = 2.718, c = 0.57721)
z1
# $a
# [1] 3.141593
# 
# $b
# [1] 2.718
# 
# $c
# [1] 0.57721

Let’s say we want to access an element of this list, typically we would use the [[ function to do so.

z1[[2]]
# [1] 2.718

But let’s say we need to access this list as part of a chain using magrittr’s pipe operator, %>%. How can we do that? Well we can pipe our list into a . which acts as a placeholder for the list, on which we can perform our subset.

library(magrittr)
z1 %>% .[[2]]
# [1] 2.718

Another solution is to call [[ using its syntactic form [[() using backticks (or quotes, see ?Quotes).

z1 %>% `[[`(2)
# [1] 2.718

Admittedly, these two solutions don’t look very nice. So what we can do instead is assign the [[ function to an object which will, in effect, be a callable wrapper function.

get <- .Primitive("[[") # Equivalent to get <- `[[`
get(z1, 2)
# [1] 2.718

Primitives are functions that are internally implemented by R and so .Primitive("[[") tells R to dispatch to the underlying C code, which will be able to correctly identify which [[ method to use on the list class (see ?.Primitive for more details).

Since our list is now the first argument of get(), we have a much “cleaner” looking way of accessing elements of a list with the magrittr pipe operator than [[. And so, let’s access the second element of our list using get() and the magrittr pipe.

z1 %>% get(2)
# [1] 2.718

We can also access the list using its names, too.

z1 %>% get("b")
# [1] 2.718

It even works with recursive indexing!

z2 <- list(a = list(b = 9, c = "hello"), d = 1:5)
z2
# $a
# $a$b
# [1] 9
# 
# $a$c
# [1] "hello"
# 
# 
# $d
# [1] 1 2 3 4 5
z2 %>% get(c("a", "c")) # equivalent to z %>% get(c(1, 2))
# [1] "hello"

Note, you may want to choose a better name than get to avoid clashes with the base::get() function.

Setting List Elements

Similarly we can create a set() function to assign values to elements of our list using .Primitive("[[<-"). Let’s add a fourth element to our list.

set <- .Primitive("[[<-")
z1 <- z1 %>% set("d", 4.6692)
z1
# $a
# [1] 3.141593
# 
# $b
# [1] 2.718
# 
# $c
# [1] 0.57721
# 
# $d
# [1] 4.6692

And now just as set() giveth, set() taketh away.

z1 <- z1 %>% set("d", NULL)
z1
# $a
# [1] 3.141593
# 
# $b
# [1] 2.718
# 
# $c
# [1] 0.57721

Of course as this is a list, we can set any kind of data.

z1 %>% set("data", data.frame(a = c(1, 2, 2, 4), b = c(2, 3, 7, 4)))
# $a
# [1] 3.141593
# 
# $b
# [1] 2.718
# 
# $c
# [1] 0.57721
# 
# $data
#   a b
# 1 1 2
# 2 2 3
# 3 2 7
# 4 4 4

Or even overwrite elements.

z1 %>% set("b", 4.6692)
# $a
# [1] 3.141593
# 
# $b
# [1] 4.6692
# 
# $c
# [1] 0.57721

Conclusion

This was just a short blog post to highlight the power of magrittr in combination with R primitives. We also saw how to rewrite and manipulate syntactic forms of internal R functions. What other interesting use cases have you found for the magrittr pipe?

Selecting the Max Value from Each Group, a Case Study: dplyr and sparklyr

Sun, 22 Sep 2019 20:13:14 -0500

Introduction

In my last post we looked at how to slice a data.table by group to obtain the rows for which a particular column in that group is at its maximum value using the excellent data.table package. In this post, we will be taking a look at how to perform this task using dplyr and sparklyr.

dplyr

First, let’s take a look at our data.

library(dplyr)
mtcars <- mtcars %>% 
  tibble::rownames_to_column(var = "car") %>% 
  tibble::as_tibble()
mtcars
# # A tibble: 32 x 12
#    car           mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#    <chr>       <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#  1 Mazda RX4    21       6  160    110  3.9   2.62  16.5     0     1     4     4
#  2 Mazda RX4 …  21       6  160    110  3.9   2.88  17.0     0     1     4     4
#  3 Datsun 710   22.8     4  108     93  3.85  2.32  18.6     1     1     4     1
#  4 Hornet 4 D…  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1
#  5 Hornet Spo…  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2
#  6 Valiant      18.1     6  225    105  2.76  3.46  20.2     1     0     3     1
#  7 Duster 360   14.3     8  360    245  3.21  3.57  15.8     0     0     3     4
#  8 Merc 240D    24.4     4  147.    62  3.69  3.19  20       1     0     4     2
#  9 Merc 230     22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2
# 10 Merc 280     19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4
# # … with 22 more rows

So here, we are interested in getting a single car from each cyl group whose mpg is at the maximum for that group. I really like the dplyr syntax for this problem, it’s really straight forward; take a look below:

mtcars %>% 
  group_by(cyl) %>% 
  arrange(desc(mpg)) %>% 
  slice(1) %>% 
  ungroup()
# # A tibble: 3 x 12
#   car            mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#   <chr>        <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 Toyota Coro…  33.9     4  71.1    65  4.22  1.84  19.9     1     1     4     1
# 2 Hornet 4 Dr…  21.4     6 258     110  3.08  3.22  19.4     1     0     3     1
# 3 Pontiac Fir…  19.2     8 400     175  3.08  3.84  17.0     0     0     3     2

We tell dplyr to create groups of data for each of the cyl levels and then within each group we arrange() by mpg in descending order. Once we have our data organised in this way it’s as simple as taking the top row from each group using slice(). Of course there is more than one way we can achieve this task using dplyr, take this next example for instance.

mtcars %>% 
  group_by(cyl) %>% 
  arrange(desc(mpg)) %>% 
  mutate(row_number = row_number()) %>% 
  filter(row_number == 1) %>% 
  select(-row_number) %>% 
  ungroup()
# # A tibble: 3 x 12
#   car            mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#   <chr>        <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 Toyota Coro…  33.9     4  71.1    65  4.22  1.84  19.9     1     1     4     1
# 2 Hornet 4 Dr…  21.4     6 258     110  3.08  3.22  19.4     1     0     3     1
# 3 Pontiac Fir…  19.2     8 400     175  3.08  3.84  17.0     0     0     3     2

It might not seem to be the most logical approach to this problem given we have access to the slice() function but it feeds nicely into the sparklyr section.

If you are interested, below you can see the benchmarks for these two dplyr approaches. We can see that the slice() approach is much quicker than the mutate() approach which we would expect since there is much less manipulation of the data going on in the first approach.

`sparklyr`

A great feature of dplyr is its ability to execute your R code on a Spark cluster. To achieve this, dplyr uses the dbplyr package which translates your dplyr code into Spark SQL code which can then be passed to the Spark connection to be executed by your Spark cluster. The problem, however, is that not all dplyr verbs translate.

First, let’s set up a local Spark cluster and upload the mtcars data to it.

library(sparklyr)
sc <- spark_connect(master = "local")
mtcars_spark <- copy_to(sc, mtcars, "mtcars")

Now we can explore our first dplyr example by attempting to execute it on the Spark cluster. We use dbplyr::sql_render() as the final part of the chain to try and see the SQL code that dbplyr translates the dplyr code to.

mtcars_spark %>% 
  group_by(cyl) %>% 
  arrange(desc(mpg)) %>% 
  slice(1) %>% 
  ungroup() %>% 
  dbplyr::sql_render()
# Error in slice_.tbl_spark(.data, .dots = compat_as_lazy_dots(...)): Slice is not supported in this version of sparklyr

In this instance, dplyr tells us that we cannot use slice() since it is not currently supported by sparklyr, this is because there is no direct translation from slice() to Spark SQL code. So let’s try our second approach.

mtcars_spark %>% 
  group_by(cyl) %>% 
  arrange(desc(mpg)) %>% 
  mutate(row_number = row_number()) %>% 
  filter(row_number == 1) %>% 
  select(-row_number) %>% 
  ungroup() %>% 
  dbplyr::sql_render()
# <SQL> SELECT `car`, `mpg`, `cyl`, `disp`, `hp`, `drat`, `wt`, `qsec`, `vs`, `am`, `gear`, `carb`
# FROM (SELECT `car`, `mpg`, `cyl`, `disp`, `hp`, `drat`, `wt`, `qsec`, `vs`, `am`, `gear`, `carb`, ROW_NUMBER() OVER (PARTITION BY `cyl` ORDER BY `mpg` DESC) AS `row_number`
# FROM (SELECT *
# FROM `mtcars`
# ORDER BY `mpg` DESC) `dbplyr_001`) `dbplyr_002`
# WHERE (`row_number` = 1.0)

Here we see that the function row_number() does translate; since it is a ranking function which mimics the functions described in SQL2003 (see ?ranking), dbplyr knows the equivalent SQL code.

mtcars_spark %>% 
  group_by(cyl) %>% 
  arrange(desc(mpg)) %>% 
  mutate(row_number = row_number()) %>% 
  filter(row_number == 1) %>% 
  select(-row_number) %>% 
  ungroup() %>% 
  collect()
# # A tibble: 3 x 12
#   car            mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#   <chr>        <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 Hornet 4 Dr…  21.4     6 258     110  3.08  3.22  19.4     1     0     3     1
# 2 Toyota Coro…  33.9     4  71.1    65  4.22  1.84  19.9     1     1     4     1
# 3 Pontiac Fir…  19.2     8 400     175  3.08  3.84  17.0     0     0     3     2

So really when it comes to using dplyr for data manipulation in Spark it sometimes requires some persistence in finding a function which will translate nicely to Spark SQL, especially if you don’t want to use the often slow spark_apply() function to apply an R function to a Spark object. Although I would recommend reading the sparklyr documentation, it can often be a little light on the details and so for a more detailed look at how to send R code to be executed on your Spark cluster, check out my colleague Jozef’s blog post.

As a side note, should you not be able to find an R function which will translate to SQL code, it is always worth checking out the list of Hive Operators and User-Defined Functions (UDFs). UDFs are functions that are built for specific purposes to perform operations like Mathematical, arithmetic, logical and relational on the operands of table column names.

Conclusion

This concludes this series of blog posts in which we have seen how we can select a single row from a data.frame, data.table or tibble for each group, where a column in that group is at the maximum value for its group. In this post, we saw how this task is quite easy to do with dplyr’s group_by() and slice() combination of functions. We then saw how we can translate our dplyr code to be executed as SQL code on a Spark cluster; though not all dplyr “verbs” currently translate into SQL. To that end, it is often worth looking to see if there is a Hive User-Defined Function to perform the data manipulation task at hand if there is not a direct translation of a dplyr function.

Selecting the Max Value from Each Group, a Case Study: data.table

Sat, 14 Sep 2019 19:13:14 -0500

Introduction

In my last post we looked at how to slice a data.frame by group to obtain the rows for which a particular column in that group is at its maximum value using base R. In this post, we will be taking a look at how to perform this task using data.table.

`data.table` Solution(s)

For this exercise we will be using datasets::mtcars and so first, we must convert mtcars to a data.table.

library(data.table)
mtcars <- as.data.table(mtcars, keep.rownames = "car")

The current data.table syntax suggests that when grouping data, we should use the .SD syntax. .SD stands for “Subset of Data.table”, so when we group the data by a variable, we are creating subsets of the data. Note that there’s no significance to the initial ., except that it makes it slightly more unlikely that there will be a clash with a user-defined column name. So, one approach to solving our problem can be seen below.

mtcars[, .SD[which.max(mpg)], by = cyl]
#    cyl              car  mpg  disp  hp drat    wt  qsec vs am gear carb
# 1:   6   Hornet 4 Drive 21.4 258.0 110 3.08 3.215 19.44  1  0    3    1
# 2:   4   Toyota Corolla 33.9  71.1  65 4.22 1.835 19.90  1  1    4    1
# 3:   8 Pontiac Firebird 19.2 400.0 175 3.08 3.845 17.05  0  0    3    2

So this code essentially treats .SD as a “group”, one for each cylinder level (by), and subsets the row by the index where mpg is at its maximum.

However this wasn’t always the case with data.table, there is some legacy syntax which is still valid within the package. If we take a look at the following code, we will see that we can obtain the row where mpg is at its maximum using the .I syntax.

mtcars[, .I[which.max(mpg)]]
# [1] 20

In other words, here .I is a vector representing the row number where mpg is at its maximum in the original data.table. Now consider the case where we look at this by each cylinder group; we obtain a data.table whose column V1 represents the row indices for each cylinder group where mpg is at its maximum, i.e. one row for each group.

mtcars[, .I[which.max(mpg)], by = cyl]
#    cyl V1
# 1:   6  4
# 2:   4 20
# 3:   8 25

So using this data.table we can subset on the column V1 to extract these row indices and subset the original data.table for those rows.

mtcars[mtcars[, .I[which.max(mpg)], by = cyl]$V1]
#                 car  mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# 1:   Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# 2:   Toyota Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
# 3: Pontiac Firebird 19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2

The final way in which we could solve this problem with data.table is in fact very similar to the base R approach that we saw in the previous post. This involves splitting the data.table into three separate data.tables, one for each cylinder group, and applying a function to each group that finds the index of the maximum row, subsetting the grouped data.table on that index. We then bind these lists together using the data.table::rbindlist() function. In fact, we could have even used the do.call(rbind, .) approach we saw in the first post.

rbindlist(lapply(split(mtcars, mtcars[, cyl]), function(x) x[which.max(mpg)]))
#                 car  mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# 1:   Toyota Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
# 2:   Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# 3: Pontiac Firebird 19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2

So there we have it, three separate ways to solve the same problem using data.table.

Benchmarks

Now this wouldn’t be a completely informative blog post without some benchmarks. In fact these three options are what inspired me to write this series of posts. We can see the results of the benchmarking below.

We can see that, on average, the .I solution is fastest. So you may be wondering, if the .SD syntax is the newer syntax, why then is the .I code quicker? Well it’s simply because .SD has not yet been completely optimised. .I avoids constructing .SD, which is the bottleneck in the .SD solution.

As a side note, we could speed these results up even more with data.table::setkey(mtcars, cyl). I won’t show the benchmarking results here as the data is so small it isn’t really a useful representation but it is worth considering should you need to perform a similar task on a larger dataset.

Conclusion

If you need to apply some function to each group within a data.table, data.table has many solutions. The newest solution, .SD, may not always be the fastest approach and you should try the old .I approach if speed is important.

Are you aware of any other data.table solutions to this problem? If so, let me know in the comments!

Next time, we will take a look at how to solve this problem in dplyr as well as sparklyr.

Selecting the Max Value from Each Group, a Case Study: base R

Sat, 14 Sep 2019 18:13:14 -0500

Introduction

Let’s say we wish to group some data by a variable, then for each group we wish to find the row of the maximum value of another variable, and then finally extract the entire row. This is a fairly common task and in fact I’ve had to do this exact data exploration technique on several occasions in the last week using different syntax, data.table and sparklyr; so I thought I would share my code with you so you can compare the different options. In fact for this blog entry, I will be using base R before looking at data.table, dplyr and sparklyr in subsequent posts.

For this exercise, I will be using the classic datasets::mtcars data. The aim here is to find the row for each cylinder group (cyl) where the miles per gallon (mpg) value is at its highest. I am not interested in finding multiple rows, I just want one row for each group even if there are cars which share the same mpg.

Base R Solution

For this blog entry, I am going to look at using base R. This is a classic split() + lapply() problem. First I’ll do some pre-processing to mtcars just so that we can see which cars have the maximum mpg for each cylinder group.

# Create a column of car names
mtcars_colnames <- colnames(mtcars)
mtcars[, "car"] <- rownames(mtcars)
mtcars <- mtcars[, c("car", mtcars_colnames)]

Now we can find the rows we want.

max_mpg <- do.call(rbind, lapply(
  # Split the data into groups for each cylinder
  split(mtcars, mtcars[, "cyl"]),
  function(x) {
    # For the group `x`, select the row which has the maximum mpg
    x[which.max(x[, "mpg"]), ]
  }
))
rownames(max_mpg) <- NULL
max_mpg
#                car  mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# 1   Toyota Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
# 2   Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# 3 Pontiac Firebird 19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2

So what we did here is split() the data.frame into separate lists, one for each cylinder group, and then used lapply() (list apply) to apply a function which, for each group, selects the row which has the maximum mpg. Finally we rbind() each list back together into a data.frame.

You may be curious about my use of which.max(x[, "mpg"]) over say mtcars[mtcars$mpg == max(mtcars$mpg), ], well it’s because the former will only return a single row, whereas the latter will return multiple matching rows (check out ?which.max) and in this instance I was only interested in a single row for each group.

Another approach for base R is to use the by function.

do.call(rbind, by(datasets::mtcars, mtcars$cyl, function(x) x[which.max(x$mpg), ]))
#    mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# 4 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
# 6 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# 8 19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2

This acts in a similar way to the split + lapply approach in that the data.frame is split by row into data.frames subset by the values of one or more factors, in this case cyl, and a function is then applied to each subset in turn. However as we can see from the benchmarks below, it isn’t quite as fast (in this case) as the former approach.

Benchmarks

Conclusion

To conclude, should you need to perform an operation on a data.frame in R, you can split() your data into lists of data.frames of the required groups, lapply() a function to each data.frame in the list; and finally rbind() those data.frames back into a single data.frame.

Are you aware of any other base R solutions to this problem? If so, let me know in the comments!

In my next blog entry, we will be looking at how to perform this task using the data.table package.

Including Optional Functionality from Other Packages in Your Code

Thu, 05 Sep 2019 21:13:14 -0500

Introduction

Let’s say you want to write a function with optional functionality which is dependent on the installation of a package that your colleague may not have installed. For example, let’s say you want to have an option to return a data.table (or a tibble) instead of a data.frame, but in this case you don’t want to force your function’s user to have to install data.table (or tibble - and its dependencies) just to use your function. Maybe they can’t install it because they are restricted to do so by their IT department or maybe they are working offline. Is it possible to do this?

A Toy Example

Let’s say we have a simple function which takes a data.frame and adds a new column which is a multiplication of an existing column, before returning the whole data.frame with that new column.

toy_function <- function(data, column, multiple = 2L, as_data_table = FALSE) {
  stopifnot(is.integer(multiple) || is.numeric(multiple))
  new_column_name <- paste(column, multiple, sep = "_")
  data[, new_column_name] <- data[, column] * multiple
  if (as_data_table) data <- data.table::setDT(data)
  return(data)
}

Running this function with as_data_table = TRUE without data.table installed will give the following error:

toy_function(mtcars, "mpg", as_data_table = TRUE)
# Error in loadNamespace(name) : there is no package called ‘data.table’

This is a frustration for the user. This also means that the whole function no longer works and doesn’t return anything. So what can we do? Well, this is where the function requireNamespace() comes in handy.

requireNamespace is a wrapper for loadNamespace analogous to require that returns a logical value.

Using requireNamespace(), we can test whether or not the data.table package can be loaded from the user’s library before running certain functionality. Let’s take a look at how this changes our function:

toy_function <- function(data, column, multiple = 2L, as_data_table = FALSE) {
  stopifnot(is.integer(multiple) || is.numeric(multiple))
  new_column_name <- paste(column, multiple, sep = "_")
  data[, new_column_name] <- data[, column] * multiple
  if (as_data_table) {
    if (!requireNamespace("data.table", quietly = TRUE)) {
      warning("Please install package 'data.table' when using 'as_data_table = TRUE'")
      return(data)
    }
    data <- data.table::setDT(data)
  }
  return(data)
}

Now when we run our function, the function will check for a data.table installation and if it is not available, it will warn us that we need to install data.table in order to use this functionality; yet it will still return the manipulated data, just as a data.frame.

toy_function(mtcars, "mpg", as_data_table = TRUE)
#                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb mpg_2
# Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4  42.0
# Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4  42.0
# Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1  45.6
# ...
# Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6  39.4
# Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8  30.0
# Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2  42.8
# Warning message:
# In toy_function(mtcars, "mpg", as_data_table = TRUE) :
#   Please install package 'data.table' when using 'as_data_table = TRUE'

A real example of this can be seen in the fst package. When using the fst::read_fst() function, the user has the option to return their loaded data as a data.table.

I really like how this way of using optional functionality does not force additional package downloads on people and also means that your code remains usable on restricted servers or offline. It’s also a great way to not clog up people’s libraries (I’m looking at you tidyverse).

Package Development

This solution extends further when developing an R package. My current team is due to start utilising Spark, though our Spark cluster is not yet configured. I have therefore been testing new functionality using a local Spark cluster on our dev environment. Our production environment does not have the sparklyr package installed yet and so I cannot include any sparklyr code within my codebase…or can I?

Typically when your package relies on another package for functionality, you list that package as an Import within your package’s DESCRIPTION file. But what this typically means is that when someone installs your package, they will also need to install the Imports. However if the dependency is not available to install, you will receive the following error upon installation.

==> R CMD INSTALL --no-multiarch --with-keep.source mypackage

* installing to library ‘/Library/Frameworks/R.framework/Versions/3.5/Resources/library’
ERROR: dependency ‘sparklyr’ is not available for package ‘mypackage’
* removing ‘/Library/Frameworks/R.framework/Versions/3.5/Resources/library/mypackage’

Exited with status 1.

I am forgoing the idea that it probably isn’t best practice to include non-production code which will not work in your package, this blog post is for the purposes of demonstration only; the following is what you could do.

Removing sparklyr from the Import list would allow us to install the package but we would then face two new issues. Firstly, end users could potentially run the function (even if it isn’t exported) and be faced with that same unhelpful error message we saw earlier.

my_function()
# Error in loadNamespace(name) : there is no package called ‘sparklyr’

Secondly, from a developer’s point of view, the R CMD check would fail - which would in turn fail any CI/CD pipelines.

devtools::check()
# ...
# ❯ checking dependencies in R code ... WARNING
#   '::' or ':::' import not declared from: ‘sparklyr’

So within my function, I simply place the below code (or similar) and if the user tries to run the function, it will simply stop and tell them they need to install the sparklyr package.

if (!requireNamespace("sparklyr", quietly = TRUE)) {
  stop("Package sparklyr needed.")
}

This will subsequently pass the R CMD check. Were this an open source package, I could add sparklyr to the Suggests field of the DESCRIPTION file such that users could install the sparklyr package to get the additional functionality if they wanted it (this is exactly what the fst package does).

Conclusion

So to conclude if you want to include functionality in your code which relies on other packages but are worried about people not having access to those packages, or simply don’t want to force your users to have to install the additional packages, then consider requireNamespace(). This is a great way of offering additional functionality without the need to clog up user’s libraries.

Credit goes to my colleague Jozef Hajnala who pointed out this really neat trick!

No Visible Binding for Global Variable

Sun, 18 Aug 2019 21:13:14 -0500

Recently I have been working on a very large legacy project which utilises the excellent data.table package throughout. What this has resulted in is an R CMD check containing literally thousands of NOTEs similar to the following:

❯ checking R code for possible problems ... NOTE
  my_fn: no visible binding for global variable ‘mpg’

There are several reasons why you might see these NOTEs and, for our code base, some of the NOTEs were potentially more damaging than others. This was a problem as these NOTEs were hidden firstly by a suppression of them due to a manipulation of the _R_CHECK_CODETOOLS_PROFILE_ option of the .Renviron file. Once this was removed we discovered the more damaging NOTEs were hidden within the sheer amount of NOTEs we had in the R CMD check.

Non-standard Evaluation

If we have a function where we are using data.table’s modification by reference features, i.e. we are using a variable in an unquoted fashion (also known as non-standard evaluation (NSE)) then this issue will occur. Take the following function as an example.

my_fn <- function() {
  mtcars <- data.table::data.table(mtcars)
  mtcars[, mpg_div_hp := mpg / hp]
  mtcars[]
}

Here, we would find the following NOTEs:

❯ checking R code for possible problems ... NOTE
  my_fn: no visible binding for global variable ‘mpg_div_hp’
  my_fn: no visible binding for global variable ‘mpg’
  my_fn: no visible binding for global variable ‘hp’
  Undefined global functions or variables:
    hp mpg mpg_div_hp

Sometimes you may also see these NOTEs for syntactic sugar such as !! or := if you haven’t correctly imported the package they come from.

This is a well discussed issue on the internet which only became an issue after a change introduced to the core R code in version 2.15.1. There are two solutions to this problem.

Option One

Include all variable names within a globalVariables() call in the package documentation file.

globalVariables(c("mpg", "hp", "mpg_div_hp"))

For our package, as there are literally thousands of variables to list in this file, it makes it very difficult to maintain this list and makes the file very long. If, however, the variables belong to data which are stored within your package then this can be greatly simplified to

globalVariables(names(my_data))

You may wish to import any syntactic sugar functionality here as well. For example

globalVariables(c(":=", "!!"))

Option Two

The second option involves binding the variable locally to the function. At the top of your function you can define the variable as a NULL value.

my_fn <- function() {
  mpg <- hp <- mpg_div_hp <- NULL
  mtcars <- data.table::data.table(mtcars)
  mtcars[, mpg_div_hp := mpg / hp]
  mtcars[]
}

Therefore your variable(s) are now bound to object(s) and so the R CMD check has nothing to complain about. This is the method that the data.table team recommend and to me, feels like a much neater and more importantly maintainable solution than the first option.

A Note on the Tidyverse

You may also come across this problem whilst programming using the tidyverse for which there is a very neat solution. You simply need to be more explicit within your function by using the .data pronoun.

#' @importFrom rlang .data
my_fn <- function() {
  mtcars %>% 
    mutate(mpg_div_hp = .data$mpg / .data$hp)
}

Note the import!

Selecting Variables with the `data.table` `..` Prefix

NOTEs can occur when we are using the .. syntax of data.table, for example

double_dot <- function() {
  mtcars <- data.table::data.table(mtcars)
  select_cols <- c("cyl", "wt")
  mtcars[, ..select_cols]
}

This will yield

❯ checking R code for possible problems ... NOTE
  Undefined global functions or variables:
    ..select_cols

In this instance, this can be solved by avoiding the .. syntax and using the alternative with = FALSE notation.

double_dot <- function() {
  mtcars <- data.table::data.table(mtcars)
  select_cols <- c("cyl", "wt")
  mtcars[, select_cols, with = FALSE]
}

Even though the .. prefix is syntactic sugar, we cannot use globalVariables(c("..")) since the actual variable in this case is ..select_cols; we would therefore need to use globalVariables(c("..select_cols")) if we wanted to use the globalVariables() approach.

Missing Imports

In our code base, I also found NOTEs for functions or datasets which were not correctly imported. For example, consider the following simple function.

Rversion <- function() {
  info <- sessionInfo()
  info$R.version
}

This gives the following NOTEs:

❯ checking R code for possible problems ... NOTE
  Rversion: no visible global function definition for ‘sessionInfo’
  Consider adding
    importFrom("utils", "sessionInfo")
  to your NAMESPACE file.

Here the R CMD check is rather helpful and tells us the solution; we need to ensure that we explicitly import the function from the utils package in the documentation. This can easily be done with the roxygen2 package by including an @importFrom utils sessionInfo tag.

Trying to Call Removed Functionality

If you have a function which has been removed from your package but attempt to call it from another function, R will only give you a NOTE about this.

use_non_existent_function <- function() {
  this_function_doesnt_exist()
}

This will give the NOTE

❯ checking R code for possible problems ... NOTE
  use_non_existent_function: no visible global function definition for
    ‘this_function_doesnt_exist’

Of course it goes without saying that you should make sure to remove any calls to functions which have been removed from your package. As a side note, when I first started working on the project, I was initially unaware that within our package we had the option _R_CHECK_CODETOOLS_PROFILE_ = "suppressUndefined = TRUE" set within our .Renviron file which will suppresses all unbound global variable NOTEs from appearing in the R CMD check. However given that this can mask these deeper issues within your package, such as not recognising when a function calls functionality which has been removed from the package. This can end up meaning the end user can face nasty and confusing error messages. Therefore I would not recommend using this setting and would suggest tackling each of your packages NOTEs individually to remove them all.

I actually discovered all of our package NOTEs when introducing the lintr package to our CI pipeline. lintr will pick up on some – but not all – of these unbound global variable problems ('lintr of course does not take the _R_CHECK_CODETOOLS_PROFILE_ into account). Take our original function as an example

my_fn <- function() {
  mtcars <- data.table::data.table(mtcars)
  mtcars[, mpg_div_hp := mpg / hp]
  mtcars[]
}

Here, lintr will highlight the variables mpg and hp as problems but it currently won’t highlight the variables on the LHS of :=, i.e. mpg_div_hp.

Conclusion

When developing your package, if you are experiencing these unbound global variables NOTEs you should

Strive to define any unbound variables locally within a function.
Ensure that any functions or data from external packages (including utils, stats, etc.) have the correct @importFrom tag
Do not suppress this check in the .Renviron file and the solutions proposed here should remove the current need to do so
Any package wide unbound variables, which are typically syntactic sugar (e.g. :=), should be defined within the package description file inside a globalVariables() function, which should be a very short and maintainable list.

Extending sparklyr: Data Types

Thu, 08 Mar 2018 21:13:14 -0500

TL;DR

sparklyr maps R data types and data storage types to Scala, but it doesn’t handle all data storage types. This blog post discusses how to generate Scala data storage types from the R side, that are not generated by sparklyr. You can do this by using the sparklyr::invoke_new function to generate the objects you want in Java or Scala, for example a java.util.ArrayList, and then sparklyr::invoke methods of the class to add data to it, or convert it to the type you need. Read on to see how to deal with different data storage types from the Scala side or skip ahead to see how to generate Scala data storage types from R.

Introduction

When working to extend the sparklyr package, for example to call custom Scala libraries, oftentimes you will come across Scala methods which require you to use different data storage types to those automatically handled by sparklyr. When using the invoke family of functions, R data types map to Scala data types, but sparklyr currently only handles certain R data storage type mappings. The below table shows the data mappings currently handled by sparklyr:

Table 1: R to Scala type mappings available in `sparklyr`
R Type	Scala Type
logical	Boolean
numeric	Double
integer	Integer
character	String
list	Array

So Scala functions with parameters that require a List or a Seq, for example, need to be handled in a different way. There are two ways we can approach this problem; from the Scala side and from the R side. We will explore both approaches.

Other Scala Data Types

Solutions from the Scala Side

There are several ways that this issue can be overcome from the Scala side, here we highlight three: changing the data type used within Scala; using overloading; and defining a specific R class to be called from R. These are discussed in detail below.

Using Different Data Types in Scala

One obvous way we could fix this problem is to rewrite the Scala code to use a different parameter type in the Scala method. For example, we could use an Array which would require us passing a list() on the R side. However, this is not ideal if your project is large, has lots of legacy code and uses other APIs such as PySpark; you may end up changing a lot of code.

Using Overloading

We can instead use overloading, which allows us to define methods of same name, in the same class, but having either different parameters or data types, though this has many issues. We would also need to write additional tests for the additional methods. You can think of this as working like R’s S3 methods - for S3 methods the method behaviour will change based on the object’s class.

Defining A New Scala Class

To avoid the possible issues of overloading, we can define two separate classes, myClass and myClassR. These will both call upon the same underlying implicit class which does the bulk of the work for the method. The difference is the data types that are passed into myClass and myClassR. myClass will take the data type you want to use, whereas myClassR will take the data type passed to it by sparklyr and then convert it before calling the implicit. Of course using this approach effectively doubles our code and is therefore very wasteful; we would also again, need to write additional tests for this new class.

Solutions from the R Side

Generating Scala Data Storage Types from R

We can actually forgo any changes on the Scala side of our code by generating what we need on the R side. Imagine we wanted to generate a Scala Seq as an example, first we create a Java ArrayList in the Spark environment and incrementally add data to it using the following code:

library(sparklyr)
sc <- spark_connect(master = "local")
# map some R vector `x` to a java ArrayList
x <- c(1, 2, 3)
al <- invoke_new(sc, "java.util.ArrayList")
lapply(x, FUN = function(y){invoke(al, "add", y)})

Note we don’t need to reassign the results of the lapply because it is adding values to the Scala List in the JVM. Then using the JavaConversions Scala package, we convert the Array to a Seq.

invoke_static(sc, "scala.collection.JavaConversions", "asScalaBuffer", al) %>%
  invoke("toSeq")

Putting this all together in a function gives

scala_seq <- function(sc, x) {
  al <- invoke_new(sc, "java.util.ArrayList")
  lapply(
    x,
    FUN = function(y) {
      invoke(al, "add", y)
    }
  )
  invoke_static(sc, "scala.collection.JavaConversions", "asScalaBuffer", al) %>%
    invoke("toSeq")
}

Calling this function returns a reference to the Scala object (spark_jobj).

# connect to spark
sc <- sparklyr::spark_connect(master = "local")

# create a scala seq object
scala_seq(sc, c(1, 2, 3))
# <jobj[16]>
#   scala.collection.convert.Wrappers$JListWrapper
#   Buffer(1.0, 2.0, 3.0)

You will note that the output we have received tells us we have created a Buffer but Buffer (and List) both belong to the same category (sequence). If what we needed was actually a List object, then we simply have to invoke the toList method on a Seq (or Buffer) object. The below function shows this in action, again this returns a reference to the Scala object (spark_jobj) to the R console.

scala_list <- function(sc, x) {
  scala_seq(sc, x) %>%
    invoke("toList")
}

# create a scala list
scala_list(sc, c(1, 2, 3))
# <jobj[21]>
#   scala.collection.immutable.$colon$colon
#   List(1.0, 2.0, 3.0)

# disconnect the spark connection
spark_disconnect(sc = sc)
# NULL

Similar results can be achieved for other data types. These new data storage types can now be used in Scala function calls when extending sparklyr, we simply generate the data in the JVM and pass the reference to the function we invoke.

Project Euler in R

Wed, 28 Feb 2018 21:13:14 -0500

Project Euler

This is just a short blog post to raise some awareness to some fun programming and mathematical challenges I recently came across, hosted on Project Euler. The idea behind Project Euler is to provide abstract programming challenges for people to develop their skills and learn new concepts in a recreational way. The problems range in difficulty and are aimed at:

students for whom the basic curriculum is not feeding their hunger to learn, adults whose background was not primarily mathematics but had an interest in things mathematical, and professionals who want to keep their problem solving and mathematics on the cutting edge.

Many, many attempts have been made to solve these problems in different languages and in fact the Rosetta Code website hosts solutions to lots of these challenges. However in my (admittedly brief) search I couldn’t find any one place with hosted R solutions. Thus, I decided to have a go at a few of them, package them up and host them on GitHub with a view to collecting solutions for all of the challenges. With a current list of 611 Project Euler challenges, however, it will take me quite a while to get through them all and so I have enlisted the help of some of my colleagues from Mango Solutions (thisisnic and adfi) who have submitted some solutions. Even so, this is a lot of problems for so few people and so I ask you, my readers, to feel free to submit pull requests via GitHub for any potential solutions you may come up with.

Accessing Private Methods from an R6 Class

Sun, 13 Aug 2017 21:13:14 -0500

I recently wrote a package to solve the Twitter Waterflow Problem using an R6 class. You can view the package here and read about how I approached the problem here. In this blog post, I want to highlight how you can access private members of an R6 class which Winston Chang mentioned in his useR!2017 talk. I will use the waterflow package for this example. Within the R6 waterflow class there is a private member function, or method, that converts the data you provide the class with, and the data it calculates, into a tidy data.frame used for generating a plot. However what if we already have the data that this function needs to be supplied with? How can we just run this function on the fly? If we try to call it directly, we get an error.

library(waterflow)
wall <- c(2, 5, 1, 2, 3, 4, 7, 7, 6)
water <- c(2, 5, 1, 2, 3, 4, 7, 7, 6)
p <- waterflow$new(wall)
p$tidyWater(water, wall)
# Error in eval(expr, envir, enclos): attempt to apply non-function

Instead, what we need to do is extract the method from the class’ environment, .__enclos_env__, which allows us access to private members of the class.

p$.__enclos_env__$private$tidyWater(water, wall)
#    pos  type val
# 1    1 water   2
# 2    2 water   5
# 3    3 water   1
# 4    4 water   2
# 5    5 water   3
# 6    6 water   4
# 7    7 water   7
# 8    8 water   7
# 9    9 water   6
# 10   1  wall   2
# 11   2  wall   5
# 12   3  wall   1
# 13   4  wall   2
# 14   5  wall   3
# 15   6  wall   4
# 16   7  wall   7
# 17   8  wall   7
# 18   9  wall   6

The Twitter Waterflow Problem

Wed, 09 Aug 2017 21:13:14 -0500

Introduction

I was recently introduced to the Twitter Waterflow Problem and I decided it was interesting enough to try and complete the challenge in R. Consider the following picture:

This plot shows a series of walls and empty valleys. We can represent this picture by an array of integers, where the value at each index is the height of the wall. So in this case, the array of integers can be defined as:

wall <- c(2, 5, 1, 2, 3, 4, 7, 7, 6)

Now imagine it rains. How much water is going to be accumulated in puddles between walls? No puddles are formed at edges of the wall and water is considered to simply run off the edge. We count volume in square blocks of 1×1. Thus, we are left with a puddle between column 2 and column 7 and the volume is 10.

The Approach

The approach I took was one of many ways you could solve this problem. I chose to treat each column (wall) as an index and then for each index I implement a loop:

Find the height of the current index
Find the maximum height of the walls to the left of the current index
Find the maximum height of the walls to the right of the index

I then work out what the smallest maximum height is between the maximum heights to the left and right of the current index. If this smallest height minus the current index height is greater than zero, then I know how many blocks will fill with water for the current index. Of course, if the smallest maximum height to the left or right is less than the current height, then I get the run off. Converting this to code looks like this:

len <- length(wall)
# pre-allocate memory to make the loop more efficient
water <- rep(0, len)
for (i in seq_along(wall)) {
  currentHeight <- wall[i]
  maxLeftHeight <- if (i > 1) {
    max(wall[1:(i - 1)])
  } else {
    0
  }
  maxRightHeight <- if (i == len) {
    0
  } else {
    max(wall[(i + 1):len])
  }
  smallestMaxHeight <- min(maxLeftHeight, maxRightHeight)
  water[i] <- if (smallestMaxHeight - currentHeight > 0) {
    smallestMaxHeight - currentHeight
  } else {
    0
  }
}
water
# [1] 0 0 4 3 2 1 0 0 0

This returns a vector of the number of blocks of water at each index.

The R6 Class

For this problem I chose to use the R6 class system because it is very self contained. The R6 class system is different from the functional S3 and S4 class systems found in base R in that it is an encapsulated class system. Some key differences between the two are:

Functional:

Objects contain data
Class methods are separate from objects
Objects are immutable - they cannot be changed after they have been created

Encapsulated:

Objects contain methods and data
Objects are mutable

Winston Chang details these differences very well in his userR!2017 talk.

I wanted the user to be able to acquire two key pieces of information: the total blocks of water and the filled plot. I therefore created three public methods inside an R6 class and placed the class in a simple package which can be found here. public methods are a list of functions (and/or non-functions) which are essentially methods (or data) of the class that are intended to be used by the user of the class.

When writing a new R6 class, we often want to perform some initial functionality when we instantiate an object of this class. This is true in our case as when we instantiate a new object of class waterflow, we want it to calculate the heights of the water straight away. We therefore call our earlier function initialize and place it inside the public list.

initialize = function(wall = NULL) {
  if (is.null(wall)) {
    stop("Please provide some wall heights")
  }
  if (!is.numeric(wall)) {
    stop("Please provide a numeric vector")
  }
  len <- length(wall)
  water <- rep(0, len)
  for (i in seq_along(wall)) {
    currentHeight <- wall[i]
    maxLeftHeight <- if (i > 1) {
      max(wall[1:(i - 1)])
    } else {
      0
    }
    maxRightHeight <- if (i == len) {
      0
    } else {
      max(wall[(i + 1):len])
    }
    smallestMaxHeight <- min(maxLeftHeight, maxRightHeight)
    water[i] <- if (smallestMaxHeight - currentHeight > 0) {
      smallestMaxHeight - currentHeight
    } else {
      0
    }
  }
  private$heights <- private$tidyWater(water, wall)
}

Note, we have one key difference here, we are assigning the results to members of the private list within our object. Once we have calculated our water heights, we use them along with our wall heights in the function private$tidyWater() and assign the resulting data.frame to private$heights. The private argument is a list which contains methods (and/or data) which are internal to the class and are not intended to be used by the user. We do similar things when writing packages - we explicitly export the functionality we want other people to use and don’t export functionality that is only used within the package itself.

So to use the class, first we instantiate the class with some data in a call to $new() which in turn runs the above initialize function.

library(waterflow)
wall <- c(2, 5, 1, 2, 3, 4, 7, 7, 6)
p <- waterflow$new(wall)

So now we have an object called p which is of class waterflow (and R6). p contains the data, as well as the (public) methods we can perform on that data.

Typically when we return p, R6 objects have a default print method that lists all members of the object but here there is a custom $print() function that returns heights.

p
#    pos  type val
# 1    1 water   0
# 2    2 water   0
# 3    3 water   4
# 4    4 water   3
# 5    5 water   2
# 6    6 water   1
# 7    7 water   0
# 8    8 water   0
# 9    9 water   0
# 10   1  wall   2
# 11   2  wall   5
# 12   3  wall   1
# 13   4  wall   2
# 14   5  wall   3
# 15   6  wall   4
# 16   7  wall   7
# 17   8  wall   7
# 18   9  wall   6

We can still return the members of the object by looking at the structure of p.

str(p)
# Classes 'waterflow', 'R6' <waterflow>
#   Public:
#     clone: function (deep = FALSE) 
#     initialize: function (wall = NULL) 
#     plot: function () 
#     print: function () 
#     total: function () 
#   Private:
#     heights: data.frame
#     tidyWater: function (water, wall)

To calculate the total water that fills the valleys, we sum over the heights object for the values of the water.

total = function() {
  sum(private$heights[private$heights$type %in% "water", "val"])
}

Calling the public method $total() gives the expected result.

p$total()
# [1] 10

To call the plot, we access the public method $plot().

p$plot()

The completed class looks like this

waterflow <- R6Class(
  "waterflow",
  public = list(
    initialize = function(wall = NULL) {
      if (is.null(wall)) {
        stop("Please provide some wall heights")
      }
      if (!is.numeric(wall)) {
        stop("Please provide a numeric vector")
      }
      len <- length(wall)
      water <- rep(0, len)
      for (i in seq_along(wall)) {
        currentHeight <- wall[i]
        maxLeftHeight <- if (i > 1) {
          max(wall[1:(i - 1)])
        } else {
          0
        }
        maxRightHeight <- if (i == len) {
          0
        } else {
          max(wall[(i + 1):len])
        }
        smallestMaxHeight <- min(maxLeftHeight, maxRightHeight)
        water[i] <- if (smallestMaxHeight - currentHeight > 0) {
          smallestMaxHeight - currentHeight
        } else {
          0
        }
      }
      private$heights <- private$tidyWater(water, wall)
    },
    plot = function() {
      ggplot(private$heights) +
        geom_col(
          aes(x = pos + 1 / 2, y = val, fill = type),
          width = 1, show.legend = FALSE
        ) +
        scale_fill_manual(values = c("dodgerblue2", "grey50")) +
        scale_x_continuous(breaks = seq(0, max(private$heights$pos), 1)) +
        theme(
          panel.background = element_blank(),
          panel.ontop = TRUE,
          panel.grid.minor.x = element_blank(),
          panel.grid.minor.y = element_line(colour = "white", size = 0.5),
          panel.grid.major.x = element_line(colour = "white", size = 0.5),
          panel.grid.major.y = element_line(colour = "white", size = 0.5),
          axis.ticks = element_blank(),
          text = element_blank()
        )
    },
    print = function() print(private$heights),
    total = function() {
      sum(private$heights[private$heights$type %in% "water", "val"])
    }
  ),
  private = list(
    heights = NULL,
    tidyWater = function(water, wall) {
      data.frame(
        pos = seq_along(wall),
        type = factor(
          rep(c("water", "wall"), each = length(wall)),
          levels = c("water", "wall")
        ),
        val = c(water, wall)
      )
    }
  )
)

Disadvantages of R6

Overall R6 is a great package with one or two downsides but these are mostly not too worrying. For one thing, R6 is a separate package that users have to load or use as an import but given that it is such a lightweight package and doesn’t have any imports of its own, it’s nothing to be concerned about. Also, R6 doesn’t have any strict type checking but this is remedied by including your own type checking in your methods. The main bug bear I have with R6 is the lack of support from Roxygen2 out of the box and this has been an open issue for a while.

Also posted on the Mango Solutions blog.

Automatically Building, Testing and Deploying bookdown with Travis and GitHub Pages

Tue, 16 May 2017 21:13:14 -0500

I recently began writing some documentation around coding standards using bookdown. The workflow I was using was to write the new sections of the book, build the book and then push the changes to GitHub where it is hosted using GitHub Pages. This was clearly one manual step too far for me as I consistently forgot to build the book before I pushed the changes to GitHub meaning those changes were not shown on the subsequent web pages. Then when I finally did manage to convert the Rmarkdown to html, I found that some links would be broken or missing, I therefore needed two things:

I needed a way to automatically build the book.
I needed a way to test my html files.

I was already familiar with Travis having used it for some of my packages. I therefore decided that a smart way to handle the build would be to build the book on Travis and push the subsequent docs folder back to my gh-pages branch on GitHub using Travis’ inbuilt deployment method for deploying to GitHub Pages. But before it pushed these changes, I would be able to test the html files with the Ruby library, html-proofer.

HTMLProofer is a set of tests to validate your HTML output. These tests check if your image references are legitimate, if they have alt tags, if your internal links are working, and so on. It’s intended to be an all-in-one checker for your output.

We can achieve all of this with the following .travis.yml file.

language: R
sudo: required
cache: packages

r_packages:
  - bookdown

before_script:
  - chmod +x ./scripts/cibuild

before_install:                           # Install Ruby and html-proofer
  - rvm get stable --auto-dotfiles
  - rvm install 2.3.3
  - gem install html-proofer

script:
  - ./scripts/cibuild

deploy:
  provider: pages                         # Specify the gh-pages deployment method
  skip_cleanup: true                      # Don't remove files
  github_token: $GITHUB_TOKEN             # Set in travis-ci.org dashboard
  local_dir: docs                         # Deploy the docs folder
  on:
    branch: master

env:
  global:
    - NOKOGIRI_USE_SYSTEM_LIBRARIES=true  # Speed up the html-proofer

notifications:
  email: false

Note, the GITHUB_TOKEN is a GitHub Personal Access Token (PAT) that you store in the travis-ci.org dashboard under the settings for the repository.

The cibuild is then a simple file that first renders the book (_build.sd), thus creating the html files within a docs folder (which is specified in the output_dir: tag in my _bookdown.yml file) and then it runs the html-proofer on the resulting html files.

. _build.sh
htmlproofer ./docs

Where the _build.sh script is just:

#!/bin/sh

Rscript -e "bookdown::render_book('index.Rmd', 'bookdown::gitbook')"

If all is well, Travis will then push the html files back to the gh-pages branch, thus updating the hosted version of the book.

Piping Within Pipes

Mon, 21 Nov 2016 21:13:14 -0500

The magrittr pipe (%>%) has revolutionised the way many people now write R code. I’ve been using R for over 7 years and the pipe has become a staple of my programming conventions. However it was recently brought to my attention that you can actually use pipes within function calls, which can make my code even more human readable. Take for example the following code.

library(forcats)
library(dplyr)
gss_cat2 <-
  gss_cat %>%
  mutate(marital2 = fct_rev(fct_infreq(marital)))

Whilst this code is fairly easy to read, you can imagine how this doesn’t scale very nicely with even more nested function calls. One solution would be to use dplyr’s ability to mutate the same column within the mutate function call to split out the code a little more.

gss_cat3 <-
  gss_cat %>%
  mutate(
    marital2 = fct_infreq(marital),
    marital2 = fct_rev(marital2)
  )

Sure this is more readable, but it’s repeating far too much code for my liking. So, we can instead just use the pipe.

gss_cat4 <-
  gss_cat %>%
  mutate(
    marital2 =
      marital %>%
      fct_infreq() %>%
      fct_rev()
  )

This not only eliminates long, nested function calls but it also makes my code much more human readable! Try it yourself.

ggplot(gss_cat4) +
  geom_bar(aes(x = marital2)) +
  labs(x = "Marital Status", y = "Count") +
  coord_flip()

About

Mon, 01 Jan 0001 00:00:00 +0000

I am the Chief Data Scientist and founder of NE Data. I have a demonstrated history of working and consulting across multiple industries since 2009. Skilled in R, Python, SQL and Statistical Modelling, my passion is turning business problems into technical solutions through the use of data; building pipelines; building applications; modelling; and data visualisation.

I have an MSc in Statistics from Sheffield University and a BSc in Mathematics and Statistics from Plymouth University. I enjoy writing open source R code and Shiny apps; check out my work on GitHub.

You can email me or find me on Twitter if you want to message me. I love meeting new people and talking about code so feel free to get in touch!

Find me on R-Bloggers.

Random R Ramblings

{poorman}: Version 0.2.5 Release

{poorman} 0.2.5

Filling NA Values Using the Last Observation Carried Forward with {dplyr}, {dbplyr} and {sparklyr}

The Problem

Solving the Problem with {dbplyr}

Bonus - Next Observation Carried Backwards

Using Functions As An Input To Functions With {dbplyr}

The Problem

Solution For data.frames

Solution For tbl_sparks

Quoted Function Name

Additional Comments

Conclusion

poorman: Versions 0.2.2 and 0.2.3 Releases

Introduction

across()

case_when()

rename_with()

Conclusion

poorman: Version 0.2.1 Release

Introduction

Selecting Distinct Rows

Slicing Data

Selecting With Predicates

Working With NA Values

Finding the First Non-Missing Element

Convert Values To NA

Replacing NA Values

Recoding Values

Group Details

Conclusion

poorman: The Selectificator 2000!

Introduction

The Selectificator 1000

The Selectificator 2000

Conclusion

poorman: Select helpers, bug fixes and tests, tests, tests!

Introduction

Select Helpers

Selecting Columns Based On Partial Column Names

Reordering Columns

Select Columns Using a Regular Expression

The Select Helper List

Docker

Test, Test, Test!

poorman: First Release of a base R dplyr Clone

Introduction

What is poorman?

So what does poorman include?

Why develop poorman?

But why not just use dplyr?

Why the name poorman?

Why not use data.table for the backend?

But doesn’t poorman have dependencies?

Conclusion

poorman: Replicating dplyr's Join and Filter Join Functions with base R

Introduction

Joins

Inner Join

Left Join

Right Join

Full Join

Filter Joins

Semi-Join

Anti-Join

Conclusion

Building A base dplyr With Primitives: Grouped Operations, Pipes and More!

Introduction

Group By

The base Way

The poorman Way

Ungrouping

Additional Functionality

The Pipe

Rename

Summary

Conclusion

Including Function Factories in an R Package: Using Collate

Introduction

Solution For `data.frame`s

Solution For `tbl_spark`s

`across()`

`case_when()`

`rename_with()`

What is `poorman`?

So what does `poorman` include?

Why develop `poorman`?

But why not just use `dplyr`?

Why the name `poorman`?

Why not use `data.table` for the backend?

But doesn’t `poorman` have dependencies?

The `base` Way

The `poorman` Way

`sparklyr`

`data.table` Solution(s)

Selecting Variables with the `data.table` `..` Prefix