R - NLEQSLV LOOP - Плохие результаты

Question

Я использую пакет R - nleqslv для реализации модели Merton более десяти лет и для нескольких компаний. Моя проблема заключается в полученном сообщении: превышен предел предельного значения итерации. Вначале это было «якобиан слишком плохо обусловлено», но я преодолел его с помощью контрольного параметра «allowSingular». Вот что я бегу в R для одной из 60 фирм:

library(nleqslv) 
    firm.txt<-"Q K r X.E t E0 
    1 570397892 0.037368583 0.233290565 0.712328767 87670471 
    2 298421077 0.041952083 0.253988381 0.715068493 95393513 
    3 33869138  0.040477083 0.664630887 0.717808219 48896391 
    4 38419643  0.032099417 0.475755744 0.715068493 56174054 
    5 35286530  0.027812167 0.252814225 0.715068493 53598838 
    6 36801905  0.027028333 0.552871571 0.712328767 42849195 
    7 37798118  0.015626667 0.374539554 0.715068493 62628367 
    8 40594887  0.015787417 0.227146212 0.715068493 82262449 
    9 35638457  0.012659167 0.205291468 0.715068493 75268900 
    10 34889369 0.005081417 0.602946469 0.715068493 80139925" 
    firm<-read.table(textConnection(firm.txt),header=TRUE,stringsAsFactors=FALSE) 
    #Loop with solver for 10 dates: 
    for(i in 1:10) { 
    K<-firm[i,2] 
    r<-firm[i,3] 
    X.E<-firm[i,4] 
    t<-firm[i,5] 
    E0<-firm[i,6] 
    BS<-function(x){ 
    f <- rep(NA, length(x)) 
    f[1] <- (x[1] * pnorm(log (x[1]/K)+(r+((x[1]^2)/2)) * T)/(x[2] *sqrt(t))-exp(-r*t)*K*pnorm(log (x[1]/K)+(r-((x[1]^2)/2))*t)/(x[2]*sqrt(t)))-E0 
    f[2]<-((x[1]*exp(-t)*pnorm(log (x[1]/K)+(r+((x[1]^2)/2)) *t)/(x[2] *sqrt(t))* x[2]) /E0)-X.E 
    f 
    } 
    p0<-c((E0+K),X.E*(V.E/(V.E+K))) 
    print(p0) 
    ans<-nleqslv(p0,BS,control=list(allowSingular=TRUE)) 
    print(ans) 
    } 

Что нужно добавить в функции nleqslv? Надеюсь, вы можете мне помочь! Спасибо!

Answer 1

Я думаю, что формулы в вашей функции BS неверны. См. Здесь Black Scholes model. Некоторое время назад кто-то другой задал аналогичный вопрос в Stackoverflow: Solving nonlinear equations. Вы также сделали формулы нечитаемыми, не используя промежуточные переменные, что делает невозможным анализ и отладку.

Написать BS функцию как

BS<-function(x){ 
    f <- rep(NA, length(x)) 
    d1 <- (log(x[1]/K)+(r+((x[2]^2)/2)) * t)/(x[2]*sqrt(t)) 
    d2 <- d1 - x[2]*sqrt(t) 
    f[1] <- x[1] * pnorm(d1) -exp(-r*t)*K*pnorm(d2)-E0 
    f[2]<- ((x[1]*exp(-t)*pnorm(d1)* x[2]) /E0)-X.E 
    f 
} 

и исправить задание p0 следующим

p0<-c((E0+K),X.E*(E0/(E0+K))) 

от вашего комментария.

Если вы используете это, вы получите гораздо лучшие результаты. Есть еще проблемы, но решение этих проблем зависит от вас.

Предупреждение: Я ничего не знаю о модели Black-Scholes. Только решение нелинейных уравнений (иногда).

Если вы используете функцию testnslv в пакете nleqslv, вы можете выяснить, есть ли возможность найти решение. Функция testnslv генерирует сводку для всех global методов nleqslv. Как это:

for(i in 1:10) { 
    K<-firm[i,2] 
    r<-firm[i,3] 
    X.E<-firm[i,4] 
    t<-firm[i,5] 
    E0<-firm[i,6] 

    BS<-function(x){ 
     f <- rep(NA, length(x)) 
     d1 <- (log(x[1]/K)+(r+((x[2]^2)/2)) * t)/(x[2]*sqrt(t)) 
     d2 <- d1 - x[2]*sqrt(t) 
     f[1] <- x[1] * pnorm(d1) -exp(-r*t)*K*pnorm(d2)-E0 
     f[2]<- ((x[1]*exp(-t)*pnorm(d1)* x[2]) /E0)-X.E 
     f 
    } 
    p0<-c((E0+K),X.E*(E0/(E0+K))) 
    print(p0) 
    z <- testnslv(p0,BS,control=list(allowSingular=TRUE)) 
    print(z) 
} 

, и вы увидите, что ваша система уравнений весьма чувствительна. Вам нужно будет проанализировать результаты для правильных решений.

Добавление

трудности вы сталкиваетесь решая систему уравнений вызваны очень плохой масштабирования значений функции. Вы можете увидеть это, вставив print(BS(p0)) после print(p0) в код. Вы увидите, что f[1] чрезвычайно велико по сравнению с f[2].

Решение очень просто: масштабируйте правую сторону от f[1] <- ... с помощью K. Другими словами, разделите K. Тогда уравнение для f[1] гласит:

f[1] <- (x[1]/K) * pnorm(d1) -exp(-r*t)*pnorm(d2)-E0/K 

Rerun код с testnslv и радуйтесь. Все методы и глобальные стратегии находят решение с нормой значений функций, близких к нулю.