In DeependraD/expdean: Collection of Design and Analysis Functions for Agriculture and Related Fields Data

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

knitr::opts_chunk$set(echo = TRUE)
library(expdean)

This vignette dives deeply into metaprogramming. This draws from resources available online, mainly the following:

• Tidy eval webinar with Nicholas May
• Expressions; Advanced R

expr() and exprs() capture expressions that you supply:

rlang::expr(symbol)
rlang::exprs(several, such, symbols)

enexpr() and enexprs() capture expressions that your user supplied:

expr_inputs <- function(arg, ...) {
  user_exprs <- enexprs(arg, ...)
  user_exprs
}
expr_inputs(hello)
expr_inputs(hello, bonjour, ciao)

ensym() and ensyms() provide additional type checking to ensure the user calling your function has supplied bare object names:

sym_inputs <- function(...) {
  user_symbols <- ensyms(...)
  user_symbols
}
sym_inputs(hello, "bonjour")
## sym_inputs(say(hello))  # Error: Must supply symbols or strings
expr_inputs(say(hello))

All these quoting functions have quasiquotation support. This means that you can unquote (evaluate and inline) part of the captured expression:

what <- sym("bonjour")
expr(say(what))
expr(say(!!what))

This also applies to expressions supplied by the user. This is like an escape hatch that allows control over the captured expression:

expr_inputs(say(!!what), !!what)

Finally, you can capture expressions as quosures. A quosure is an object that contains both the expression and its environment:

quo <- quo(letters)
quo

rlang::get_expr(quo)
rlang::get_env(quo)

Quosures can be evaluated with eval_tidy():

rlang::eval_tidy(quo)

They have the nice property that you can pass them around from context to context (that is, from function to function) and they still evaluate in their original environment:

multiply_expr_by_10 <- function(expr) {
  # We capture the user expression and its environment:
  # expr <- enquo(expr)
  expr <- enexpr(expr)

  # Then create an object that only exists in this function:
  local_ten <- 10

  # Now let's create a multiplication expression that (a) inlines
  # the user expression as LHS (still wrapped in its quosure) and
  # (b) refers to the local object in the RHS:
  quo(!!expr * local_ten)
}
quo <- multiply_expr_by_10(2 + 3)

The local parts of the quosure are printed in colour if your terminal is capable of displaying colours:

quo

All the quosures in the expression evaluate in their original context. The local objects are looked up properly and we get the expected result:

rlang::eval_tidy(quo)

simple_df <- readr::read_csv("./data/00 Sample RCBD data.csv", na = ".")
simple_df <- simple_df %>% 
  mutate_at(c("Country", "Location", "Rep", "Genotype"), as.factor)

h2_blue <- heritability_n_blues(df = simple_df, grouping_var = `Location`, 
                     grouping_items_sel = c("Karaj", "Beijin", "Chihuahua"), 
                     dependent_var = `YLD`, genotype_var = Genotype, covariate = `TGW`,
                     replication_var = `Rep`)

h2_blue

simple_df %>% head()

In the data given above (simple_df), let us construct a tidyverse helper function that generates mean for a given grouping variable.

mean_var_grouped <- function(data, grouping_var, summarized_var){
  grouping_var_quo <- enquo(grouping_var)
  summarized_var_quo <- enquo(summarized_var)
  summarized_var_out_quo <- paste0("mean_", quo_name(summarized_var_quo))
  print(summarized_var_out_quo)

  data %>% 
    group_by(!!grouping_var_quo) %>% 
    summarize(!! summarized_var_out_quo := mean(!!summarized_var_quo, na.rm = TRUE))
}

mean_var_grouped(data = simple_df, grouping_var = Location, summarized_var = `YLD`)

# # if ensym is used, following works as well
# mean_var_grouped(data = simple_df, grouping_var = "Location", summarized_var = "TGW")

If more than one variable needs to be summarized simulataneously with same function/s we need to convert the variable names to symbols first.

mean_var_grouped <- function(data, grouping_var, summarized_var, funks){
  grouping_var_quo <- enquo(grouping_var)
  summarized_var_syms <- syms(summarized_var)
  print(summarized_var_syms)
  # summarized_var_out_quo <- paste0("mean_", quo_name(summarized_var_quo))
  # print(summarized_var_out_quo)

  # quote functions as expressions
  fun_exprs <- enexpr(funks)[-1] # omit first from c(list, min, max )
  as.list(fun_exprs)

  map_dfc(fun_exprs, 
          function(fun){
            map_dfc(summarized_var_syms, 
                    function(summarized_var_sym){
                      data %>%
                        summarize(
                          !!paste0(fun, "_", summarized_var_sym) :=
                            (!!fun)(!!summarized_var_sym, na.rm = TRUE)
                        )
                    })
          })

}

mean_var_grouped(data = simple_df, grouping_var = Location, summarized_var = c("YLD", "TGW"), funks = list(min, max, mean))

Reducing sparsity

coalesce_all_ift_fields <- function(df, irrel_fields) {
  # Get initial visit field names, follow-up names, and telephone names
  ift_fields <- names(df)[-which(irrel_fields %in% names(df))]

  # Reduce initial, follow-up, telephone visit fields to initial fields only
  i_fields <- reduce_ift_fieldnames(ift_fields)

  # Convert initial field strings to symbol expressions
  i_fields_syms <- syms(i_fields)

  # Map over intial visit field symbols, coalescing IFT fields
  # Each iteration returns coalesced field, column-bound to other coal'd fields
  map_dfc(i_fields_syms,
          function(i_field_sym) {
            f_field_sym <- sym(paste0("fu_", i_field_sym))
            t_field_sym <- sym(paste0("tele_", i_field_sym))

            df %>% 
              select(!!i_field_sym, !!f_field_sym, !!t_field_sym) %>% 
              mutate(!!i_field_sym := 
                       coalesce(!!i_field_sym, !!f_field_sym, !!t_field_sym)) %>% 
              select(-!!f_field_sym, -!!t_field_sym)
          }) %>% 
    # attach `irrel_fields` to the front of the returned data frame
    bind_cols(df[, irrel_fields], .) 
}

# refer to example from Nicholas May's tutorial

Notes

• It is better to use ensym() in a dataframe context (for example when quoting column names), because it can capture symbolic names and works with strings.

DeependraD/expdean documentation built on Nov. 25, 2019, 12:33 a.m.