Существует ли более точный решатель, чем uniroot, для решения нелинейного уравнения?

Question

Моя проблема в том, что я использую uniroot для поиска значения нелинейной функции, но проблема в том, что значения не такие, как ожидалось, когда я вычисляю их вручную.

Я написал такую ​​функцию:

yield.to.call <- function(ytc,p,c,t,f=4,N=100){
  #d <- (1+(ytc/f))^f
  c <- c/f 
  if(t<92){t <- ((92-t)/(92-0))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+c/((1+(ytc/f))^(t+12))+c/((1+(ytc/f))^(t+13))+c/((1+(ytc/f))^(t+14))+c/((1+(ytc/f))^(t+15))+c/((1+(ytc/f))^(t+16))+c/((1+(ytc/f))^(t+17))+c/((1+(ytc/f))^(t+18))+(c+N)/((1+(ytc/f))^(t+19))-p}}
  else if(t<184){t <- ((184-t)/(184-92))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+c/((1+(ytc/f))^(t+12))+c/((1+(ytc/f))^(t+13))+c/((1+(ytc/f))^(t+14))+c/((1+(ytc/f))^(t+15))+c/((1+(ytc/f))^(t+16))+c/((1+(ytc/f))^(t+17))+(c+N)/((1+(ytc/f))^(t+18))-p}}
  else if(t<275){t <- ((275-t)/(275-184))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+c/((1+(ytc/f))^(t+12))+c/((1+(ytc/f))^(t+13))+c/((1+(ytc/f))^(t+14))+c/((1+(ytc/f))^(t+15))+c/((1+(ytc/f))^(t+16))+(c+N)/((1+(ytc/f))^(t+17))-p}}
  else if(t<365){t <- ((365-t)/(365-275))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+c/((1+(ytc/f))^(t+12))+c/((1+(ytc/f))^(t+13))+c/((1+(ytc/f))^(t+14))+c/((1+(ytc/f))^(t+15))+(c+N)/((1+(ytc/f))^(t+16))-p}}
  else if(t<457){t <- ((457-t)/(457-365))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+c/((1+(ytc/f))^(t+12))+c/((1+(ytc/f))^(t+13))+c/((1+(ytc/f))^(t+14))+(c+N)/((1+(ytc/f))^(t+15))-p}}
  else if(t<548){t <- ((548-t)/(548-457))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+c/((1+(ytc/f))^(t+12))+c/((1+(ytc/f))^(t+13))+(c+N)/((1+(ytc/f))^(t+14))-p}}
  else if(t<639){t <- ((639-t)/(639-548))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+c/((1+(ytc/f))^(t+12))+(c+N)/((1+(ytc/f))^(t+13))-p}}
  else if(t<730){t <- ((730-t)/(730-639))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+c/((1+(ytc/f))^(t+11))+(c+N)/((1+(ytc/f))^(t+12))-p}}
  else if(t<821){t <- ((821-t)/(821-730))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+c/((1+(ytc/f))^(t+10))+(c+N)/((1+(ytc/f))^(t+11))-p}}
  else if(t<915){t <- ((915-t)/(915-821))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+c/((1+(ytc/f))^(t+9))+(c+N)/((1+(ytc/f))^(t+10))-p}}
  else if(t<1006){t <- ((1006-t)/(1006-915))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+c/((1+(ytc/f))^(t+8))+(c+N)/((1+(ytc/f))^(t+9))-p}}
  else if(t<1097){t <- ((1097-t)/(1097-1006))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+c/((1+(ytc/f))^(t+7))+(c+N)/((1+(ytc/f))^(t+8))-p}}
  else if(t<1188){t <- ((1188-t)/(1188-1097))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+c/((1+(ytc/f))^(t+6))+(c+N)/((1+(ytc/f))^(t+7))-p}}
  else if(t<1280){t <- ((1280-t)/(1280-1188))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+c/((1+(ytc/f))^(t+5))+(c+N)/((1+(ytc/f))^(t+6))-p}}
  else if(t<1371){t <- ((1371-t)/(1371-1280))#done 
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+c/((1+(ytc/f))^(t+4))+(c+N)/((1+(ytc/f))^(t+5))-p}}
  else if(t<1461){t <- ((1461-t)/(1461-1371))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+c/((1+(ytc/f))^(t+3))+(c+N)/((1+(ytc/f))^(t+4))-p}}
  else if(t<1553){t <- ((1553-t)/(1553-1461)) 
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+c/((1+(ytc/f))^(t+2))+(c+N)/((1+(ytc/f))^(t+3))-p}}
  else if(t<1645){t <- ((1645-t)/(1645-1553))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+c/((1+(ytc/f))^(t+1))+(c+N)/((1+(ytc/f))^(t+2))-p}}
  else if(t<1736){t <- ((1736-t)/(1736-1645))
    q <- function(ytc,p,c,t,f=4,N=100){c/((1+(ytc/f))^(t))+(N+c)/((1+(ytc/f))^(t+1))-p}}
  else if(t<1826){t<-((1826-t)/(1826-1736))
    q <- function(ytc,p,c,t,f=4,N=100){(N+c)/(1+(ytc/f)^(t))-p}}
  else q <- function(ytc,p,c,t=0,f=4,N=100){(N+c)/p-(ytc/f)-1} 
  
  q2<- function(ytc){q(ytc,p,c,t,N=100)}
  yield.t.c <- uniroot(q2,c(0,1),tol = .Machine$double.eps^0.5)$root 
  return(yield.t.c)
}

yield.to.call(ytc,p=100,t=1790,c=5,N=100)

Например, значение для t = 1790 составляет 6,987728e-05, но должно быть примерно 0,0126 или около того.

Доходность для вызова - это функция, которая должна рассчитать для меня внутреннюю норму доходности денежного потока по купонной облигации. Имеется в виду денежный поток структуры y = c / (1+ (r / 4)) ^ t, где все известно, кроме r, для которого я пытаюсь найти.

У кого-нибудь есть идея?

РЕДАКТИРОВАТЬ: Я обнаружил, что проблема лежит в строке:

else if(t<1826){t<-((1826-t)/(1826-1736))
    q <- function(ytc,p,c,t,f=4,N=100){(N+c)/(1+(ytc/f)^(t))-p}}

Поскольку функция больше не является линейной для любого значения t:

Участок t = 1790

Есть идеи, как «линеаризовать» это и получить желаемое решение?