在 lapply 中将函数作为参数传递给 FUN
Passing a function as an argument to FUN in lapply
我正在设计一个适合模型的包，该模型涉及矩阵列的基础扩展。我希望扩展是用户定义的，这样任何扩展都是可能的，例如 splines::bs、splines::ns、stats::poly。相同的扩展将应用于矩阵的每一列。我尝试了 eval 和 substitute 的一些组合，但无法让它在嵌套函数中工作。
我想做什么
set.seed(123)
(mat <- replicate(4, rnorm(10)))
#> [,1] [,2] [,3] [,4]
#> [1,] -0.56047565 1.2240818 -1.0678237 0.42646422
#> [2,] -0.23017749 0.3598138 -0.2179749 -0.29507148
#> [3,] 1.55870831 0.4007715 -1.0260044 0.89512566
#> [4,] 0.07050839 0.1106827 -0.7288912 0.87813349
#> [5,] 0.12928774 -0.5558411 -0.6250393 0.82158108
#> [6,] 1.71506499 1.7869131 -1.6866933 0.68864025
#> [7,] 0.46091621 0.4978505 0.8377870 0.55391765
#> [8,] -1.26506123 -1.9666172 0.1533731 -0.06191171
#> [9,] -0.68685285 0.7013559 -1.1381369 -0.30596266
#> [10,] -0.44566197 -0.4727914 1.2538149 -0.38047100
fit <- function(x, expr = splines::bs(i, df = 5)) {
nvars <- ncol(x)
x <- scale(x, center = TRUE, scale = FALSE)
design <- design_mat(x = x, expr = expr, nvars = nvars)
# then fit some model on design
}
design_mat <- function(x, expr, nvars) {
lapply(seq_len(nvars), function(j) expr(x[, j]))
}
fit(x = mat)
#> Error in splines::bs(i, df = 5): object 'i' not found
我试过的
set.seed(123)
mat <- replicate(4, rnorm(10))
fit <- function(x, expr = splines::bs(i, df = 5)) {
sexpr <- substitute(expr)
sexpr[[2]] <- substitute(x[,j])
lapply(seq_len(ncol(x)), function(j) eval(sexpr))
}
result <- fit(x = mat)
lapply(result, head)
#> [[1]]
#> 1 2 3 4 5
#> [1,] 0.2869090697 0.6076093707 0.10273054 0.000000000 0.0000000
#> [2,] 0.0415525644 0.6427602520 0.31195968 0.003727506 0.0000000
#> [3,] 0.0000000000 0.0003743454 0.01981069 0.247406189 0.7324088
#> [4,] 0.0001816776 0.4352403899 0.51334496 0.051232973 0.0000000
#> [5,] 0.0000000000 0.3905258786 0.53866977 0.070804348 0.0000000
#> [6,] 0.0000000000 0.0000000000 0.00000000 0.000000000 1.0000000
#>
#> [[2]]
#> 1 2 3 4 5
#> [1,] 0.0000000000 0.02198301 0.3045954 0.49460707 0.1788145
#> [2,] 0.0011185047 0.35509930 0.6295682 0.01421403 0.0000000
#> [3,] 0.0003890728 0.32724596 0.6499248 0.02244016 0.0000000
#> [4,] 0.0246803968 0.50883712 0.4664825 0.00000000 0.0000000
#> [5,] 0.2872342378 0.53361187 0.1461208 0.00000000 0.0000000
#> [6,] 0.0000000000 0.00000000 0.0000000 0.00000000 1.0000000
#>
#> [[3]]
#> 1 2 3 4 5
#> [1,] 0.35168337 0.5649939 0.08306911 0.000000000 0
#> [2,] 0.00000000 0.3231237 0.55125784 0.125618496 0
#> [3,] 0.30267559 0.5962519 0.10107251 0.000000000 0
#> [4,] 0.07651472 0.6370926 0.28014756 0.006245077 0
#> [5,] 0.03869768 0.5949041 0.35104880 0.015349416 0
#> [6,] 0.00000000 0.0000000 0.00000000 0.000000000 0
#>
#> [[4]]
#> 1 2 3 4 5
#> [1,] 0.02100644 2.785920e-01 0.530958302 0.1694432 0.0000000
#> [2,] 0.55111536 5.535714e-02 0.001433639 0.0000000 0.0000000
#> [3,] 0.00000000 0.000000e+00 0.000000000 0.0000000 1.0000000
#> [4,] 0.00000000 1.946324e-05 0.004217654 0.2228812 0.7728817
#> [5,] 0.00000000 1.578049e-03 0.068681551 0.6628659 0.2668745
#> [6,] 0.00000000 3.492500e-02 0.350034463 0.6150405 0.0000000
哦，你很接近。你只需要表达式是一个函数。
fit <- function(x, expr = function(i) splines::bs(i, df = 5)) {
nvars <- ncol(x)
x <- scale(x, center = TRUE, scale = FALSE)
design <- design_mat(x = x, expr = expr, nvars = nvars)
# then fit some model on design
}
这是另一个使用 non-standard 评估来更改调用 splines::bs(x, df = 6) 的解决方案。基本思想依赖于使用 rlang 包来更改从用户那里捕获的 抽象语法树 。这是解决方案；详情如下：
fit <- function(expr = splines::bs(x, df = 6)) {
sexpr <- rlang::enexpr(expr)
new_expr <- call2(sexpr[[1]],
call2(`[`, sexpr[[2]],
call2(seq_len,
call2(nrow,
sexpr[[2]])),
sym("i")),
splice(as.list(sexpr)[-c(1:2)]))
seq_col <- call2(seq_len, call2(ncol, sexpr[[2]]))
design <- lapply(eval(seq_col), function(i) eval(new_expr))
# then fit some model on design
}
详情
用户提供的表达式
splines::bs(x, df = 6)
你想导出的表达式
splines::bs(x[,i], df = 6)
我们将使用函数 rlang::call2 创建一个函数调用，然后使用 base::eval.
对其求值
1。捕获用户的表情
这很简单：sexpr <- rlang::enexpr(expr)。现在我们可以提取函数作为list-like对象sexpr的第一个槽位，其他槽位对应传递给这个函数的参数
2。创建x[,i]
我们首先需要以前缀形式重写：`[`(x, seq_len(nrow(x)), i)。我们现在看到我们有三个嵌套函数。我们可以创建第一个调用 nrow(x)，如下所示：call2(nrow, sym("x"))。但是回想一下，符号 sym("x") 也可以从 sexpr 的第二个槽中提取出来，它给出 call2(nrow, sexpr[[2]])。继续这样下去，我们可以得到x[,i]如下：
call2(`[`,
sexpr[[2]],
call2(seq_len,
call2(nrow,
sexpr[[2]])),
sym("i"))
3。创建splines::bs(x[,i], df = 6)
这很棘手，因为我们需要跟踪额外的参数。为此，我们可以使用函数 rlang::splice。如果我们让 foo 成为上面步骤 2 中创建的表达式，我们可以写成
`call2(sexpr[[1]], foo, splice(as.list(sexpr)[-c(1:2)]))`
请注意，我们从 sexpr 中删除了第一个和第二个槽，它们分别对应于函数和矩阵 x。
4。创建seq_len(ncol(x))
我们现在很擅长：call2(seq_len, call2(ncol, sexpr[[2]]))
5。综合起来评价
这是最后一行lapply(eval(seq_col), function(i) eval(new_expr))
我正在设计一个适合模型的包，该模型涉及矩阵列的基础扩展。我希望扩展是用户定义的，这样任何扩展都是可能的，例如 splines::bs、splines::ns、stats::poly。相同的扩展将应用于矩阵的每一列。我尝试了 eval 和 substitute 的一些组合，但无法让它在嵌套函数中工作。
我想做什么
set.seed(123)
(mat <- replicate(4, rnorm(10)))
#> [,1] [,2] [,3] [,4]
#> [1,] -0.56047565 1.2240818 -1.0678237 0.42646422
#> [2,] -0.23017749 0.3598138 -0.2179749 -0.29507148
#> [3,] 1.55870831 0.4007715 -1.0260044 0.89512566
#> [4,] 0.07050839 0.1106827 -0.7288912 0.87813349
#> [5,] 0.12928774 -0.5558411 -0.6250393 0.82158108
#> [6,] 1.71506499 1.7869131 -1.6866933 0.68864025
#> [7,] 0.46091621 0.4978505 0.8377870 0.55391765
#> [8,] -1.26506123 -1.9666172 0.1533731 -0.06191171
#> [9,] -0.68685285 0.7013559 -1.1381369 -0.30596266
#> [10,] -0.44566197 -0.4727914 1.2538149 -0.38047100
fit <- function(x, expr = splines::bs(i, df = 5)) {
nvars <- ncol(x)
x <- scale(x, center = TRUE, scale = FALSE)
design <- design_mat(x = x, expr = expr, nvars = nvars)
# then fit some model on design
}
design_mat <- function(x, expr, nvars) {
lapply(seq_len(nvars), function(j) expr(x[, j]))
}
fit(x = mat)
#> Error in splines::bs(i, df = 5): object 'i' not found
我试过的
set.seed(123)
mat <- replicate(4, rnorm(10))
fit <- function(x, expr = splines::bs(i, df = 5)) {
sexpr <- substitute(expr)
sexpr[[2]] <- substitute(x[,j])
lapply(seq_len(ncol(x)), function(j) eval(sexpr))
}
result <- fit(x = mat)
lapply(result, head)
#> [[1]]
#> 1 2 3 4 5
#> [1,] 0.2869090697 0.6076093707 0.10273054 0.000000000 0.0000000
#> [2,] 0.0415525644 0.6427602520 0.31195968 0.003727506 0.0000000
#> [3,] 0.0000000000 0.0003743454 0.01981069 0.247406189 0.7324088
#> [4,] 0.0001816776 0.4352403899 0.51334496 0.051232973 0.0000000
#> [5,] 0.0000000000 0.3905258786 0.53866977 0.070804348 0.0000000
#> [6,] 0.0000000000 0.0000000000 0.00000000 0.000000000 1.0000000
#>
#> [[2]]
#> 1 2 3 4 5
#> [1,] 0.0000000000 0.02198301 0.3045954 0.49460707 0.1788145
#> [2,] 0.0011185047 0.35509930 0.6295682 0.01421403 0.0000000
#> [3,] 0.0003890728 0.32724596 0.6499248 0.02244016 0.0000000
#> [4,] 0.0246803968 0.50883712 0.4664825 0.00000000 0.0000000
#> [5,] 0.2872342378 0.53361187 0.1461208 0.00000000 0.0000000
#> [6,] 0.0000000000 0.00000000 0.0000000 0.00000000 1.0000000
#>
#> [[3]]
#> 1 2 3 4 5
#> [1,] 0.35168337 0.5649939 0.08306911 0.000000000 0
#> [2,] 0.00000000 0.3231237 0.55125784 0.125618496 0
#> [3,] 0.30267559 0.5962519 0.10107251 0.000000000 0
#> [4,] 0.07651472 0.6370926 0.28014756 0.006245077 0
#> [5,] 0.03869768 0.5949041 0.35104880 0.015349416 0
#> [6,] 0.00000000 0.0000000 0.00000000 0.000000000 0
#>
#> [[4]]
#> 1 2 3 4 5
#> [1,] 0.02100644 2.785920e-01 0.530958302 0.1694432 0.0000000
#> [2,] 0.55111536 5.535714e-02 0.001433639 0.0000000 0.0000000
#> [3,] 0.00000000 0.000000e+00 0.000000000 0.0000000 1.0000000
#> [4,] 0.00000000 1.946324e-05 0.004217654 0.2228812 0.7728817
#> [5,] 0.00000000 1.578049e-03 0.068681551 0.6628659 0.2668745
#> [6,] 0.00000000 3.492500e-02 0.350034463 0.6150405 0.0000000
哦，你很接近。你只需要表达式是一个函数。
fit <- function(x, expr = function(i) splines::bs(i, df = 5)) {
nvars <- ncol(x)
x <- scale(x, center = TRUE, scale = FALSE)
design <- design_mat(x = x, expr = expr, nvars = nvars)
# then fit some model on design
}
这是另一个使用 non-standard 评估来更改调用 splines::bs(x, df = 6) 的解决方案。基本思想依赖于使用 rlang 包来更改从用户那里捕获的 抽象语法树 。这是解决方案；详情如下：
fit <- function(expr = splines::bs(x, df = 6)) {
sexpr <- rlang::enexpr(expr)
new_expr <- call2(sexpr[[1]],
call2(`[`, sexpr[[2]],
call2(seq_len,
call2(nrow,
sexpr[[2]])),
sym("i")),
splice(as.list(sexpr)[-c(1:2)]))
seq_col <- call2(seq_len, call2(ncol, sexpr[[2]]))
design <- lapply(eval(seq_col), function(i) eval(new_expr))
# then fit some model on design
}
详情
用户提供的表达式
splines::bs(x, df = 6)
你想导出的表达式
splines::bs(x[,i], df = 6)
我们将使用函数 rlang::call2 创建一个函数调用，然后使用 base::eval.
1。捕获用户的表情
这很简单：sexpr <- rlang::enexpr(expr)。现在我们可以提取函数作为list-like对象sexpr的第一个槽位，其他槽位对应传递给这个函数的参数
2。创建x[,i]
我们首先需要以前缀形式重写：`[`(x, seq_len(nrow(x)), i)。我们现在看到我们有三个嵌套函数。我们可以创建第一个调用 nrow(x)，如下所示：call2(nrow, sym("x"))。但是回想一下，符号 sym("x") 也可以从 sexpr 的第二个槽中提取出来，它给出 call2(nrow, sexpr[[2]])。继续这样下去，我们可以得到x[,i]如下：
call2(`[`,
sexpr[[2]],
call2(seq_len,
call2(nrow,
sexpr[[2]])),
sym("i"))
3。创建splines::bs(x[,i], df = 6)
这很棘手，因为我们需要跟踪额外的参数。为此，我们可以使用函数 rlang::splice。如果我们让 foo 成为上面步骤 2 中创建的表达式，我们可以写成
`call2(sexpr[[1]], foo, splice(as.list(sexpr)[-c(1:2)]))`
请注意，我们从 sexpr 中删除了第一个和第二个槽，它们分别对应于函数和矩阵 x。
4。创建seq_len(ncol(x))
我们现在很擅长：call2(seq_len, call2(ncol, sexpr[[2]]))
5。综合起来评价
这是最后一行lapply(eval(seq_col), function(i) eval(new_expr))