R 数据帧的非标准子集

对数据框进行子集设置的一个怪癖是，在提到列时，必须重复键入该数据框的名称。例如，数据框

cars

在这里被提到三次：

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

和dplyr一样

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

或

1）子集这只要求

cars

被提及一次。没有使用任何软件包

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

或

使用

attach（）

附加（车辆）
汽车[速度=4，距离<10，]
#速度距离
# 1     4    2

---

我在R learning的早期就被劝阻不要使用

attach（）

，但只要你小心不要引入名称冲突，我认为这应该是可以的。

我知道我完全是在作弊，但从技术上讲它是有效的：）：

with（汽车，数据帧（速度=速度，距离=距离）[速度=4，距离<10，]
#速度距离
# 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
参数的类，如果它是表达式或公式，我们将在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

覆盖子集方法
`[.data.frame`=函数（x，i，j，…）{
如果（！missing（i）&（is.language（i）| | is.symbol（i）| | |继承（i，“公式”））{
if（继承（i，“公式”））i=as.list（i）[[2]]
i=eval（i，x，enclose=baseenv（））
} 
基：`[.data.frame`（x，i，j，…）
}
#####
数据（汽车）
汽车[汽车$speed==4，汽车$dist<10，]
#速度距离
# 1     4    2
#车辆[速度=4，距离<10，]错误
汽车[报价（速度=4，距离<10），]
#速度距离
# 1     4    2
#，或
汽车[~速度==4，距离<10，]
#速度距离
# 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

locally=函数（expr）{
curr_call=as.list（系统调用（1））
如果（作为字符（当前调用[[1]]）==“[”）{
可能是\u df=eval（curr\u调用[[2]]，parent.frame（））
if（is.data.frame（可能是_-df））{
expr=替换（expr）
expr=eval（expr，可能是_df，enclose=baseenv（））
}
}
expr
}
汽车[本地（速度=4，距离<10），]
#速度距离
# 1     4    2
subset
是解决此问题的基本函数。但是，与所有使用非标准求值的基本R函数一样，subset

不能完全执行代码扩展。因此

subset（）

在非全局范围内（例如在lappy循环中）使用时，求值错误的变量

例如，这里我们在两个地方定义变量

var

，首先在值为

40

的全局范围内，然后在值为

30

的局部范围内这里是为了简单起见，但是这在函数中的行为是等价的。直观地说，我们希望

子集

在求值中使用值

30

。但是在执行以下代码时，我们看到的是使用值

40

（因此不返回行）

此版本的子集的行为与

base:：subset.data.frame（）

相同

但是

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

本地({
var[[1]]
#>mpg气缸显示hp drat wt qsec与am齿轮carb
#>菲亚特128 32.4 78.7 66 4.08 2.200 19.47 1 4 1
#>本田思域30.4 4 75.7 52 4.93 1.615 18.52 1 4 2
#>丰田花冠33.9 4 71.1 65 4.22 1.835 19.90 1 4 1
#>莲花欧罗巴30.4 4 95.1 113 3.77 1.513 16.90 1 5 2
#> 
#> [[2]]
#>mpg气缸显示hp drat wt qsec与am齿轮carb
#>菲亚特128 32.4 78.7 66 4.08 2.200 19.47 1 4 1
#>本田思域30.4 4 75.7 52 4.93 1.615 18.52 1 4 2
#>丰田花冠33.9 4 71.1 65 4.22 1.835 19.90 1 4 1
#>莲花欧罗巴30.4 4 95.1 113 3.77 1.513 16.90 1 5 2

这使得非标准评估能够在所有环境中可靠地使用，而不是像以前的方法那样仅在顶级环境中使用

这使得使用非标准求值的函数更加有用。以前，虽然它们很适合交互使用，但在编写函数和包时，您需要使用更详细的标准求值函数。现在，相同的函数可以在所有上下文中使用，而无需修改代码

---

有关非标准评估的更多详细信息，请参见莱昂内尔·亨利的、和小插曲。

关于

with（cars，cars[speed==4&dist<10，]）

@G5W

with（）

需要两次数据帧名称。

cars[eval（substitute（speed==4&dist<10，cars）），]

.dplyr适用于标准数据。framesIsn

子集

答案是什么？@BrodieG最近似乎在考虑tidyverse代码的评估问题上付出了很多努力，我想知道你是否可以将评估部分与tidyverse部分分开。你当然是绝对正确的，但投票表决一个tidyverse代码感觉相当错误swer建议附加。是的，这仍然不是我认可的方法。考虑到这一点，它会让我有一点恶心的感觉。无论如何，它仍然被提到两次，所以你最好使用

（cars，cars[speed==4&dist<10，]）

。更不用说你仍然需要一个电话来分离。

library(sqldf)

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

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

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

library(magrittr)

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

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

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

##### 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

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

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)

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]
}

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

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