r - 在 lapply 中将函数作为参数传递给 FUN

Question

我正在设计一个适合模型的包，该模型涉及矩阵列的基础扩展。我希望扩展是用户定义的，这样任何扩展都是可能的，例如 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

Answer 1

哦，你很接近。您只需要将表达式作为函数即可。

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
}