Actualmente estoy tratando de implementar el modelo y la Importancia de Muestreo del estimador para Longstaff y Schwartz algoritmo para la fijación de precios Americana de opciones put. Es usada de forma que las más de las rutas son en-el-dinero que menos de la simulación es necesario y también la varianza se reduce.
Estoy siguiendo los pasos por Moreni y simular $n$-caminos de un desvió el movimiento browniano geométrico dado por:
$dS_t = S_t\big[(r+\theta \sigma)dt+\sigma dW_t\big]$.
Luego moreni define el cociente de probabilidad $L_\tau^\theta=exp\{-\theta W_t+0.5 \theta^2 t \}$.
Por el tiempo de parada de teorema, queremos encontrar para cada ruta $n$ $\sup_\tau \mathbb{E}[f^{(n)}(\tau,S_\tau)]$ la correspondiente Importancia de muestreo del estimador de $\sup_\tau \mathbb{E}[L_\tau^\theta f^{(n)}(\tau,S_\tau)]$, donde $f$ es la función de la rentabilidad.
Cuando hemos encontrado que el tiempo de parada para cada ruta $$ n podemos tomar el promedio y obtener la deseada ponga el precio en el tiempo 0.
Mi pregunta es que es el proceso de wiener en el cociente de probabilidad de que el número aleatorio en $\textit{óptimo}$ de $\tau$ para la ruta de un camino $n_i$? Y al mismo tiempo debe $t$ ser el momento óptimo $\tau$ path $n_i$?
Ya que en R el estándar de L&S algoritmo es inexistente en el paquete library(LSMonteCarlo)
, he modificado la función AmerPutLSM
, de tal manera que se simule con la deriva $\theta$ y estoy de establecer la tasa de interés a 0.
Sin embargo, me parece que conseguir precios muy altos cuando trato de simular en comparación con el estándar. Así que no estoy segura de si realmente han entendido los cálculos correctamente. Puedo usar valores negativos para $\theta$ y debe ser de alrededor de -0.5 y -1 de acuerdo a Moreni. Pero los precios que tienen son muy divergentes.
Aquí está el código que he modificado:
firstValueRow <- function (x)
{
cumSumMat <- matrix(NA, nrow = dim(x)[1], ncol = dim(x)[2])
for (i in 1:(dim(x)[1])) {
cumSumMat[i, ] <- cumsum(x[i, ])
}
cumSumMat2 <- cbind(matrix(0, nrow = dim(x)[1], ncol = 1), cumSumMat[, -(dim(x)[2])])
ResultMat <- matrix(NA, nrow = dim(x)[1], ncol = dim(x)[2])
for (i in 1:dim(x)[2]) {
ResultMat[, i] <- ifelse(cumSumMat2[, i] > 0, 0, x[,i])
}
return(ResultMat)
}
Spot = 36
sigma = 0.8
theta = -1
mu = 0
n = 1000
m = 50
Strike = 40
r = 0
dr = 0
mT = 1
dt <- mT/m
GBM <- matrix(NA, nrow = n, ncol = m)
Zlist <- matrix(NA, nrow = n, ncol = m)
for (i in 1:n)
{
Z <- rnorm(m, mean = mu, sd = 1)
GBM[i, ] <- Spot * exp(cumsum(((r+theta*sigma-0.5*sigma*sigma)*dt)+(sigma*(sqrt(dt))*Z)))
Zlist[i, ] <- Z
}
X <- ifelse(GBM < Strike, GBM, NA) #stock rates only in the money
### payoff importance sampling
Ltheta <- exp(-theta*Zlist-0.5*theta*theta*dt)
CFL <- matrix(Ltheta*pmax(0, Strike - GBM), nrow = n, ncol = m) #cashflows
Xsh <- X[, -m]
X2sh <- Xsh * Xsh
Y1 <- CFL * exp(-1 * r * dt)
Y2 <- cbind((matrix(NA, nrow = n, ncol = m - 1)), Y1[, m]) #value of derivate at time t+1
CV <- matrix(NA, nrow = n, ncol = m - 1) #continuation value
for (i in (m - 1):1)
{
reg1 <- lm(Y2[, i + 1] ~ Xsh[, i] + X2sh[, i])
CV[, i] <- (matrix(reg1$coefficients)[1, 1]) + ((matrix(reg1$coefficients)[2,1]) * Xsh[, i]) + ((matrix(reg1$coefficients)[3,1]) * X2sh[, i])
CV[, i] <- (ifelse(is.na(CV[, i]), 0, CV[, i]))
Y2[, i] <- ifelse(CFL[, i] > CV[, i], Y1[, i], Y2[, i + 1] * exp(-1 * r * dt))
}
CV <- ifelse(is.na(CV), 0, CV)
CVp <- cbind(CV, (matrix(0, nrow = n, ncol = 1)))
POF <- ifelse(CVp > CFL, 0, CFL)
FPOF <- firstValueRow(POF)
dFPOF <- matrix(NA, nrow = n, ncol = m)
for (i in 1:m)
{
dFPOF[, i] <- FPOF[, i] * exp(-1 * dt * r * i)
}
PRICE <- mean(rowSums(dFPOF))
PRICE
Si el flujo de caja se multiplica por el cociente de probabilidad de inmediato?
Agradezco por la ayuda. Gracias