Перевод функции VBA в R

Question

Я пытаюсь перевести функцию DISCRINV (), которая является функцией Excel, доступной в надстройке simtools excel, созданной Роджером Майерсоном, в функцию R. Я верю, что я близок, но мне трудно понять циклический синтаксис VBA.

Код VBA для этой функции выглядит следующим образом:

Function DISCRINV(ByVal randprob As Double, values As Object, probabilities As Object)
On Error GoTo 63
Dim i As Integer, cumv As Double, cel As Object
If values.Count <> probabilities.Count Then GoTo 63
For Each cel In probabilities
 i = i + 1
 cumv = cumv + cel.Value
 If randprob < cumv Then
 DISCRINV = values.Cells(i).Value
 Exit Function
 End If
Next cel
If randprob < cumv + 0.001 Then
 DISCRINV = values.Cells(i).Value
 Exit Function
End If
63 DISCRINV = CVErr(xlErrValue)
End Function

Попытка перевести это непосредственно из кода VBA, который я придумал ( Неправильно):

DISCRINV <- function(R,V,P){
 if(length(V) != length(P)){
   print("ERROR NUMBER OF VALUES DOES NOT EQUAL NUMBER OF PROBABILITIES")
 } else{
   for (i in 1:length(P)){
     cumv=cumv+P[i]
     if (R < cumv){
       DISCY1 = V[i]
       return(DISCY1)
       }

   print(cumv)

 if (R < cumv +0.001){

   DISCY2 = V[i]

   return(DISCY2)
 }
   }
 }
}

Пытаясь перевести это через мое понимание того, что он делает, я придумал это:

DISCRINV <- function(x,values,probabilities){
  require(FSA)
  precumsum <- pcumsum(probabilities)
  middle <- c()
  for (i in 1:(length(values)-2)){
    if (precumsum[i+1] <= x & x < precumsum[i+2]){
      middle[i] <- values[i+1]}
    else{
      middle[i] <- 0
    }
  }

  firstrow <- ifelse(x < precumsum[2], values[1], 0)
  lastrow <- ifelse(precumsum[length(precumsum)] <= x , values[length(precumsum)] , 0)
  Gvector <- c(firstrow,middle,lastrow)
  print(firstrow)
  print(middle)
  print(lastrow)
  print(Gvector)
  simulatedvalue <-  sum(Gvector)

  return(simulatedvalue)
}

Последний параметр работает в 99% случаев, но не в том случае, если первый параметр функции превышает 0,5, второй параметр представляет собой вектор значений c (1000, 2000), а третий параметр представляет собой вектор (0,5,0,5). Случай, когда последний вариант не работает в 100% случаев, побудил меня попытаться перевести функцию напрямую. Может, кто-нибудь подскажет, где мой перевод идет не так?

Дополнительно описание функции выглядит следующим образом:

DISCRINV (randprob, значения, вероятности) возвращает обратные кумулятивные значения для дискретной случайной величины. Когда первым параметром является RAND, DISCRINV возвращает дискретную случайную величину с возможными значениями и соответствующими вероятностями в заданных диапазонах.

Заранее благодарим за понимание!

Answer 1

Для всех, кому это интересно, я смог успешно перевести этот скрипт VBA, используя этот код

    DISCRINV <- function(x,values,probabilities){
    require(FSA)
    precumsum <- pcumsum(probabilities)
    middle <- c()
    if(length(values <3 )){

    if(x<0.5){
    middle1 <- values[1]
    return(middle1)
    } else{
    middle2 <- values[2]
    return(middle2)
    }
    }
    else{
    for (i in 1:(length(values)-2)){
    if (precumsum[i+1] <= x & x < precumsum[i+2]){
    middle[i] <- values[i+1]}
    else{
    middle[i] <- 0
    }
    }
    firstrow <- ifelse(x < precumsum[2], values[1], 0)
    lastrow <- ifelse(precumsum[length(precumsum)] <= x , values[length(precumsum)] , 0)
    Gvector <- c(firstrow,middle,lastrow)
    print(firstrow)
    print(middle)
    print(lastrow)
    print(Gvector)
    simulatedvalue <-  sum(Gvector)

    return(simulatedvalue)
    }
    }