Recursive cumulative function - r

I need to write a cumulative summation function in R but I've been hitting a brick wall. The function has the following structure:
a*x1
a*x2 + a^2*x1
a*x3 + a^2*x2 + a^3*x1
a*x4 + a^2*x3 + a^3*x2 + a^4*x1
And so on. cumsum doesn't seem to work for this type of function. Is there any way this could be implemented in R?

Since your recursion is
u[n+1] = a * ( x[n+1] + u[n] )
i.e.,
u[n+1]/a = x[n+1] + a * u[n]/a,
you can use filter:
x <- 1:5
a <- 2
a*filter(1:5, a, method="recursive")
# Compare with the expected values
a*x[1]
a*x[2] + a^2*x[1]
a*x[3] + a^2*x[2] + a^3*x[1]
a*x[4] + a^2*x[3] + a^3*x[2] + a^4*x[1]

Related

Solve multi-objective optimization problem with R package rmoo

The documentation to this packages is available here, but for me it is impossible to transfer my real-valued 3 objective function to a form that it works.
I'm trying to solve it with the nsga2 function - and I think nsga3 should work the same way?!
My objective functions, which I want to minimize, are:
f1 <- 1640.2823 + 2.3573285*x[1] + 2.3220035*x[2] +4.5688768*x[3] + 7.7213633*x[4] + 4.4559504*x[5]
f2 <- 6.5856 + 1.15*x[1] - 1.0427*x[2] + 0.9738*x[3] + 0.8364*x[4] - 0.3695*x[1]*x[4] + 0.0861*x[1]*x[5] + 0.3628*x[2]*x[4] - 0.1106*x[1]^2 - 0.3437*x[3]^2 + 0.1764*x[4]^2
f3 <- -0.0551 + 0.0181*x[1] + 0.1024*x[2] + 0.0421*x[3] - 0.0073*x[1]*x[2] + 0.024*x[2]*x[3] - 0.0118*x[2]*x[4] - 0.0204*x[3]*x[4] - 0.008*x[3]*x[5] - 0.0241*x[2]^2 + 0.0109*x[4]^2
And x has to be between one and three (these are the constraints)
1 <= x[i] <= 3
I appreciate any hints... so many thanks in advance!

Automating a function to return an expression with math constants and unknowns

I am trying to build a transitions matrix from Panel data observations in order to obtain the ML estimators of a weighted transitions matrix. A key step is obtaining the individual likelihood function for individuals. Say you have the following data frame:
ID Feature1 Feature2 Transition
120421006 10000 1 ab
120421006 12000 0 ba
120421006 10000 1 ab
123884392 3000 1 ab
123884392 2000 0 ba
908747738 1000 1 ab
The idea is to return, for each agent, the log-likelihood of his path. For agent 120421006, for instance, this boils down to (ignoring the initial term)
LL = log(exp(Yab)/1 + exp(Yab)) + log(exp(Yba) /(1 + exp(Yba))) +
log(exp(Yab)/1 + exp(Yab))
i.e,
log(exp(Y_transition)/(1 + exp(Y_transition)))
where Y_transition = xFeature1 + yFeature2 for that transition, and x and y are unknowns.
For example, for individual 120421006, this would boil down to an expression with three elements, since he transitions thrice, and the function would return
LL = log(exp(10000x + 1y)/ 1 + exp(10000x + 1y)) +
log(exp(12000x + 0y)/ 1 + exp(12000x + 0y)) +
log(exp(10000x + 1y)/ 1 + exp(10000x + 1y))
And here's the catch: I need x and y to return as unknowns, since the objective is to obtain a sum over the likelihoods of all individuals in order to pass it to an ML estimator. How would you automate a function that returns this output for all IDs?
Many thanks in advance
First you have to decide how flexible your function has to be. I am leaving it fairly rigid, but you can alter it at your flavor.
First, you have to input the initial guess parameters, which you will supply in the optimizer. Then, declare your data and variables to be used in your estimation.
Assuming you will always have only 2 variables (you can change it later)
y <- function(initial_param, data, features){
x = initial_param[1]
y = initial_param[2]
F1 = data[, features[1]]
F2 = data[, features[2]]
LL = log(exp(F1 * x + F2 * y) / (1 + exp(F1 * x + F2 * y)))
return(-sum(LL))
}
This function returns the sum of minus the log likelihood, given that most optimizers try to find the parameters at which your function reaches a minimum, by default.
To find your parameters just supply the below function with your likelihood function y, the initial parameters, data set and a vector with the names of your variables:
nlm(f = y, initial_param = your_starting_guess, data = your_data,
features = c("name_of_first_feature", "name_of_second_feature"), iterlim=1000, hessian=F)
Create the function:
fun=function(x){
a=paste0("exp(",x[1],"*x","+",x[2],"*y)")
parse(text=paste("sum(",paste0("log(",a,"/(1+",a,"))"),")"))
}
by(test[2:3],test[,1],fun)
sum(log(exp(c(10000, 12000, 10000) * x + c(1, 0, 1) * y)/(1 +
exp(c(10000, 12000, 10000) * x + c(1, 0, 1) * y))))
--------------------------------------------------------------------
sum(log(exp(c(3000, 2000) * x + c(1, 0) * y)/(1 + exp(c(3000,
2000) * x + c(1, 0) * y))))
--------------------------------------------------------------------
sum(log(exp(1000 * x + 1 * y)/(1 + exp(1000 * x + 1 * y))))
taking an example of x=0 and y=3 we can solve this:
x=0
y=3
sapply(by(test[2:3],test[,1],fun),eval)
[1] -0.79032188 -0.74173453 -0.04858735
in your example above:
x=0
y=3
log(exp(10000*x + 1*y)/ (1 + exp(10000*x + 1*y))) +#There should be paranthesis
log(exp(12000*x + 0*y)/ (1 + exp(12000*x + 0*y))) +
log(exp(10000*x + 1*y)/( 1 + exp(10000*x + 1*y)))
[1] -0.7903219
To get what you need within the comments:
fun1=function(x){
a=paste0("exp(",x[1],"*x","+",x[2],"*y)")
paste("sum(",paste0("log(",a,"/(1+",a,"))"),")")
}
paste(by(test[2:3],test[,1],fun1),collapse = "+")
1] "sum( log(exp(c(10000, 12000, 10000)*x+c(1, 0, 1)*y)/(1+exp(c(10000, 12000, 10000)*x+c(1, 0, 1)*y))) )+sum( log(exp(c(3000, 2000)*x+c(1, 0)*y)/(1+exp(c(3000, 2000)*x+c(1, 0)*y))) )+sum( log(exp(1000*x+1*y)/(1+exp(1000*x+1*y))) )"
But this doesnt make sense why you would group them and then sum all of them. That is same as just summing them without grouping them using the ID which would be simpler and faster

Defining a particular polynomial ring in some CAS (Computer Algebra System)

I'm interested in defining the following polynomial quotient ring in some CAS (Singular, GAP, Sage, etc.):
R = GF(256)[x] / (x^4 + 1)
Specifically, R is the set of all polynomials of degree at most 3, whose coefficients belong to GF(256). Two examples include:
p(x) = {03}x^3 + {01}x^2 + {01}x + {02}
q(x) = {0B}x^3 + {0D}x^2 + {09}x + {0E}
Addition and multiplication are defined as the per ring laws. Here, I mention them for emphasis:
Addition: The corresponding coefficients are XOR-ed (the addition law in GF(256)):
p(x) + q(x) = {08}x^3 + {0C}x^2 + {08}x + {0C}
Multiplication: The polynomials are multiplicated (coefficients are added and multiplicated in GF(256)). The result is computed modulo x^4 + 1:
p(x) * q(x) = ({03}*{0B}x^6 + ... + {02}*{0E}) mod (x^4 + 1)
= ({03}*{0B}x^6 + ... + {02}*{0E}) mod (x^4 + 1)
= ({1D}x^6 + {1C}x^5 + {1D}x^4 + {00}x^3 + {1D}x^2 + {1C}x + {1C}) mod (x^4 + 1)
= {01}
Please tell me how to define R = GF(256)[x] / (x^4 + 1) in a CAS of your choice, and show how to implement the above addition and multiplication between p(x) and q(x).

How to compute autocorrelation function in R

I'd like to know the best way to compute autocorrelation function as defined below.
For i=1,2,... I would like to compute the i-th autocorrelation function acf.
This is the sum, from k = 1 to n-i, of +1 if v(k) = v(k+i) or -1 if v(k) is different from v(k+i), where n is the length of a vector.
For example:
if v<-c(0,1,1,0,0) and i = 2. Then
acf(v) = (-1) + (-1) + (-1) = -3
Thanks!
What about using R-help? There you should have found the acf function.
v = c(1,1,0,0,1,0,1,0,1)
acf(v,plot=F) -> acf_v
acf_v[2]
I created a function to do to it but still looking for a short and efficient way to do it.
Here is the function:
> v<-c(0,1,1,1,0,1,1)
> acf_bit <-function(vec,lag) {
+ m<-length(vec)
+ t<-0
+ for (k in 1:(m-lag)) {
+ if (v[k]==v[k+lag]) {t<-t+1}
+ else {t<-t-1}
+ }
+ return(t)
+ }
> acf_bit(v,2)
[1] -1

Evaluating logarithm of expression, given logarithms of variables

I have to programmatically determine the value of the expression:
S = log(x1y1 + x2y2 + x3y3 ...)
Using only the values of:
lxi = log(xi)
lyi = log(yi)
Calculating anti-logs of each of lxi and lyi would probably be impractical and is not desired ...
Is there any way this evaluation can be broken down into a simple summation?
EDIT
I saw a C function somewhere that does the computation in a simple summation:
double log_add(double lx, double ly)
{
double temp,diff,z;
if (lx<ly) {
temp = lx; lx = ly; ly = temp;
}
diff = ly-lx;
z = exp(diff);
return lx+log(1.0+z);
}
The return values are added for each pair of values, and this seems to be giving the correct answer. But I'm not able to figure out how and why it's working!
The direct way is to perform two exponentiations:
ln(x+y) = ln(eln(x) + eln(y))
The log_add function uses a slightly different approach to get the same result with only one:
ln(x+y) = ln((x+y)x/x)
= ln((x+y)/x) + ln(x)
= ln(1 + y/x) + ln(x)
= ln(1 + eln(y/x)) + ln(x)
= ln(1 + eln(y)-ln(x)) + ln(x)

Resources