Как я могу использовать оптимизирующие, оптимизирующие функции и т. Д., Чтобы найти входные данные функции, которые предоставляют конкретное возвращаемое значение?

Question

Я пытаюсь найти входное значение функции (скалярное значение), которое в сочетании с тремя другими известными параметрами вектора создает четвертый вектор, который уменьшается до нуля именно в конкретном элементе вектора (а не раньше).

Четвертый вектор содержит рассчитанные сальдо портфеля, и каждый элемент вектора представляет собой год.Я хочу, чтобы баланс портфеля уменьшался до нуля точно в балансе портфеля за год, в который умирает инвестор (год указан в одном из известных векторных параметров).Я хочу добиться этого, найдя начальную стоимость портфеля, в результате чего этот элемент вектора будет равен нулю в год смерти и не раньше.

(Примечание. В Excel это можно сделать с помощью инструмента «Поиск цели» с помощьюустановив конкретный элемент баланса портфеля (год) равным нулю, изменив начальное значение портфеля.)

Я пробовал оптимизировать и оптимизировать, но в последний раз попробовал приведенный ниже скрипт.Оптимизированная начальная стоимость портфеля всегда равна ограничению max.

Любая помощь будет принята с благодарностью.Вытягивал мои волосы в течение двух дней.

f1 <- function(init,spendV,returnV,stateV) {

  # create a vector that equals an initial portfolio value (init) and sets subsequent vector elements
  # equal to the previous portfolio balance minus an amount of spending and then applies a market return rate.
  # Portfolio balance can never fall below zero

  # When the state vector element = 4, the investor died in the previous period
  endState <- which (stateV == 4)
  portfoliobal <- rep(0,length(spendV))

  portfoliobal[1] <- (init - spendV[1]) * returnV[1]

  for (i in (2:length(spendV))) {
    portfoliobal[i] <- max(0,(portfoliobal[i-1] - spendV[i]) * returnV[i])
  }

  # the function returns the portfolio balance when the investor dies
  return(portfoliobal[endState])

}

# spending, market growth rates, and the period of death are given vectors
spendV <- c(97719.19,97737.92,102649.4,98669.15,78108.44,58105.49,51710.02,53267.12,
            39982.34,21070,22439.68,21375.4,15613.45,10826.54,9333.82,7808.239,
            8737.435,8382.001,7267.976,6534.688,5129.403,5026.947,4931.132,5468.401,
            5033.245,5195.273,5199.938,4854.684,5039.221,3757.753,1822.97,1202.24,
            1237.238,965.111,1051.235,906.4884,1110.66,1018.127,500.788,538.2703,
            584.5545,599.1832,575.2254,640.8828,604.0179,781.878,595.9795,625.5037,
            615.471,667.4227)

init <- 1000000 

returnV <- c(0.9347388,1.170053,1.204515,0.9572276,1.044682,0.9229759,1.110595,0.9299398,
             1.161509,1.053207,1.058104,0.8997761,1.000342,1.353597,1.031785,1.121795,0.8745584,
             1.05637,1.180234,0.9795393,0.9137375,0.772738,1.021843,0.9697467,1.055284,0.9182615,
             0.9662726,1.105152,1.099005,0.9195565,0.895424,0.9226368,1.196467,1.085768,0.9529325,
             1.485245,0.9124764,0.8978044,0.8021779,0.9064698,1.034353,0.9914232,0.742632,
             0.9308539,0.9683604,0.9325817,1.000051,1.145982,1.018012,1.127159)

stateV <- c(3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
            2,2,2,2,2,2,2,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)

cat("\n\nCritical vector element= ",which(stateV == 4))

# the critical vector element is the portfolio balance at death

# I experiment with different inital portfolio values and find that portfolio balance[34] approaches zero
# when initial portfolio balance is about 710,000
f1value <- f1(init=1000000,spendV,returnV,stateV)
cat ("\n\nf1value for critical vector element",which(stateV == 4)," when inital value = 1,000,000: ",f1value)

f1value <- f1(init=800000,spendV,returnV,stateV)
cat ("\n\nf1value for critical vector element",which(stateV == 4)," when inital value = 800,000: ",f1value)

f1value <- f1(init=710000,spendV,returnV,stateV)
cat ("\n\nf1value for critical vector element",which(stateV == 4)," when inital value = 710,000: ",f1value)

# I am trying to find the initial portfolio balance that leaves zero dollars in portfolio balance vector [34]
# ---- BUT not BEFORE portfolio balance [34]

# opt <- optimize(f1,c(0,10000000),spendV,returnV,stateV,maximum = FALSE)

Answer 1

Ответ

optim() и optimize() оба ищут минимум (по умолчанию).Вы хотите ноль.Функция, которую вы ищете: uniroot().Сделайте это:

uniroot(f=f1, interval=c(1, 1e7), spendV=spendV, returnV=returnV, stateV=stateV)
#> $root
#> 703932.9

---

Некоторые другие вещи

Для интереса, вот переписать вашу функцию в векторизованной записи (я лениво пропустилreturnV и spendV args):

f2 <- function(init, end=34) {
    init*prod(returnV[1:end]) - sum(cumprod(returnV[end:1])*spendV[end:1])
}

uniroot(f2, c(1, 1e7))
#> $root
#> 703932.9

В целом, если вы тестируете возможные решения, вам может оказаться проще построить целую кучу решений, а не пробовать их по одному.и сообщая результат с cat().Вот как я могу это сделать:

x <- seq(1, 2e6, by=100000)
y <- f2(x, 34)
plot(x, y, pch=20)
abline(v=0, h=0)

Еще одна мысль: в вашей функции f1 строка which(stateV==4) может возвращать вектор значений, если пользователь вводит, скажем, stateV=c(1,4,4).Я предполагаю, что вы хотите первое вхождение «4», которое вы можете выполнить с помощью which(stateV==4)[1] или if(sum(stateV==4)>1) stop("Too many 4s!").