原文鏈接：http://tecdat.cn/?p=11936
1引言
在本教程中，我們將研究如何將Nelson-Siegel-Svensson（NSS）模型擬合到數據。由於我們將使用隨機技術進行優化，因此我們應該重新運行幾次。變量nRuns設置示例重啓的次數。
> set.seed(112233)
2將NS模型擬合到給定的零利率
NS模型
我們使用給定的參數betaTRUE創建“真實”的收益曲線yM。付款時間（以年爲單位）在向量tm中。
> tm <- c(c(1, 3, 6, 9)/12, 1:10)
> betaTRUE <- c(6, 3, 8, 1)
> yM <- NS(betaTRUE, tm)
> par(ps = 11, bty = "n", las = 1, tck = 0.01, mgp = c(3, 0.2, 0), mar = c(4, 4, 1, 1))
> plot(tm, yM, xlab = "maturities in years", ylab = "yields in %")
目的是通過這些點擬合平滑曲線。我們從目標函數OF開始。它有兩個參數：param和list數據（包含所有其他變量）。返回觀察到的（“市場”）收益率yM的向量與參數param的模型收益率之間的最大絕對差。
我們添加了一個粗略而有效的約束，以防止導致“ NA”值的參數值：目標函數返回較大的正值。我們將其最小化，因此產生NA值的參數被標記爲不良。在第一個示例中，我們將數據設置如下：
> data <- list(yM = yM, tm = tm, model = NS, ww = 0.1, min = c( 0,-15,-30, 0), max = c(15, 30, 30,10))
我們添加了一個模型（在本例中爲NS），該模型描述了從參數到收益曲線的映射，以及向量min和max，我們稍後將其用作約束。ww是懲罰權重，如下所述。
OF將採用候選解決方案參數，通過data $ model將此解決方案轉換爲收益，並將這些收益與yM進行比較，這意味着要計算最大絕對差。
> OF(param2, data) ## ... gives a postive number
[1] 0.97686
我們還可以根據收益率曲線比較解決方案。
> par(ps = 11, bty = "n", las = 1, tck = 0.01, mgp = c(3, 0.2, 0), mar = c(4, 4, 1, 1))
> plot(tm, yM, xlab = "maturities in years", ylab = "yields in %")
> lines(tm, NS(param1, tm), col = "blue")
> lines(tm, NS(param2, tm), col = "red")
> legend(x = "topright", legend = c("true yields", "param1", "param2"), col = c("black", "blue", "red"), pch = c(1, NA, NA), lty = c(0, 1, 1))
我們通常希望獲取參數，以便滿足某些約束條件。我們通過懲罰函數將它們包括在內。
我們已經有了數據，因此讓我們看看該函數對違反約束的解決方案有何作用。假設我們有三個解的總體mP。
> param1 <- c( 6, 3, 8, -1)
> param2 <- c( 6, 3, 8, 1)
> param3 <- c(-1, 3, 8, 1)
> mP <- cbind(param1,param2,param3)
> rownames(mP) <- c("b1","b2","b3","lambda")
> mP
param1 param2 param3
b1 6 6 -1
b2 3 3 3
b3 8 8 8
lambda -1 1 1
第一個和第三個解決方案違反了約束。在第一個解決方案中，λ爲負。在第三個解中，β1爲負。
> penalty(mP,data)
param1 param2 param3
0.2 0.0 0.2
參數ww控制了我們的懲罰程度。
> data$ww <- 0.5
> penalty(mP,data)
param1 param2 param3
1 0 1
對於有效的解決方案，懲罰應爲零。
> penalty(mP, data)
param1 param2 param3
0 0 0
請注意，懲罰會立即生效；無需遍歷解決方案。
這樣我們就可以進行測試了。我們首先定義DE的參數。請特別注意，我們傳遞了懲罰函數，並將loopPen設置爲FALSE。
然後使用目標函數OF，列表數據和列表算法調用DEopt。
> sol <- DEopt(OF = OF, algo = algo, data = data)
差異演化。
最佳解的目標函數值爲0;
最終人羣中OF的標準偏差爲3.0455e-16。
爲了檢查目標函數是否正常工作，我們將最大誤差與返回的目標函數值進行比較–它們應該相同。
> max( abs(data$model(sol$xbest, tm) - data$model(betaTRUE, tm)) )
[1] 0
> sol$OFvalue
[1] 0
作爲基準，我們從stats包運行函數nlminb。
如果發現它的性能優於DE，我們將有力地表明我們的DE實現存在問題。
我們使用一個隨機起始值s0。
> s0 <- algo$min + (algo$max - algo$min) * runif(length(algo$min))
> sol2 <- nlminb(s0, OF, data = data,
lower = data$min,
upper = data$max,
control = list(eval.max = 50000L,
iter.max = 50000L))
同樣，我們比較返回的目標函數值和最大誤差。
> max( abs(data$model(sol2$par, tm) - data$model(betaTRUE,tm)) )
[1] 1.5787e-07
> sol2$objective
[1] 1.5787e-07
爲了比較我們的兩個解（DE和nlminb），我們可以將它們與真實的收益率曲線一起繪製。但是必須強調的是，這兩種算法的結果都是隨機的：對於DE，因爲它故意使用隨機性；在nlminb的情況下，因爲我們隨機設置了起始值。爲了獲得更有意義的結果，我們應該多次運行這兩種算法。爲了降低插圖的構建時間，我們只運行兩種方法一次。
> plot(tm, yM, xlab = "maturities in years",
ylab = "yields in %")
> algo$printDetail <- FALSE
> for (i in seq_len(nRuns)) {
sol <- DEopt(OF = OF, algo = algo, data = data)
lines(tm, data$model(sol$xbest,tm), col = "blue")
s0 <- algo$min + (algo$max-algo$min) * runif(length(algo$min))
sol2 <- nlminb(s0, OF, data = data,
lower = data$min,
upper = data$max,
control = list(eval.max = 50000L,
iter.max = 50000L))
lines(tm,data$model(sol2$par,tm), col = "darkgreen", lty = 2)
}
> legend(x = "topright", legend = c("true yields", "DE", "nlminb"),
col = c("black","blue","darkgreen"),
pch = c(1, NA, NA), lty = c(0, 1, 2))
毫無疑問，DE似乎通常只有一條曲線：實際上有nRuns 條線，但是它們是相互疊加的。
其他約束
NS（和NSS）模型的參數約束是要確保所得的零利率爲非負數。但實際上，它們不能保證正利率。
> plot(tm, yM, xlab = "maturities in years", ylab = "yields in %")
> abline(h = 0)
這確實是一個虛構的示例，但儘管如此，我們仍可能希望包括針對此類參數向量的約束措施：我們可以僅包含一個所有速率均大於零的約束條件。
同樣，這可以通過懲罰函數來完成。
校驗：
> penalty2(c(3, -2, -8, 1.5),data)
[1] 0.86343
此懲罰函數僅適用於單個解決方案，因此實際上將其直接寫入目標函數最簡單。
因此，就像一個數值測試：假設上述參數爲真，而利率爲負。
> algo$pen <- NULL; data$yM <- yM; data$tm <- tm
> par(ps = 11, bty = "n", las = 1, tck = 0.01,
mgp = c(3, 0.2, 0), mar = c(4, 4, 1, 1))
> plot(tm, yM, xlab = "maturities in years", ylab = "yields in %")
> abline(h = 0)
> sol <- DEopt(OF = OFa, algo = algo, data = data)
> lines(tm,data$model(sol$xbest,tm), col = "blue")
> legend(x = "topleft", legend = c("true yields", "DE (constrained)"),
col = c("black", "blue"),
pch = c(1, NA, NA), lty = c(0, 1, 2))
3將NSS模型擬合到給定的零利率
如果要改用NSS模型，則幾乎不需要更改。我們只需要向目標函數傳遞一個不同的模型。下面是一個示例。同樣，我們修復了真實參數並嘗試恢復它們。
列表數據和算法與以前幾乎相同；目標函數保持完全相同。
仍然需要運行算法。（同樣，我們檢查返回的目標函數值。）
> sol <- DEopt(OF = OF, algo = algo, data = data)
> max( abs(data$model(sol$xbest, tm) - data$model(betaTRUE, tm)) )
[1] 7.9936e-15
> sol$OFvalue
[1] 7.9936e-15
我們將結果與nlminb進行比較。
最後，我們比較了幾次運行所得的收益率曲線。
> par(ps = 11, bty = "n", las = 1, tck = 0.01,
mgp = c(3, 0.2, 0), mar = c(4, 4, 1, 1))
> plot(tm, yM, xlab = "maturities in years", ylab = "yields in %")
> for (i in seq_len(nRuns)) {
sol <- DEopt(OF = OF, algo = algo, data = data)
lines(tm, data$model(sol$xbest,tm), col = "blue")
s0 <- algo$min + (algo$max - algo$min) * runif(length(algo$min))
sol2 <- nlminb(s0, OF, data = data,
lower = data$min,
upper = data$max,
control = list(eval.max = 50000L,
iter.max = 50000L))
lines(tm, data$model(sol2$par,tm), col = "darkgreen", lty = 2)
}
> legend(x = "topright", legend = c("true yields", "DE", "nlminb"),
col = c("black","blue","darkgreen"),
pch = c(1,NA,NA), lty = c(0,1,2), bg = "white")
參考文獻
關於數值優化中“良好起始值”的註釋，2010年。http://comisef.eu/?q = working_papers