I would like to find the value of "p" below (which is between 0 and 1), knowing the following equations:
RI_26 = min(IR,na.rm=FALSE)
RI_min = 100-(sse*SUM/((1+p)*Dotation2017*100))^(1/p)
where RI_26 is the minimum of resources index of my 26 area. It is a constant in my case. In RI_min, sse and Dotations2017 are 2 constants and p is a unknown. I know that RI_26 should be equal to RI_min.
It would be easy to solve it, but SUM (which is present in RI_min) is as well unknown as it is a function of p as following:
`sum.function = function(p){
SUM <- c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
for(i in 1:length(Canton))
if(IR[i] < 100) {
SUM[i] <- (100-IR[i])^(1+p)*Pop[i]
SUM[27] <- SUM[27]+SUM[i]
}
SUM <- round(SUM,0)
return(SUM[27])
}
SUM = sum.function(p)
SUM returns a number (or vector 1X1). To deal with it, I would like to find the value of p that satisfied:
RI_26/RI_min = 1
To do so, I would like to do a loop, beginning with p = 0 and then increasing the value of p by 0.01 until it reaches 1. The loop should return the value of p_star when the constraint is True (RI_26/RI_min = 1.00).
I don't have any idea how to do this but it could look like the following code:
p.function = function(){
for(...)
if(RI_26/RI_min = 1.000000) {
p_star <- p
}
return(p_star)
}
So the function will return the value of p_star when RI_26/RI_min = 1.000000. What am I suppose to write in my function: p.function to increment "p" and have the result that I want? Any idea?
for (i in seq(0, 1, by = 0.1)) {
"Your code here"
}
Related
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!
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)
}
}
I come from OOP background (C#/Java to be specific) and I really do not understand how R treat the variable from outside the function.
I made this example:
result = list();
result$total = 0;
result$count = 0;
result$something = "abc";
a = 1:10;
b = 10:20;
mapply(function(x, y) {
print(result$something);
# Does not work with either = or <--
result$total <-- result$total + x + y;
result$count <-- result$count + 1;
print(result$count);
}, x = a, y = b);
result$average = result$total / result$count;
print(result$total);
print(result$count);
print(result$average);
Here, clearly result is available to the anonymous function because the program did print "abc" 10 times.
However, the change to its component total and count does not survive. 10 times it prints 1 for the result$count, and the final 3 lines are 0, 0 and NaN.
Why is this happening? What should I do in this case, if I want the function to be able to change the variable value?
Note: in my real case, result is NOT a global variable, but is inside another function, and I will use return (result) from the function.
I want to create functions that compute the Simple Moving Average (SMA) and the Exponential Moving Average (EMA).
My problem is in the EMA implementation. I would like to set a constant variable inside the recursive function that is equal to one of its argument.
Here is my code:
#SMA
sma <- function(P,t,n)
{
return(sum(P[(t-n):(t-1)])/n)
}
#EMA
recursive.ema <- function(P,t,n)
{
# Here I want to create a constant variable that keeps in memory the first
# value of t, i.e. the value of t before the first recursion, so I can use
# it as argument of sma function.
# Something similar to this: tmp <- t (t given from outside the function)
b <- 2/(n+1)
if (t == 1)
{
return(b*P[1] + (1-b)*sma(P,tmp,n))
}
return (b*P[t] + (1-b)*recursive.ema(P,t-1,n))
}
Here P is a vector, time series of prices, t is the index of the vector, the time in my model, and n is any positive number, corresponding to n lagged periods at time t.
Would this work ?
e <-new.env()
test<-TRUE
assign("test",test,e)
recursive.ema <- function(P,t,n)
{
test <-get("test",envir=e)
if (test) {
assign("t",t,envir=e)
assign("test",FALSE,envir=e)
} else {
t=get("t",envir=e)
}
b <- 2/(n+1)
if (t == 1)
{
return(b*P[1] + (1-b)*sma(P,tmp,n))
}
return (b*P[t] + (1-b)*recursive.ema(P,t-1,n))
}
I have a weird question..
Essentially, I have a function which takes a data frame of dimension Nx(2k) and transforms it into an array of dimension Nx2xk. I then further use that array in various locations in the function.
My issue is this, when k == 2, I'm left with a matrix of degree Nx2, and even worse, if N = 1, I'm stuck with a matrix of degree 1x2.
I would like to write myArray[thisRow,,] to select that slice of the array, but this falls short for the N = 1, k = 2 case. I tried myArray[thisRow,,,drop = FALSE] but that gives an 'incorrect number of dimensions' error. This same issue arrises for the Nx2 case.
Is there a work around for this issue, or do I need to break my code into cases?
Sample Code Shown Below:
thisFunction <- function(myDF)
{
nGroups = NCOL(myDF)/2
afMyArray = myDF
if(nGroups > 1)
{
afMyArray = abind(lapply(1:nGroups, function(g){myDF[,2*(g-1) + 1:2]}),
along = 3)
}
sapply(1:NROW(myDF),
function(r)
{
thisSlice = afMyArray[r,,]
*some operation on thisSlice*
})
}
Thanks,
James
got a while loop going, and that's working fine.
However I also need to add another condition.
I need the loop to keep going until it satisfies the while loop, but then I also need to add that this can only get repeated x times.
I think you would have to make a for loop to do x times, is it possible to put a while loop in this?
Basically how can I make a loop either reach the goal or stop after x loops??
The expression in while needs to be TRUE for the loop to continue. You can use | or & to add extra conditions. This loop runs 99 times or until sum of random variables is less than 100.
counter <- 0
result <- 0
while(counter < 100 | sum(result) < 100) {
result <- sum(result, rnorm(1, mean = 5, sd = 1))
counter <- sum(counter, 1)
}
> result
[1] 101.5264
> counter
[1] 21
Just pass the current iterator value as an argument to your function. That way you can break the recursion if that reaches a particular value.
But why do you have a while loop if you use recursion, for example:
add_one_recursive = function(number) {
number = number + 1
cat("New number = ", number, "\n")
if(number > 10) {
return(number)
} else {
return(add_one_recursive(number))
}
}
final_number = add_one_recursive(0)
New number = 1
New number = 2
New number = 3
New number = 4
New number = 5
New number = 6
New number = 7
New number = 8
New number = 9
New number = 10
New number = 11
Does not require an explicit loop at all.