data.frames 的非标准子集化

Non-standard subsetting of data.frames

数据框子集的一个怪癖是在提到列时必须重复键入该数据框的名称。例如,数据框cars在这里被提到了3次:

cars[cars$speed == 4 & cars$dist < 10, ]
##   speed dist
## 1     4    2

data.table 包解决了这个问题。

library(data.table)
dt_cars <- as.data.table(cars)
dt_cars[speed == 4 & dist < 10]

dplyr一样。

library(dplyr)
cars %>% filter(speed == 4, dist < 10)

我想知道是否存在针对标准问题 data.frames 的解决方案(也就是说,不求助于 data.tabledplyr)。

我想我正在寻找类似

的东西
cars[MAGIC(speed == 4 & dist < 10), ]

MAGIC(cars[speed == 4 & dist < 10, ])

其中MAGIC待定

我尝试了以下方法,但它给了我一个错误。

library(rlang)
cars[locally(speed == 4 & dist < 10), ]
# Error in locally(speed == 4 & dist < 10) : object 'speed' not found

1) subset 这只需要提到一次cars。没有使用包。

subset(cars, speed == 4 & dist < 10)
##   speed dist
## 1     4    2

2) sqldf 这使用了一个包但不使用 dplyr 或 data.table 这是问题排除的唯一两个包:

library(sqldf)

sqldf("select * from cars where speed = 4 and dist < 10")
##   speed dist
## 1     4    2

3) 赋值 不确定这是否重要,但您可以将 cars 赋值给其他变量名称,例如 .,然后使用它。在那种情况下 cars 只会被提及一次。这不使用包。

. <- cars
.[.$speed == 4 & .$dist < 10, ]
##   speed dist
## 1     4    2

. <- cars
with(., .[speed == 4 & dist < 10, ])
##   speed dist
## 1     4    2

关于这两个解决方案,您可能想查看 Bizarro Pipe 上的这篇文章:http://www.win-vector.com/blog/2017/01/using-the-bizarro-pipe-to-debug-magrittr-pipelines-in-r/

4) magrittr 这也可以用 magrittr 表示,并且该包未被问题排除。请注意,我们正在使用 magrittr %$% 运算符:

library(magrittr)

cars %$% .[speed == 4 & dist < 10, ]
##   speed dist
## 1     4    2

使用attach()

attach(cars)
cars[speed == 4 & dist < 10,]
#   speed dist
# 1     4    2

我在 R 学习的早期就劝阻不要使用 attach(),但只要你注意不要引入名称冲突,我认为它应该没问题。

我知道我完全是在作弊,但从技术上讲它是有效的:):

with(cars, data.frame(speed=speed,dist=dist)[speed == 4 & dist < 10,])
#   speed dist
# 1     4    2

更恐怖:

`[` <- function(x,i,j){
  rm(`[`,envir = parent.frame())
  eval(parse(text=paste0("with(x,x[",deparse(substitute(i)),",])")))
  }
cars[speed == 4 & dist < 10, ]

#   speed dist
# 1     4    2

为 data.frame 覆盖 [ 方法的解决方案。在新方法中,我们检查 i 参数的 class,如果它是表达式或公式,我们将在 data.frame 上下文中评估它。

##### override subsetting method
`[.data.frame` = function (x, i, j, ...) {
    if(!missing(i) && (is.language(i) || is.symbol(i) || inherits(i, "formula"))) {
        if(inherits(i, "formula")) i = as.list(i)[[2]] 
        i = eval(i, x, enclos = baseenv())
    } 
    base::`[.data.frame`(x, i, j, ...)
}

#####

data(cars)
cars[cars$speed == 4 & cars$dist < 10, ]
#     speed dist
# 1     4    2

# cars[speed == 4 & dist < 10, ] # error

cars[quote(speed == 4 & dist < 10),] 
#     speed dist
# 1     4    2


# ,or
cars[~ speed == 4 & dist < 10,]
#     speed dist
# 1     4    2

另一种更神奇的解决方案。请重新启动 R 会话以避免干扰以前的解决方案:

locally = function(expr){
    curr_call = as.list(sys.call(1))
    if(as.character(curr_call[[1]])=="["){
        possibly_df = eval(curr_call[[2]], parent.frame())
        if(is.data.frame(possibly_df)){
            expr = substitute(expr)
            expr = eval(expr, possibly_df, enclos = baseenv())
        }
    }
    expr
}

cars[locally(speed == 4 & dist < 10), ]
#     speed dist
# 1     4    2

subset 是解决这个问题的基本函数。但是,与所有使用非标准评估的基本 R 函数一样,subset 不会执行完全卫生的代码扩展。因此 subset() 在非全局范围内使用时(例如在 lapply 循环中)计算错误的变量。

举个例子,这里我们在两个地方定义了变量var,首先是在全局范围内,值为40,然后是在局部范围内,值为30。此处使用 local() 是为了简单起见,但这在函数内部的行为是等效的。直觉上,我们希望 subset 在评估中使用值 30。但是,在执行以下代码时,我们看到使用的是值 40(因此没有返回任何行)。

var <- 40

local({
  var <- 30
  dfs <- list(mtcars, mtcars)
  lapply(dfs, subset, mpg > var)
})

#> [[1]]
#>  [1] mpg  cyl  disp hp   drat wt   qsec vs   am   gear carb
#> <0 rows> (or 0-length row.names)
#> 
#> [[2]]
#>  [1] mpg  cyl  disp hp   drat wt   qsec vs   am   gear carb
#> <0 rows> (or 0-length row.names)

发生这种情况是因为 subset() 中使用的 parent.frame()lapply() 主体内的环境,而不是本地块。因为所有环境最终都继承自全局环境,所以在那里找到了值为 40.

的变量 var

通过准引用(在 rlang package 中实现)的卫生变量扩展解决了这个问题。我们可以使用在所有上下文中都能正常工作的整洁评估来定义子集的变体。该代码源自 base::subset.data.frame().

的代码,并且在很大程度上与其相同
subset2 <- function (x, subset, select, drop = FALSE, ...) {
  r <- if (missing(subset))
    rep_len(TRUE, nrow(x))
  else {
    r <- rlang::eval_tidy(rlang::enquo(subset), x)
    if (!is.logical(r))
      stop("'subset' must be logical")
    r & !is.na(r)
  }
  vars <- if (missing(select))
    TRUE
  else {
    nl <- as.list(seq_along(x))
    names(nl) <- names(x)
    rlang::eval_tidy(rlang::enquo(select), nl)
  }
  x[r, vars, drop = drop]
}

此版本子集的行为与 base::subset.data.frame() 相同。

subset2(mtcars, gear > 4, disp:wt)
#>                 disp  hp drat    wt
#> Porsche 914-2  120.3  91 4.43 2.140
#> Lotus Europa    95.1 113 3.77 1.513
#> Ford Pantera L 351.0 264 4.22 3.170
#> Ferrari Dino   145.0 175 3.62 2.770
#> Maserati Bora  301.0 335 3.54 3.570

然而 subset2() 不受子集范围问题的影响。在我们前面的示例中,值 30 用于 var,正如我们从词法范围规则中期望的那样。

local({
  var <- 30
  dfs <- list(mtcars, mtcars)
  lapply(dfs, subset2, mpg > var)
})

#> [[1]]
#>                 mpg cyl disp  hp drat    wt  qsec vs am gear carb
#> 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
#> Lotus Europa   30.4   4 95.1 113 3.77 1.513 16.90  1  1    5    2
#> 
#> [[2]]
#>                 mpg cyl disp  hp drat    wt  qsec vs am gear carb
#> 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
#> Lotus Europa   30.4   4 95.1 113 3.77 1.513 16.90  1  1    5    2

这允许在所有上下文中稳健地使用非标准评估,而不仅仅是像以前的方法那样在顶级上下文中使用。

这使得使用非标准评估的函数更加有用。以前虽然它们很适合交互式使用,但在编写函数和包时需要使用更冗长的标准评估函数。现在可以在所有上下文中使用相同的功能,而无需修改代码!

有关非标准评估的更多详细信息,请参阅 Lionel Henry 的 Tidy evaluation (hygienic fexprs) presentation, the rlang vignette on tidy evaluation and the programming with dplyr 小插图。