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