6

コードは次のとおりです (長くて申し訳ありませんが、これは私が最初に使用した例です)。CreditMetricsA. Wittmann によるパッケージの CVaR の例とDEoptimソルバーを使用して最適化しています。

library(CreditMetrics)
library(DEoptim)

N <- 3
n <- 100000
r <- 0.003
ead <- rep(1/N,N)
rc <- c("AAA", "AA", "A", "BBB", "BB", "B", "CCC", "D")
lgd <- 0.99
rating <- c("BBB", "AA", "B")   
firmnames <- c("firm 1", "firm 2", "firm 3")
alpha <- 0.99

# correlation matrix
rho <- matrix(c(  1, 0.4, 0.6,
                  0.4,   1, 0.5,
                  0.6, 0.5,   1), 3, 3, dimnames = list(firmnames, firmnames),
              byrow = TRUE)

# one year empirical migration matrix from standard&poors website
rc <- c("AAA", "AA", "A", "BBB", "BB", "B", "CCC", "D")
M <- matrix(c(90.81,  8.33,  0.68,  0.06,  0.08,  0.02,  0.01,   0.01,
              0.70, 90.65,  7.79,  0.64,  0.06,  0.13,  0.02,   0.01,
              0.09,  2.27, 91.05,  5.52,  0.74,  0.26,  0.01,   0.06,
              0.02,  0.33,  5.95, 85.93,  5.30,  1.17,  1.12,   0.18,
              0.03,  0.14,  0.67,  7.73, 80.53,  8.84,  1.00,   1.06,
              0.01,  0.11,  0.24,  0.43,  6.48, 83.46,  4.07,   5.20,
              0.21,     0,  0.22,  1.30,  2.38, 11.24, 64.86,  19.79,
              0,     0,     0,     0,     0,     0,     0, 100
)/100, 8, 8, dimnames = list(rc, rc), byrow = TRUE)

cm.CVaR(M, lgd, ead, N, n, r, rho, alpha, rating)

y <- cm.cs(M, lgd)[which(names(cm.cs(M, lgd)) == rating)]

今、私は自分の関数を書きます...

fun <- function(w) {
  # ... 
  - (t(w) %*% y - r) / cm.CVaR(M, lgd, ead = w, N, n, r, 
                           rho, alpha, rating)
}

...そして私はそれを最適化したい:

DEoptim(fn = fun, lower = rep(0, N), upper = rep(1, N), 
        control = DEoptim.control())

最適化中に何を挿入する必要があるか教えていただけます# ...か?sum(w) = 1

以下に、flodel のヒントによる最適化の結果を示します。

# The first trick is to include B as large number to force the algorithm to put sum(w) = 1

fun <- function(w) {
  - (t(w) %*% y - r) / cm.CVaR(M, lgd, ead = w, N, n, r, rho, alpha, rating) + 
    abs(10000 * (sum(w) - 1))
}

DEoptim(fn = fun, lower = rep(0, N), upper = rep(1, N), 
        control = DEoptim.control())

$optim$bestval
[1] -0.05326055

$optim$bestmem
par1        par2        par3 
0.005046258 0.000201286 0.994752456

parsB <- c(0.005046258, 0.000201286, 0.994752456)

> fun(parsB)
            [,1]
[1,] -0.05326089

...と...

ご覧のとおり、最初のトリックは、2 番目のトリックよりも小さい結果を見つけるという点でうまく機能します。残念ながら、彼はもっと時間がかかるようです。

# The second trick needs you use w <- w / sum(w) in the function itself

fun <- function(w) {
  w <- w / sum(w)
  - (t(w) %*% y - r) / cm.CVaR(M, lgd, ead = w, N, n, r, rho, alpha, rating) #+ 
    #abs(10000 * (sum(w) - 1))
}

DEoptim(fn = fun, lower = rep(0, N), upper = rep(1, N), 
        control = DEoptim.control())

$optim$bestval
[1] -0.0532794

$optim$bestmem
par1         par2         par3 
1.306302e-15 2.586823e-15 9.307001e-01

parsC <- c(1.306302e-15, 2.586823e-15, 9.307001e-01)
parC <- parsC / sum(parsC)

> fun(parC)
           [,1]
[1,] -0.0532794

任意のコメント？

最適化される関数が「確率的すぎる」ため、反復回数を増やす必要がありますか?

4

2 に答える 2

8

試す：

w <- w / sum(w)

ifDEoptimは、 then が最適なソリューションになるw*ように最適なソリューションを提供します。sum(w*) != 1w*/sum(w*)

別のアプローチは、1 つを除くすべての変数を解決することです。1 - sum(w)最後の変数の値は、関数の本体で次のようにする必要があることがわかっています。

w <- c(w, 1-sum(w))

によって返される最適解に対して同じことを行いますDEoptim。w* <- c(w*, 1-sum(w*))

どちらのソリューションでも、使用できるように、問題を制約のない (変数の範囲を考慮しない) 最適化に再定式化する必要がありますDEoptim。DEoptimこれにより、元の問題の解決策を回復するために、外部で少し余分な作業を行う必要があります。

DEoptimコメントへの返信として、正しい答えをすぐに (つまり、後変換を必要とせずに)返したい場合は、目的関数にペナルティ コストを含めることB * abs(sum(w)-1)もできます。B数sum(w)が多いのでやむを得ず出品させていただきます1。

于 2012-09-29T18:53:55.857 に答える