R公式-如何以紧凑的方式编写具有求和的级数?

时间:2019-07-02 06:58:53

标签: r regression

我需要使用R来拟合Dunham expansion。这意味着我想使用nls()函数来拟合公式

enter image description here

Yk,l为拟合参数。

我当然可以“手动”将其扩展到kl的特定范围,但是我想知道,是否有任何方法可以编写这样的{{3} }以更优雅的方式?

我看过R-formula,但似乎问题的重点在于创建R函数本身,而不是回归函数公式。

1 个答案:

答案 0 :(得分:1)

您可以使用expand.grid()来获得kl的所有组合;然后将每个术语构建为字符串;将paste()collapse参数一起使用以将术语组合成单个字符串;并强制转换为公式:

dunham_formula <- function(k, l) {
  terms <- with(expand.grid(k = k, l = l), {
    glue::glue("y{k}{l} * (v + .5)^{k} * (J * (J + 1))^{l}")
  })

  as.formula(paste("E ~", paste0(terms, collapse = " + ")))
}

dunham_formula(0:1, 0:1)
#> E ~ y00 * (v + 0.5)^0 * (J * (J + 1))^0 + y10 * (v + 0.5)^1 * 
#>     (J * (J + 1))^0 + y01 * (v + 0.5)^0 * (J * (J + 1))^1 + y11 * 
#>     (v + 0.5)^1 * (J * (J + 1))^1
#> <environment: 0x00000000159e58f8>

让我们用一些假数据进行测试:

set.seed(42)
n <- 50

df <- data.frame(
  E = rexp(n),
  v = runif(n),
  J = runif(n)
)

summary(nls(dunham_formula(0:1, 0:1), data = df))
#> Warning in nls(dunham_formula(0:1, 0:1), data = df): No starting values specified for some parameters.
#> Initializing 'y00', 'y10', 'y01', 'y11' to '1.'.
#> Consider specifying 'start' or using a selfStart model
#> 
#> Formula: E ~ y00 * (v + 0.5)^0 * (J * (J + 1))^0 + y10 * (v + 0.5)^1 * 
#>     (J * (J + 1))^0 + y01 * (v + 0.5)^0 * (J * (J + 1))^1 + y11 * 
#>     (v + 0.5)^1 * (J * (J + 1))^1
#> 
#> Parameters:
#>     Estimate Std. Error t value Pr(>|t|)
#> y00  0.11636    1.60105   0.073    0.942
#> y10  0.68614    1.56022   0.440    0.662
#> y01  0.31082    1.61183   0.193    0.848
#> y11  0.05498    1.51326   0.036    0.971
#> 
#> Residual standard error: 1.406 on 46 degrees of freedom
#> 
#> Number of iterations to convergence: 1 
#> Achieved convergence tolerance: 1.81e-07

由于这实际上是线性模型,因此您也可以改成返回基础矩阵的函数,然后使用lm()来拟合模型:

dunham_basis <- function(v, J, k, l) {
  dunham_term <- function(k, l) {
    (v + .5) ^ k * (J * (J + 1)) ^ l
  }

  indices <- expand.grid(k = k, l = l)

  cols <- with(indices, Map(dunham_term, k, l))
  names(cols) <- apply(indices, 1, paste, collapse = ",")

  do.call("cbind", cols)
}

df$Y <- with(df, dunham_basis(v, J, k = 0:1, l = 0:1))

summary(lm(E ~ 0 + Y, data = df))
#> 
#> Call:
#> lm(formula = E ~ 0 + Y, data = df)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -1.5828 -0.7332 -0.3373  0.2736  5.3756 
#> 
#> Coefficients:
#>      Estimate Std. Error t value Pr(>|t|)
#> Y0,0  0.11636    1.60105   0.073    0.942
#> Y1,0  0.68614    1.56022   0.440    0.662
#> Y0,1  0.31082    1.61183   0.193    0.848
#> Y1,1  0.05498    1.51326   0.036    0.971
#> 
#> Residual standard error: 1.406 on 46 degrees of freedom
#> Multiple R-squared:  0.432,  Adjusted R-squared:  0.3826 
#> F-statistic: 8.745 on 4 and 46 DF,  p-value: 2.453e-05

reprex package(v0.3.0)于2019-07-02创建