extract.Rmd

``` r
library(rlang)

grab <- function(x, i, env = baseenv(), inline = FALSE){
  ex <- if (inline) {
    expr((!!`[`)( !!x, !!i) )
  } else {
    expr((!!x)[!!i])
  }
  cat("-------")
  print(match.call())
  cat("str(x) = ")
  str(x)

  res <- try(eval(ex, envir = env), silent = TRUE)
  cat("x[i] = ")
  str(res)
  invisible(NULL)
}

`[.test` <- function(x, i, ...){
  structure(unclass(x)[i, ...], class = "test")
}

GlobalS4Class <- setClass("GlobalS4Class", contains = "integer")
setMethod('[', 'GlobalS4Class', function(x, i, ...){ new("GlobalS4Class", unclass(x)[i, ...])  })

f <- function(){
  here <- environment()
  methods <- getNamespace("methods")
  i <- c(1,2)

  # simple vector
  x <- c(1, 2, 2, 3)
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)

  # with a class
  x <- structure(c(1,2,3,4), class = "withclass")
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)

  # same with a local `[`
  `[.withclass` <- function(x, i, ...){
    structure(unclass(x)[i, ...], class = "withclass")
  }
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)

  # with a class that has an `[` method
  x <- structure(c(1,2,3,4), class = "test")
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)

  # with an S3 defined in a package
  x <- glue::glue("{x}", x = letters)
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)

  # S4 class from a package
  x <- lubridate::hm("10:30", "10:30", "0:0")
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = methods, inline = TRUE)
  grab(x, i, env = methods, inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)

  # S4 class defined locally
  LocalS4Class <- setClass("LocalS4Class", contains = "integer")
  setMethod('[', 'LocalS4Class', function(x, i, ...){ new("LocalS4Class", unclass(x)[i, ...])  })
  on.exit(removeClass("LocalS4Class"))
  x <- new( "LocalS4Class", 1:10)
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)
  grab(x, i, env = methods, inline = TRUE)
  grab(x, i, env = methods, inline = FALSE)

  # S4 class defined locally
  x <- new( "GlobalS4Class", 1:10)
  grab(x, i, env = baseenv(), inline = TRUE)
  grab(x, i, env = baseenv(), inline = FALSE)
  grab(x, i, env = globalenv(), inline = TRUE)
  grab(x, i, env = globalenv(), inline = FALSE)
  grab(x, i, env = here, inline = TRUE)
  grab(x, i, env = here, inline = FALSE)
  grab(x, i, env = methods, inline = TRUE)
  grab(x, i, env = methods, inline = FALSE)
}

f()
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) =  num [1:4] 1 2 2 3
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) =  num [1:4] 1 2 2 3
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) =  num [1:4] 1 2 2 3
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) =  num [1:4] 1 2 2 3
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) =  num [1:4] 1 2 2 3
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) =  num [1:4] 1 2 2 3
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  'withclass' num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) =  'withclass' num [1:4] 1 2 3 4
#> x[i] =  'withclass' num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) =  'test' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) =  'test' num [1:4] 1 2 3 4
#> x[i] =  num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) =  'test' num [1:4] 1 2 3 4
#> x[i] =  'test' num [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) =  'test' num [1:4] 1 2 3 4
#> x[i] =  'test' num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) =  'test' num [1:4] 1 2 3 4
#> x[i] =  'test' num [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) =  'test' num [1:4] 1 2 3 4
#> x[i] =  'test' num [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) =  'glue' chr [1:26] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" ...
#> x[i] =  'glue' chr [1:2] "a" "b"
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) =  'glue' chr [1:26] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" ...
#> x[i] =  'glue' chr [1:2] "a" "b"
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) =  'glue' chr [1:26] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" ...
#> x[i] =  'glue' chr [1:2] "a" "b"
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) =  'glue' chr [1:26] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" ...
#> x[i] =  'glue' chr [1:2] "a" "b"
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) =  'glue' chr [1:26] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" ...
#> x[i] =  'glue' chr [1:2] "a" "b"
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) =  'glue' chr [1:26] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" ...
#> x[i] =  'glue' chr [1:2] "a" "b"
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = methods, inline = TRUE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = methods, inline = FALSE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:3] 0 0 0
#>   ..@ year  : num [1:3] 0 0 0
#>   ..@ month : num [1:3] 0 0 0
#>   ..@ day   : num [1:3] 0 0 0
#>   ..@ hour  : num [1:3] 10 10 0
#>   ..@ minute: num [1:3] 30 30 0
#> x[i] = Formal class 'Period' [package "lubridate"] with 6 slots
#>   ..@ .Data : num [1:2] 0 0
#>   ..@ year  : num [1:2] 0 0
#>   ..@ month : num [1:2] 0 0
#>   ..@ day   : num [1:2] 0 0
#>   ..@ hour  : num [1:2] 10 10
#>   ..@ minute: num [1:2] 30 30
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  'try-error' chr "Error in getGeneric(\"[\") : could not find function \"getGeneric\"\n"
#>  - attr(*, "condition")=List of 2
#>   ..$ message: chr "could not find function \"getGeneric\""
#>   ..$ call   : language getGeneric("[")
#>   ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = methods, inline = TRUE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = methods, inline = FALSE)
#> str(x) = Formal class 'LocalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = TRUE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = baseenv(), inline = FALSE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = TRUE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = globalenv(), inline = FALSE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = TRUE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = here, inline = FALSE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = methods, inline = TRUE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
#> -------grab(x = x, i = i, env = methods, inline = FALSE)
#> str(x) = Formal class 'GlobalS4Class' [package ".GlobalEnv"] with 1 slot
#>   ..@ .Data: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> x[i] =  int [1:2] 1 2
```

Created on 2018-10-01 by the [reprex package](https://reprex.tidyverse.org) (v0.2.1.9000)