R中非線性最小二乘內的樣條

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 ) )

生成擬合值很簡單，並借助於（例如）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值自動執行此操作。 這使用文本munging構造公式，然后使用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的補充（發布時我正在打字並使用類似的想法，但添加了幾個不錯的額外內容）幾乎就是這樣; 這是一個可以接受的答案，所以我已經檢查過了。