filtrar - mutate en r

Variables como argumentos por defecto de una función, usando dplyr

Question

Gol

Mi objetivo es definir algunas funciones para usar dentro de los verbos de dplyr , que usan variables predefinidas. Esto se debe a que tengo algunas de estas funciones que toman un montón de argumentos, de los cuales muchos son siempre los mismos nombres de variables.

Mi entendimiento: esto es difícil (y quizás imposible) porque dplyr evaluará perezosamente las variables especificadas por el usuario más adelante, pero cualquier argumento predeterminado no está en la llamada a la función y, por lo tanto, es invisible para dplyr .

Ejemplo de juguete

Considere el siguiente ejemplo, donde uso dplyr para calcular si una variable ha cambiado o no (en este caso, sin sentido):

library(dplyr)
mtcars  %>%
  mutate(cyl_change = cyl != lag(cyl))

Ahora, lag también soporta ordenamiento alternativo como tal:

mtcars  %>%
  mutate(cyl_change = cyl != lag(cyl, order_by = gear))

¿Pero qué pasa si me gustaría crear mi propia versión de lag que siempre ordena por gear ?

Intentos fallidos

El enfoque ingenuo es este:

lag2 <- function(x, n = 1L, order_by = gear) lag(x, n = n, order_by = order_by)

mtcars %>%
  mutate(cyl_change = cyl != lag2(cyl))

Pero esto obviamente plantea el error:

no se encontró ningún objeto llamado ''engranaje''

Las opciones más realistas serían estas, pero tampoco funcionan:

lag2 <- function(x, n = 1L) lag(x, n = n, order_by = ~gear)
lag2 <- function(x, n = 1L) lag(x, n = n, order_by = get(gear))
lag2 <- function(x, n = 1L) lag(x, n = n, order_by = getAnywhere(gear))
lag2 <- function(x, n = 1L) lag(x, n = n, order_by = lazyeval::lazy(gear))

Pregunta

¿Hay alguna forma de que lag2 encuentre correctamente el gear dentro del data.frame en el que dplyr está operando?

• Uno debería poder llamar a lag2 sin tener que proporcionar gear .
• Uno debería poder usar lag2 en los conjuntos de datos que no se llaman mtcars (pero tienen el gear como uno de sus variables).
• Preferiblemente, el gear sería un argumento predeterminado para la función, por lo que aún se puede cambiar si es necesario, pero esto no es crucial.

Answer 1

Aquí está mi respuesta final que realmente terminé usando. Se basa fundamentalmente en una función que inyecta explícitamente cualquier valor de función predeterminado en las expresiones de un objeto de puntos perezosos.

La función completa (con comentarios) está al final de esta respuesta.

Limitaciones:

• Necesita al menos algunos trucos adicionales para que esto funcione bien (ver más abajo).
• Ignora las funciones primitivas, pero no creo que éstas tengan argumentos de función predeterminados.
• Para los genéricos de S3, uno debería usar el método real en su lugar. Como seq.default lugar de seq.default Si el objetivo es la inyección de valores predeterminados en sus propias funciones, entonces esto generalmente no será un gran problema.

Por ejemplo, uno puede usar esta función así:

dots <- lazyeval::all_dots(a = ~x, b = ~lm(y ~ x, data = d))
add_defaults_to_dots(dots)

$a
<lazy>
  expr: x
  env:  <environment: R_GlobalEnv>

$b
<lazy>
  expr: lm(formula = y ~ x, data = d, subset = , weights = , na.action = ,  ...
  env:  <environment: R_GlobalEnv>

Podemos resolver el problema de los juguetes de la pregunta de varias maneras. Recuerda la nueva función y el caso de uso ideal:

lag2 <- function(x, n = 1L, order_by = gear) lag(x, n = n, order_by = order_by)

mtcars %>%
  mutate(cyl_change = cyl != lag2(cyl))

1. Usa mutate_ con dots directamente:

   dots <- lazyeval::all_dots(cyl_change = ~cyl != lag2(cyl), all_named = TRUE)
   dots <- add_defaults_to_dots(dots)
   mtcars %>% mutate_(.dots = dots)

2. Redefinir la mutate para incluir la adición de valores predeterminados.

   mutate2 <- function(.data, ...) {
     dots <- lazyeval::lazy_dots(...)
     dots <- add_defaults_to_dots(dots)
     dplyr::mutate_(.data, .dots = dots)
   }
   
   mtcars %>% mutate2(cyl_change = cyl != lag2(cyl))

3. Use S3 Dispatch para hacer esto como predeterminado para cualquier clase personalizada:

   mtcars2 <- mtcars
   class(mtcars2) <- c(''test'', ''data.frame'')
   
   mutate_.test <- function(.data, ..., .dots) {
     dots <- lazyeval::all_dots(.dots, ..., all_named = TRUE)
     dots <- add_defaults_to_dots(dots)
     dplyr::mutate_(tibble::as_tibble(.data), .dots = dots)
   }
   mtcars2 %>% mutate(cyl_change = cyl != lag2(cyl))

Dependiendo del caso de uso, creo que las opciones 2 y 3 son las mejores formas de lograr esto. La opción 3 en realidad tiene el caso de uso sugerido completo, pero se basa en una clase S3 adicional.

Función:

add_defaults_to_dots <- function(dots) {
  # A recursive function that continues to add defaults to lower and lower levels.
  add_defaults_to_expr <- function(expr) {
    # First, if a call is a symbol or vector, there is nothing left to do but
    # return the value (since it is not a function call).
    if (is.symbol(expr) | is.vector(expr) | class(expr) == "formula") {
      return(expr)
    }
    # If it is a function however, we need to extract it.
    fun <- expr[[1]]
    # If it is a primitive function (like `+`) there are no defaults, and we
    # should not manipulate that call, but we do need to use recursion for cases
    # like a + f(b).
    if (is.primitive(match.fun(fun))) {
      new_expr <- expr
    } else {
      # If we have an actual non-primitive function call, we formally match the
      # call, so abbreviated arguments and order reliance work.
      matched_expr <- match.call(match.fun(fun), expr, expand.dots = TRUE)
      expr_list <- as.list(matched_expr)
      # Then we find the default arguments:
      arguments <- formals(eval(fun))
      # And overwrite the defaults for which other values were supplied:
      given <- expr_list[-1]
      arguments[names(given)] <- given
      # And finally build the new call:
      new_expr <- as.call(c(fun, arguments))
    }
    # Then, for all function arguments we run the function recursively.
    new_arguments <- as.list(new_expr)[-1]
    null <- sapply(new_arguments, is.null)
    new_arguments[!null] <- lapply(new_arguments[!null], add_defaults_to_expr)
    new_expr <- as.call(c(fun, new_arguments))
    return(new_expr)
  }
  # For lazy dots supplied, separate the expression and environments.
  exprs <- lapply(dots, `[[`, ''expr'')
  envrs <- lapply(dots, `[[`, ''env'')
  # Add the defaults to the expressions.
  new_exprs <- lapply(exprs, add_defaults_to_expr)
  # Add back the correct environments.
  new_calls <- Map(function(x, y) {
    lazyeval::as.lazy(x, y)
  }, new_exprs, envrs)
  return(new_calls)
}

Answer 2

Aquí hay dos enfoques en la data.table de data.table , sin embargo, no creo que ninguno de los dos funcione en dplyr en el presente.

En data.table , todo lo que esté dentro de la j-expression (el segundo argumento de [.data.table ) se analiza primero en el paquete data.table , y no en el analizador R regular. En cierto modo, puedes considerarlo como un analizador de lenguaje independiente que vive dentro del analizador de lenguaje regular que es R. Lo que hace este analizador es buscar las variables que has utilizado que son realmente columnas de la data.table que estás data.table . en, y lo que sea que encuentre lo pone en el entorno de la j-expression .

Lo que esto significa es que debe informar a este analizador de alguna manera que se utilizará el equipo, o simplemente no será parte del entorno. A continuación se presentan dos ideas para lograr eso.

La forma "simple" de hacerlo, es usar el nombre de la columna en la j-expression donde llamas lag2 (además de algunos lag2 en lag2 ):

dt = as.data.table(mtcars)

lag2 = function(x) lag(x, order_by = get(''gear'', sys.frame(4)))

dt[, newvar := {gear; lag2(cyl)}]
# or
dt[, newvar := {.SD; lag2(cyl)}]

Esta solución tiene 2 propiedades indeseables en primer lugar, no estoy seguro de qué tan frágil es sys.frame(4) : pones esto en una función o en un paquete y no sé qué sucederá. Probablemente puedas evitarlo y descifrar el marco correcto, pero es una especie de dolor. En segundo lugar, debe mencionar la variable particular en la que está interesado, en cualquier lugar de la expresión, o .SD en el entorno utilizando .SD , de nuevo en cualquier lugar.

Una segunda opción que me gusta más es aprovechar el hecho de que el analizador data.table evalúa las expresiones eval en su lugar antes de la búsqueda de variables, por lo que si usa una variable dentro de alguna expresión que eval , eso funcionaría:

lag3 = quote(function(x) lag(x, order_by = gear))

dt[, newvar := eval(lag3)(cyl)]

Esto no sufre los problemas de la otra solución, con la obvia desventaja de tener que escribir una eval adicional.

Answer 3

Esta solución se acerca:

Considere un ejemplo de juguete un poco más fácil:

mtcars %>%
  mutate(carb2 = lag(carb, order_by = gear))

Todavía utilizamos el argumento de lag y order_by , pero no hacemos ningún cálculo adicional con él. En lugar de apegarnos a la mutate SE, cambiamos a NSE mutate_ y hacemos que lag2 construya una llamada de función como un vector de caracteres.

lag2 <- function(x, n = 1, order_by = gear) {
  x <- deparse(substitute(x))
  order_by <- deparse(substitute(order_by))
  paste0(''dplyr::lag(x = '', x, '', n = '', n, '', order_by = '', order_by, '')'')
}

mtcars %>%
  mutate_(carb2 = lag2(carb))

Esto nos da un resultado idéntico al anterior.

El ejemplo de juguete original se puede lograr con:

mtcars %>%
  mutate_(cyl_change = paste(''cyl !='', lag2(cyl)))

Desventajas:

1. Tenemos que usar el mutate_ SE.
2. Para uso extendido como en el ejemplo original, también necesitamos usar paste .
3. Esto no es particularmente seguro, es decir, no está inmediatamente claro de dónde debe venir el equipo. Asignar valores a gear o carb en el entorno global parece estar bien, pero supongo que en algunos casos podrían ocurrir errores inesperados. Usar una fórmula en lugar de un vector de caracteres sería más seguro, pero esto requiere que se asigne el entorno correcto para que funcione, y eso sigue siendo un gran interrogante para mí.

Answer 4

Esto no es elegante, ya que requiere un argumento extra. Pero, al pasar todo el marco de datos obtenemos casi el comportamiento requerido

lag2 <- function(x, df, n = 1L, order_by = df[[''gear'']], ...) {
  lag(x, n = n, order_by = order_by, ...)
}

hack <- mtcars  %>%  mutate(cyl_change = cyl != lag2(cyl, .))
ans <- mtcars  %>%  mutate(cyl_change = cyl != lag(cyl, order_by = gear))
all.equal(hack, ans)
# [1] TRUE

1. Uno debería poder llamar a lag2 sin tener que proporcionar equipo.

Sí, pero tienes que pasar . .

2. Uno debería poder usar lag2 en los conjuntos de datos que no se llaman mtcars (pero tienen el engranaje como uno de sus variables).

Esto funciona.

3. Preferiblemente, el engranaje sería un argumento predeterminado para la función, por lo que aún se puede cambiar si es necesario, pero esto no es crucial.

Esto también funciona:

hack_nondefault <- mtcars %>%  mutate(cyl_change = cyl != lag2(cyl, order_by = cyl))
ans_nondefault <- mtcars %>%  mutate(cyl_change = cyl != lag(cyl, order_by = cyl))
all.equal(hack_nondefault, ans_nondefault)
# [1] TRUE

Tenga en cuenta que si da manualmente order_by , especificando df con el . ya no es necesario y el uso se vuelve idéntico al lag original (lo cual es muy bueno).

Apéndice

Parece difícil evitar el uso de SE mutate_ como en la respuesta planteada por el OP, hacer algunas piraterías simples como en mi respuesta aquí, o hacer algo más avanzado que involucre la ingeniería inversa lazyeval::lazy_dots .

Evidencia:

1) dplyr::lag sí no utiliza ninguna magia NSE

2) mutate simplemente llama a mutate_(.data, .dots = lazyeval::lazy_dots(...))

Answer 5

También puede resolver su problema de la siguiente manera:

library(dplyr)

lag2 <- function(df, x, n = 1L, order_by = gear) {
  order_var <- enquo(order_by)
  x <- enquo(x)
  var_name <- paste0(quo_name(x), "_change")

  df %>% 
    mutate(!!var_name := lag(!!x, n = n, order_by = !!order_var))
}

mtcars %>%
  lag2(cyl)

# A tibble: 32 x 12
#      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb cyl_change
#    <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          8
#  2  21       6  160    110  3.9   2.88  17.0     0     1     4     4          6
#  3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1          6
#  4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1         NA
#  5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2          6
#  6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1          8
#  7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4          6
#  8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2          4
#  9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2          4
# 10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4          4
# ... with 22 more rows

Soy consciente de que, una vez más, el marco de datos debe transmitirse en la función, pero de esa manera, el entorno donde se espera la gear es más claro. Además, la naturaleza de la tubería se conserva muy bien, así como la definición automática del nombre de la nueva variable.

Comentario: Estoy bastante seguro de que esta solución no estaba disponible la primera vez que publicó esta pregunta, pero no obstante, puede ser bueno mantener esto aquí para futuras consultas.