The base-R function all.vars() returns all the names from an expression. For example:
> all.vars( ~ e == M * c^2 )
[1] "e" "M" "c"
There's one R operator for which this is inappropriate. In many expressions written by people who aren't using non-standard evaluation and functions from rlang and its like, names will be the names of variables. But if those expressions contain calls to $ , the name on the right-hand side will not be a variable, but an index or column name. (I know the distinction between variables and column names can be blurred by clever use of environments and data masking, but that's not the point here.)
all.vars() doesn't have an option for ignoring the right-hand sides of $ . Are there any similar functions that do, or must I program my own expression-walker? Basically, I want a function that if passed the expression
a $ b + c $ d
will return "a" and "c" .
Reason for request
Roland, it is good of you to suggest I explain why I want this. I use vectorisation much, since it's the only way to get sufficient speed in the calculations I do over very large datasets. Vast tracts of my code thus consist of this kind of thing:
cond <- ¢ A logical vector of 500,000 elements ¢
v1 ¢ (and v2 etc. ) ¢ <- ¢ Numerical or string vectors of the same length ¢
result_size <- length( cond )
result <- rep( NA, result_size )
result[ cond ] <- f( v1[ cond ], v3[ cond ]
, v4[ cond ], v7[ cond ]
, v9[ cond ], v10[ cond ]
)
result[ ! cond ] <- g( v2[ ! cond ], v3[ ! cond ]
, v4[ ! cond ], v5[ ! cond ]
, v6[ ! cond ], v8[ ! cond ]
, v10[ ! cond ]
)
That, I think, is what R experts call a split workflow. Split data by a condition, process each group separately, combine results.
This pattern is crying out to be abstracted into something that looks like a conditional. (See e.g. R. D. Tennant's book, Semantics of Programming Languages for examples of abstractions in this sense of the term and why they're good.) So instead of the accident-prone stuff above, replete with mistypeable and repetitious indices and partial-vector assignments, I want to be able to write:
cond <- ¢ A logical vector of 500,000 elements ¢
v1 ¢ (and v2 etc. ) ¢ <- ¢ Numerical or string vectors of the same length ¢
result <- splivif( cond
, f( v1, v3, v4, v7, v9, v10 )
, g( v2, v3, v4, v5, v6, v8, v10 )
)
splivif() here should be interpreted as just another kind of conditional function, in the same way that if(), if_else(), ifelse() and fifelse(), and probably half-a-dozen others that I don't yet know are. It would hide some clever details in the same way that those functions do: namely evaluating its condition, splitting any variables mentioned in the "then" and "else" branches into subvectors according to that condition, calling each branch on those subvectors, and then combining the results.
Such a function is one that I have in fact implemented and use often. As said above, it first evaluates its condition. It then scans the "then" and "else" expressions for variables. Those that it deems to be vectors of the right length, it evaluates. It then selects only the cond'th elements of each value, and binds them, in a new environment, to the name of the original variable.
So, by the end of this stage, we have a new baby environment E in which the name "v1" is bound to V1[ cond ] , where V1 is the value of the original v1. Also in E are similar bindings for names "v2" to "v10".
splivif() then evaluates its "then" and "else" expressions in E, and combines the results into a result vector.
My need for all.vars() was in scanning the "then" and "else" expressions for variables. I use nested named lists to store values that control my calculations. Therefore the expressions have a largish number of references to those lists' elements, for example Taxogellation $ IgnoreRepeats and Taxogellation $ DoInnerSplines . The nub of my question was that all.vars() would then incorrectly return "IgnoreRepeats" and "DoInnerSplines" as the names of variables when in fact they're indices.
Code to demonstrate why I need to vectorise
I added this section on September 8th 2020, in response to Roland's comment. It builds a table of sample data, representing the incomes, ages, and health of 50,000 families. Each family consists of either one or two adults. It then defines a function, pension() , which calculates the pension due to each family. This isn't the same as any existing government would give, but illustrates features of typical pension calculations. For example, the results typically depend on age and health, and may depend on income. These dependencies set a minumum complexity for any such calculation, and hence a minimum time.
The code then compares and times three ways of applying pension() to all 50,000 families. These are: grouping via the Tidyverse; grouping via data.table; and vectorisation. The latter uses the fact that operators and functions such as +, |, > and pmax() can be applied to vectors of more than one element, and then work elementwise on corresponding elements.
My timing results show that the Tidyverse, and even data.table, are woefully slow compared to vectorisation. For 50,000 families, vectorisation was 40 times quicker!
library( tidyverse )
library( data.table )
library( assertthat )
library( microbenchmark )
library( purrr )
#1) Create sample data
#=====================
# The code in this section makes a table
# of no_of_groups families. Each family has
# one or two adults. Adults are randomly assigned
# an income, between 0 and 30,000 pounds;
# an age, between 18 and 99, and a health
# indicator. Each family also gets an integer
# ID. Each adult also gets a number indicating
# whether they are adult 1 or adult 2.
#
# The sections following this will define
# a function for calculating families'
# pensions. My code will apply it in three
# ways, and time each one. These are: by
# grouping using the Tidyverse; by grouping
# using data.table; and by vectorisation.
# This shows that the Tidyverse and data.table
# are both woefully inefficient compared with
# vectorisation. For 5,000 families, the
# Tidyverse takes 2.5 seconds and data.table
# 2 seconds. Vectorisation takes a mere 50
# milliseconds, 40 times as fast.
#
no_of_groups <- 5000
group_sizes <- sample( c(1,2), no_of_groups, replace=TRUE )
ids <- 1:no_of_groups
data <- tibble( fam_id=map2( ids, group_sizes, rep ) %>% unlist() )
data <-
data %>%
group_by( fam_id ) %>%
mutate( ad_no = seq_along( fam_id )
, two_people = length( ad_no ) == 2
) %>%
ungroup()
data $ income <- runif( nrow( data ), 0, 1 ) * 30000
data $ age <- sample( 18:99, nrow( data ), replace=TRUE )
data $ bad_health <- sample( c(T,F), nrow( data ), replace=TRUE, prob=c(0.1,0.9) )
#2) Function to calculate pension on single family
#=================================================
# two_people is true if the family has two
# people, otherwise false.
# ad1_inc and ad2_inc are the incomes, in
# pounds per year. ad2_inc is NA if there is
# only one person.
# Similarly, ad1_age and ad2_age are ages.
# And ad1_bad_health and ad2_bad_health are
# Booleans indicating whether the person
# has bad health.
# The result is the pension the Government
# gives the family, in pounds per week.
# This is NOT meant to be the same as in any
# existing country's social-security system,
# but exemplifies the kinds of calculation
# such a function needs to do. On our data,
# these will be called several hundred
# thousand times.
#
pension <- function( two_people
, ad1_inc, ad2_inc
, ad1_age, ad2_age
, ad1_bad_health, ad2_bad_health
)
{
max_age <-
ifelse( two_people
, pmax( ad1_age, ad2_age )
, ad1_age
)
income <-
ifelse( two_people
, ad1_inc + ad2_inc
, ad1_inc
)
bad_health <-
ifelse( two_people
, ad1_bad_health | ad2_bad_health
, ad1_bad_health
)
pension_level <-
case_when( income > 50000 | max_age < 65 ~ "None"
, max_age > 80 | bad_health ~ "High"
, max_age >= 65 ~ "Normal"
)
pension <-
case_when( pension_level == "High" ~ 200.00
, pension_level == "Normal" ~ 150.00
, pension_level == "None" ~ 0
)
pension
}
#3) Check it works
#=================
pension( F, 40000, NA, 75, NA, F, NA )
# 150.
pension( T, 20000, 20000, 75, 75, F, F )
# 150.
pension( F, 60000, NA, 75, NA, F, NA )
# 0, because of high income.
pension( T, 30000, 30000, 75, 75, F, F )
# 0, because of high income.
pension( F, 60000, NA, 50, NA, F, NA )
# 0, because of low age.
pension( T, 20000, 20000, 75, 75, F, T )
# 200, because of bad health.
#4) Function to calculate all pensions using Tidyverse group-by
#==============================================================
pension_over_all_TV <- function( data )
{
results <-
data %>%
group_by( fam_id ) %>%
group_map( ~ {
assert_that( nrow( .x ) %in% c( 1, 2 ) )
two_people <- .x $ two_people[[ 1 ]]
pension( two_people
, .x $ income[[ 1 ]]
, ifelse( two_people, .x $ income[[ 2 ]], NA )
, .x $ age [[ 1 ]]
, ifelse( two_people, .x $ age[[ 2 ]], NA )
, .x $ bad_health[[ 1 ]]
, ifelse( two_people, .x $ bad_health[[ 2 ]], NA )
)
}
)
#
# A vector of pension values, one per family.
results
}
#5) Try it and time it
#=====================
pensions_TV <- pension_over_all_TV( data )
#
# Pensions as calculated by Tidyverse grouping.
res <- microbenchmark( pension_over_all_TV( data ), times=3 )
print( res )
#
# Time it. Mean is 2.5 seconds:
# Unit: seconds
# expr min lq mean median uq max neval
# pension_over_all_TV(data) 2.533073 2.565714 2.584183 2.598356 2.609738 2.621121 3
#6) Function to calculate all pensions using data.table group-by
#===============================================================
pension_over_all_DT <- function( data )
{
# The function that data.table must apply
# to each group.
#
f <- function( group )
{
assert_that( nrow( group ) %in% c( 1, 2 ) )
two_people <- group $ two_people[[ 1 ]]
pension( two_people
, group $ income[[ 1 ]]
, ifelse( two_people, group $ income[[ 2 ]], NA )
, group $ age [[ 1 ]]
, ifelse( two_people, group $ age[[ 2 ]], NA )
, group $ bad_health[[ 1 ]]
, ifelse( two_people, group $ bad_health[[ 2 ]], NA )
)
}
data <- as.data.table( data )
results <-
data[
, f( .SD )
, by=c( "fam_id" )
]
#
# A table with a V1 column containing one
# pension value per family.
results
}
#7) Try it and time it
#=====================
pensions_DT <- pension_over_all_DT( data )
#
# Pensions as calculated by data.table grouping.
assert_that( are_equal( unlist( pensions_TV ), pensions_DT $ V1 ) )
#
# Making allowance for the slightly different
# formats of the results returned by group_map()
# and data.table's grouped operations, check
# that the numbers are the same.
res <- microbenchmark( pension_over_all_DT( data ), times=3 )
print( res )
#
# Time it. Mean is 2 seconds:
# Unit: seconds
# expr min lq mean median uq max neval
# pension_over_all_DT(data) 1.824391 1.950273 2.155805 2.076154 2.321512 2.56687 3
#8) Function to calculate all pensions using vectorisation
#=========================================================
# This applies pension() to data by using vectorisation.
# It widens data into a table wherein each column is
# a vector corresponding to one of pension()'s arguments.
# It then calls exec() to apply pension() to these
# vectors. I had deliberately written pension() so that
# it would work on vector arguments with more than one
# element.
#
pension_over_all_Vect <- function( data )
{
data_widened <-
pivot_wider( data
, names_from = "ad_no"
, names_prefix = "ad"
, values_from = all_of( c("income","age","bad_health") )
) %>%
rename( ad1_inc="income_ad1", ad2_inc="income_ad2",
, ad1_age="age_ad1", ad2_age="age_ad2"
, ad1_bad_health="bad_health_ad1", ad2_bad_health="bad_health_ad2"
) %>%
select( -fam_id )
#
# A table with one row for each family, and one
# column for each of pension()'s arguments.
results <- exec( pension, !!! as.list( data_widened ) )
#
# A vector of results: one pension value for
# each family.
results
}
#9) Try it and time it
#=====================
pensions_Vect <- pension_over_all_Vect( data )
#
# Returns a list of plausible-looking results.
assert_that( are_equal( unlist( pensions_TV ), pensions_Vect ) )
assert_that( are_equal( unlist( pensions_DT $ V1 ), pensions_Vect ) )
#
# Check that this is equal to the previously-
# calculated results.
res <- microbenchmark( pension_over_all_Vect( data ), times=3 )
print( res )
#
# Time it. The mean is 50 milliseconds.
# Unit: milliseconds
# expr min lq mean median uq max neval
# pension_over_all_Vect(data) 35.7834 45.23245 50.8431 54.6815 58.37295 62.0644 3