【问题标题】:Non-standard subsetting of data.framesdata.frames 的非标准子集
【发布时间】:2017-11-10 22:08:34
【问题描述】:

子集数据框的一个怪癖是在提及列时必须重复输入该数据框的名称。比如数据框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

【问题讨论】:

  • with(cars, cars[speed == 4 &amp; dist &lt; 10, ])怎么样
  • @G5W with() 需要两次数据框名称。和cars[eval(substitute(speed == 4 &amp; dist &lt; 10, cars)), ]一样。
  • dplyr 适用于标准 data.frames
  • subset 不是答案吗?
  • @BrodieG 最近似乎在考虑评估 tidyverse 代码方面付出了很多努力,我想知道您是否可以将评估部分与 tidyverse 部分分开。

标签: r evaluation


【解决方案1】:

1) 子集 这只需要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

【讨论】:

    【解决方案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() 主体内的环境,而不是本地块。因为所有环境最终都从全局环境继承,所以变量var 的值是40

    通过准引用(在rlang package 中实现)的卫生变量扩展解决了这个问题。我们可以使用在所有上下文中都能正常工作的整洁评估来定义子集的变体。该代码源自base::subset.data.frame(),并与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) presentationrlang vignette on tidy evaluationprogramming with dplyr 小插图。

    【讨论】:

      【解决方案3】:

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

      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
      

      【讨论】:

        【解决方案4】:

        对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
        

        另一个更神奇的解决方案。请重新启动 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
        

        【讨论】:

          【解决方案5】:

          使用attach()

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

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

          【讨论】:

          • 您当然是绝对正确的,但是赞成建议附加的答案感觉相当错误。
          • 是的,这仍然不是我认可的方法。想想就觉得有点恶心。
          • 无论如何它仍然被提及两次,所以你不妨使用with(cars, cars[speed == 4 &amp; dist &lt; 10, ])。更不用说你仍然需要一个电话来分离。
          猜你喜欢
          • 1970-01-01
          • 2019-09-29
          • 1970-01-01
          • 2015-02-17
          • 2014-12-16
          • 2013-11-30
          • 2012-04-29
          • 1970-01-01
          • 1970-01-01
          相关资源
          最近更新 更多