2

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

2 回答 2

5

哦，你已经接近了。你只需要表达式是一个函数。

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
}
于 2018-03-28T20:51:35.330 回答
1

这是另一种使用非标准评估来更改调用的解决方案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). 现在我们可以将函数提取为类列表对象的第一个槽，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))

于 2018-03-29T01:01:59.157 回答