R DEoptim中的错误:目标函数的NaN值
我正在写一个程序,用赫斯顿模型对欧式期权定价。我正在尝试校准模型,并且正在使用R DEoptim中的错误:目标函数的NaN值,r,calibration,deoptimization,R,Calibration,Deoptimization,我正在写一个程序,用赫斯顿模型对欧式期权定价。我正在尝试校准模型,并且正在使用DEoption()函数。正如你在标题中读到的,我总是得到同样的错误 目标函数的NaN值!也许可以调整界限。” 我试图通过改变边界来解决这个问题,但是我得到了同样的错误,所以我很确定它们不是问题所在 代码如下: my_calib_data <- read_csv("data_test.csv", col_types = cols(interest_rate = col_number(),
DEoption()
函数。正如你在标题中读到的,我总是得到同样的错误
目标函数的NaN值!也许可以调整界限。”
我试图通过改变边界来解决这个问题,但是我得到了同样的错误,所以我很确定它们不是问题所在
代码如下:
my_calib_data <- read_csv("data_test.csv", col_types = cols(interest_rate = col_number(),
maturity = col_number(), mid = col_number()), locale = locale(decimal_mark = ","))
XH = my_calib_data$strike
ST = my_calib_data$spot
mat = my_calib_data$maturity
interest_r = my_calib_data$interest_rate
mid_price = my_calib_data$mid
Ndata = length(my_calib_data$spot)
tipo = 1
calibrazione <- function(z){
rmse = 0
for (i in 1:Ndata) {
print(i)
vp = put_callprice(tipo, XH[i],ST[i], mat[i], interest_r[i], z[1], z[2], z[3], z[4], z[5])
dif = mid_price[i] - vp
rmse = rmse + dif^2
}
rmse = sqrt(rmse/Ndata)
return(rmse)
}
output <- DEoptim(calibrazione, lower = c(-100, -1, 0.01, 0.01, 0.01), upper = c(100, 1, 2, 2, 2))
我真的不知道是什么问题。希望你能设法帮助我
谢谢
cfHest1 <- function(w, S, tau, r, k, rho, sigma, v0, vT){
i = 1i
b = k-rho*sigma
d = sqrt((rho*sigma*w*i - b)^2 - sigma^2*(w*i - w^2))
g = (b - rho*sigma*w*i + d)/(b - rho*sigma*w*i - d)
C = r*w*i*tau + (k*vT/sigma^2)*(tau*(b - rho*sigma*w*i + d) - 2*log((1-g*exp(d*tau))/(1-g)))
D = ((b - rho*sigma*w*i + d)/sigma^2) * ((1-exp(d*tau))/(1-g*exp(d*tau)))
cf1 = exp(C + D*v0 + w*i*log(S))
return(cf1)
}
cfHest2 <- function(w, S, tau, r, k, rho, sigma, v0, vT){
i = 1i
b = k
d = sqrt((rho*sigma*w*i - b)^2 + sigma^2*(w*i + w^2))
g = (b - rho*sigma*w*i + d)/(b - rho*sigma*w*i - d)
C = r*w*i*tau + (k*vT/sigma^2)*(tau*(b - rho*sigma*w*i + d) - 2*log((1-g*exp(d*tau))/(1-g)))
D = ((b - rho*sigma*w*i + d)/sigma^2) * ((1-exp(d*tau))/(1-g*exp(d*tau)))
cf2 = exp(C + D*v0 + w*i*log(S))
return(cf2)
}
Parte_Reale1 <- function(w, X, S, tau, r, k, rho, sigma, v0, vT){
i = 1i
junk = Re((exp(-i*w*log(X)) * cfHest1(w, S, tau, r, k, rho, sigma, v0, vT))/(w*i))
return(junk)
}
Parte_Reale2 <- function(w, X, S, tau, r, k, rho, sigma, v0, vT){
i = 1i
junk = Re((exp(-i*w*log(X)) * cfHest2(w, S, tau, r, k, rho, sigma, v0, vT))/(w*i))
return(junk)
}
put_callprice <- function(tipo, X,S, tau, r, k, rho, sigma, v0, vT){
P1 = 0.5 + (1/pi) * pcubature(Parte_Reale1, lowerLimit = 0, upperLimit = 200, X, S, tau, r, k, rho, sigma, v0, vT)$integral
P2 = 0.5 + (1/pi) * pcubature(Parte_Reale2, lowerLimit = 0, upperLimit = 200, X, S, tau, r, k, rho, sigma, v0, vT)$integral
if (tipo == 0){
cal = S*P1 - X*P2*exp(-r*tau)
return(cal)
}
else if (tipo == 1){
put = X*exp(-r*tau) - S + S*P1 - X*P2*exp(-r*tau)
return(put)
}
else if (tipo != 1 && tipo != 0){
print("Error: tipe 1 for put option or 0 for call option")
}
}