Question

考虑R中的非线性最小二乘模型，例如以下形式：

 y ~ theta / ( 1 + exp( -( alpha + beta * x) ) )

（我真正的问题有几个变量，外部函数不是逻辑但更复杂;这个更简单，但我想如果我能做到这一点，我的情况应该几乎立即跟进）

我想用（例如）自然三次样条替换术语“alpha + beta * x”。

这里有一些代码用于在逻辑中创建一些具有非线性函数的示例数据：

set.seed(438572L)
x <- seq(1,10,by=.25)
y <- 8.6/(1+exp( -(-3+x/4.4+sqrt(x*1.1)*(1.-sin(1.+x/2.9))) )) + rnorm(x, s=0.2 )

不需要围绕它进行逻辑运算，如果我在lm中，我可以轻松地用样条项代替线性项;所以线性模型是这样的：

 lm( y ~ x )

然后变成

 library("splines")
 lm( y ~ ns( x, df = 5 ) )

生成拟合值很简单，并借助于得到预测值（for 例如，rms包似乎很简单。

事实上，将原始数据与基于lm的样条拟合拟合并不是太糟糕，但我有理由在逻辑函数中需要它（或者更确切地说，在我的问题中等效）。

nls的问题是我需要为所有参数提供名称（我很高兴为他们调用一个样条拟合（b1，...，b5）（并说c1，...，c6）对于另一个变量 - 我需要能够制作其中的几个变量。）

是否有合理的方法来生成nls的相应公式，以便我可以用样条函数替换非线性函数内的线性项？

我能想到的唯一方法就是可以做到这一点有点尴尬和笨重，如果不编写一大堆代码就不能很好地概括。

（编辑以澄清）对于这个小问题，我当然可以手工完成 - 为 ns生成的矩阵中的每个变量的内积写出一个表达式，乘以参数向量。但是，我必须为每个其他变量中的每个样条再次逐个编写整个项目，并且每次我在任何样条曲线中更改df时再次编写，并且如果我想使用cs而不是ns，则再次。然后，当我想尝试做一些预测（/插值）时，我们会得到一系列新的问题需要处理。我需要一遍又一遍地继续这样做，并且可能需要大量的结和几个变量，以便在分析后进行分析 - 我想知道是否有一种比写出每个单独术语更简洁，更简单的方法，无需编写大量代码。我可以看到一个相当牛逼的方式，这将涉及到相当多的代码，但是作为R，我怀疑有更简洁的方式（或更可能是3或4个更简洁的方式）只是躲避我。因此问题。

我以为我曾经看到有人在过去以相当不错的方式做过这样的事情，但是对于我的生活，我现在找不到它;我已经尝试了很多次来找到它。

[更具体地说，我通常希望能够在每个变量中尝试拟合几种不同的样条 - 尝试几种可能性 - 以便看看我是否能找到一个简单的模型，但仍然只有一个适合的目的是适合的目的（噪音非常低;合适的偏差可以达到一个很好的平滑结果，但只能达到一个点）。它比找到推理和数据挖掘的任何东西都更“找到一个漂亮的，可解释的，但足够的拟合函数”。对于这个问题，这不是真正的问题。]

或者，如果这比gnm或ASSIST或其他一个包更容易，那将是有用的知识，但是关于如何继续上面的玩具问题的一些指示将有所帮助。

Answer 1

ns实际上生成了一个预测变量矩阵。您可以做的是将该矩阵拆分为单个变量，并将它们提供给nls。

m <- ns(x, df=5)
df <- data.frame(y, m)  # X-variables will be named X1, ... X5
# starting values should be set as appropriate for your data
nls(y ~ theta * plogis(alpha + b1*X1 + b2*X2 + b3*X3 + b4*X4 + b5*X5), data=df,
        start=list(theta=1, alpha=0, b1=1, b2=1, b3=1, b4=1, b5=1))

ETA：这是针对不同df值自动执行此操作。这会使用文本修改构建公式，然后使用do.call来调用nls。警告：未经测试。

my.nls <- function(x, y, df)
{
    m <- ns(x, df=df)
    xn <- colnames(m)
    b <- paste("b", seq_along(xn), sep="")
    fm <- formula(paste("y ~ theta * plogis(1 + alpha + ", paste(b, xn, sep="*",
          collapse=" + "), ")", sep=""))
    start <- c(1, 1, rep(1, length=length(b)))
    names(start) <- c("theta", "alpha", b)
    do.call(nls, list(fm, data=data.frame(y, m), start=start))
}

Answer 2

我在澄清自己的问题时得到的一个认识让我发现，与我以前见过的方式相比，这种方式不那么笨拙。

即使有一些明显的流线型可以进入，我仍然有点不优雅，但至少可以忍受重复使用，所以我认为这是一个充分的答案。我仍然对比下面这个更简洁的方式感兴趣。

Hong Ooi在ns生成的矩阵上使用data.frame来自动命名列的技巧很可爱，我在下面使用它。我可能会使用粘贴来构建它们，因为我有几个变量可以使用。

假设问题中给出了数据设置 -

lin.expr <- function(p,xn) {
  pn<-paste(p, 1:length(xn), sep = "")
  paste(paste(pn,xn,sep=" * "),collapse=" + ")
  }


m <- ns(x, df=3)
mydf <- data.frame(y, m)  # X-variables will be named X1, X2, ... 
xn <- names(mydf)[2:dim(mydf)[2]]

nspb <- lin.expr("b",xn)

c.form <- paste("y ~ theta * plogis( a + ",nspb,")",sep="")
stl <- list(theta=2, a=-5,b1=10, b2=10, b3=10)
nls( c.form, data=mydf, start= stl)

我的实际公式将有几个术语，如nspb。实质性改进得到赞赏;我宁愿不选择自己的答案，但我想如果一天或两天没有进一步的话，我会选择它。

编辑：Hong Ooi的添加（发布时我正在打字并使用类似的想法，但添加了几个不错的额外内容）几乎就是这样;这是一个可以接受的答案，所以我已经检查过了。

R中非线性最小二乘内的样条

2 个答案: