Translating a VBA function into R - r

Question

I am attempting to translate the function DISCRINV() which is an excel function available in the simtools excel add-in that was created by Roger Myerson into an R function. I believe i am close, but am having difficulty understanding the looping syntax of VBA.
The VBA code for this function is as follows:
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
Attempting to translate this directly from the VBA code i have come up with this (Not Correct):
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)
}
}
}
}
Attempting to translate this through my understanding of what it is doing i have come up with this:
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)
}
The latter option works 99% of the time, but not when the first function parameter is over 0.5, the second parameter is a vector of values c(1000,2000) and the third parameter is a vector (0.5,0.5). The case of the latter option not working 100% of the time is what has led me to try to translate the function directly. Could someone please give some insight into where my translation is going wrong?
Additionally a description of the function is as follows:
DISCRINV(randprob, values, probabilities) returns inverse cumulative values for a discrete random variable. When the first parameter is a RAND, DISCRINV returns a discrete random variable with possible values and corresponding probabilities in the given ranges.
Thank you in advance for the insight!

Answer 1

For anyone that is interested, i was able to successfully translate this VBA script using this code
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)
}
}