library(rlang)
Major challenge: How to discriminate between x[j] and x[i, ]?
convert_ij <- function(ij) {
if (is_missing(ij)) {
NULL
} else if (is.null(ij)) {
integer()
} else {
ij
}
}
bracket_args_from_dots <- function(i, j, ...) {
ellipsis::check_dots_empty()
if (nargs() <= 1) {
list(i = NULL, j = convert_ij(maybe_missing(i)))
} else {
list(i = convert_ij(maybe_missing(i)), j = convert_ij(maybe_missing(j)))
}
}
`[.foo` <- function(x, ..., drop = FALSE) {
c(
bracket_args_from_dots(...),
drop = drop
)
}
vctrs::s3_register("base::[", "foo")
foo <- structure(list(), class = "foo")
foo[]
## $i
## NULL
##
## $j
## NULL
##
## $drop
## [1] FALSE
foo[,]
## $i
## NULL
##
## $j
## NULL
##
## $drop
## [1] FALSE
foo[1]
## $i
## NULL
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
foo[, 1]
## $i
## NULL
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
foo[2, ]
## $i
## [1] 2
##
## $j
## NULL
##
## $drop
## [1] FALSE
foo[2, 1]
## $i
## [1] 2
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
bracket_args <- function(..., .parent_call = sys.call(-1)) {
n_unnamed_args <- sum(names2(.parent_call) == "") - 2L
if (n_unnamed_args <= 1) {
list(i = NULL, j = convert_ij(maybe_missing(..1)))
} else {
list(i = convert_ij(maybe_missing(..1)), j = convert_ij(maybe_missing(..2)))
}
}
`[.bar` <- function(x, i, j, drop = FALSE) {
c(
bracket_args(i, j),
drop = drop
)
}
vctrs::s3_register("base::[", "bar")
bar <- structure(list(), class = "bar")
bar[]
## $i
## NULL
##
## $j
## NULL
##
## $drop
## [1] FALSE
bar[,]
## $i
## NULL
##
## $j
## NULL
##
## $drop
## [1] FALSE
bar[1]
## $i
## NULL
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
bar[, 1]
## $i
## NULL
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
bar[2, ]
## $i
## [1] 2
##
## $j
## NULL
##
## $drop
## [1] FALSE
bar[2, 1]
## $i
## [1] 2
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
bracket_args_simple <- function(i, j) {
list(i = convert_ij(maybe_missing(i)), j = convert_ij(maybe_missing(j)))
}
`[.baz` <- function(x, i, j, drop = FALSE) {
n_ij <- nargs() - !missing(drop) <= 0
if (n_ij <= 1) {
args <- bracket_args_simple(missing_arg(), i)
} else {
args <- bracket_args_simple(i, j)
}
c(
args,
drop = drop
)
}
vctrs::s3_register("base::[", "baz")
baz <- structure(list(), class = "baz")
baz[]
## $i
## NULL
##
## $j
## NULL
##
## $drop
## [1] FALSE
baz[,]
## $i
## NULL
##
## $j
## NULL
##
## $drop
## [1] FALSE
baz[1]
## $i
## NULL
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
baz[, 1]
## $i
## NULL
##
## $j
## [1] 1
##
## $drop
## [1] FALSE
baz[2, ]
## $i
## [1] 2
##
## $j
## NULL
##
## $drop
## [1] FALSE
baz[2, 1]
## $i
## [1] 2
##
## $j
## [1] 1
##
## $drop
## [1] FALSE