Since it's a short question I'll leave out regular background information (if you need, I'll add it).
Finally there is a data frame called Coefficients
Serial_number Fixed_effects_beta_0 Fixed_effects_beta_1 Fixed_effects_beta_2 Fixed_effects_beta_3 Random_effects_beta_0 Random_effects_beta_1 Random_effects_beta_2 Random_effects_beta_3 p0_fixed p1_fixed p2_fixed p3_fixed p0_random p1_random p2_random p3_random Fitted_Voltage
1 912009913 1.238401 13.19572 -0.08379988 1.366747 -0.039642999 -0.40767221 -0.25476169 -0.11315457 -11.92334 0.1177605 -0.0003777831 4.328852e-07 0.56414753 -0.006946270 2.736287e-05 -3.583906e-08 352.9476
(...)
and for each row I want to apply the function
inverse = function (f, lower = lower_limit, upper = 450) {
function (y) uniroot((function (x) f(x) - y), lower = lower_limit, upper = upper)[1]
# function (y) polyroot((function (x) f(x) - y), lower = lower_limit, upper = upper)[1]
}
function_to_observe = inverse((function(x=150)
exp(
exp(
sum(
Coefficients[running_row,"p0_fixed"] * x^0,
Coefficients[running_row,"p1_fixed"] * x^1,
Coefficients[running_row,"p2_fixed"] * x^2,
Coefficients[running_row,"p3_fixed"] * x^3
))
)
)
, 50, 450)
by making use of values stored in each row and in certain columns of the data frame as follows:
for(i in 1:nrow(Coefficients)){
Coefficients[i,"Fitted_Voltage"]<- function_to_observe(150)
}
Unfortunately this does not work since Coefficients[i,"Fitted_Voltage"]<- function_to_observe(150) does not take care of the different rows of Coefficients.
What's a remedy? Whyever I cannot do the following:
for(i in 1:nrow(Coefficients)){
Coefficients[i,"Fitted_Voltage"]<- inverse((function(x=150)
exp(
exp(
sum(
Coefficients[i,"p0_fixed"] * x^0,
Coefficients[i,"p1_fixed"] * x^1,
Coefficients[i,"p2_fixed"] * x^2,
Coefficients[i,"p3_fixed"] * x^3
))
)
)
, 50, 450)
}
This yields:
Error in x[[jj]][iseq] <- vjj :
incompatible types (from closure to double) in subassignment type fix
Thanks a lot in advance for any help!
# Update:
With the help of mathdotrandom I tried a bit and get the following:
lower_limit<- 0
function_to_observe<- inverse((function(x=150)
exp(
exp(
sum(
Coefficients[i,"p0_fixed"] * x^0,
Coefficients[i,"p1_fixed"] * x^1,
Coefficients[i,"p2_fixed"] * x^2,
Coefficients[i,"p3_fixed"] * x^3
))))
, 50, 550
)
inverse = function (f, lower = lower_limit, upper = 450) {
function (y) uniroot((function (x) f(x) - y), lower = lower_limit, upper = upper)[1]
}
for(i in 1:nrow(Coefficients)){
Coefficients[i, "Fitted_Voltage"]<- function_to_observe(150)
}
Coefficients["Fitted_Voltage"]
which yields reasonable values:
Fitted_Voltage
1 352.9476
2 352.9476
3 352.9476
4 352.9476
5 352.9476
6 352.9476
7 352.9476
8 352.9476
9 352.9476
10 352.9476
11 352.9476
12 352.9476
13 352.9476
14 352.9476
15 352.9476
Though I do not understand the syntax I guess this is correct since it does what it should.
function(x=150) does not run the function but sets x as a default parameter of 150. So you try to put a function definition into your data.frame. Thats why it complains about the type closure(function). Easiest is to give the function a name and define it outside of the for loop and then call it.
If you really want to use it as lambda function checkout this question and lebatsnok answer: lambda-like functions in R?
The inverse function should not return a function but a number. The uniroot function expects a function, so f should be a function as you did. R will actually lookup the value of i or running_row from above if you don't put it as a parameter.
Coefficients <- data.frame("Fitted_Voltage"=c(0,0), "p0_fixed"=c(10^-1, 10^-2),
"p1_fixed"=c(10^-2, 10^-3), "p2_fixed"=c(10^-3, 10^-4),
"p3_fixed"=c(10^-4, 10^-5))
f <- function(x=150)exp(exp(sum(Coefficients[running_row,"p0_fixed"] * x^0,
Coefficients[running_row,"p1_fixed"] * x^1,
Coefficients[running_row,"p2_fixed"] * x^2,
Coefficients[running_row,"p3_fixed"] * x^3)))
inverse = function (f, lower_limit, upper = 450) {
y = (f(lower_limit) + f(upper))/2
uniroot(function(x)(f(x)-y), lower = lower_limit, upper = upper)[1]
}
for(running_row in 1:nrow(Coefficients)){
Coefficients[i, "Fitted_Voltage"] <- inverse(f,-1,1)
}
But your function is always positive because you used exp and exp(x) >0 forall x, so uniroot can not find a zero of that function. Also polyroot can only find zeros of polynomials but you are using an exponentail function. Are you sure that your function should look like: e^(e^(c_0 + c_1*x + c_2*x^2 + c_3*x^3))?
I subtract a value in inverse to make it have a root but i dont know if this makes any sense in your context. Also because of double exponential the function gets big really fast, so even for small Coefficients it returns Infinity for lower limit 50 and upper 450, so i needed to do -1 and 1 as limits to get some results. But this should be somehow similar to how you want it.
Following mathdotrandom's suggestion. You can define function outside. Try this:
inner.f <- function(x=150, i){
exp(
exp(
sum(
Coefficients[i,"p0_fixed"] * x^0,
Coefficients[i,"p1_fixed"] * x^1,
Coefficients[i,"p2_fixed"] * x^2,
Coefficients[i,"p3_fixed"] * x^3
))
)
}
then (if you want x to be set to 150)
Coefficients[i,"Fitted_Voltage"]<- inverse(inner.f(150, i), 50, 450)
Related
I am building and training a neural network model with Flux, and I am wondering if there is a way to take linear combinations of Zygote.Grads types.
Here is a minimalistic example. This is how it is typically done:
m = hcat(2.0); b = hcat(-1.0); # random 1 x 1 matrices
f(x) = m*x .+ b
ps = Flux.params(m, b) # parameters to be adjusted
inputs = [0.3 1.5] # random 1 x 2 matrix
loss(x) = sum( f(x).^2 )
gs = Flux.gradient(() -> loss(inputs), ps) # the typical way
#show gs[m], gs[b] # 5.76, 3.2
But I want to do the same calculation by computing gradients at a deeper level, and then assembling it at the end. For example:
input1 = hcat(inputs[1, 1]); input2 = hcat(inputs[1, 2]); # turn each input into a 1 x 1 matrix
grad1 = Flux.gradient(() -> f(input1)[1], ps) # df/dp using input1 (where p is m or b)
grad2 = Flux.gradient(() -> f(input2)[1], ps) # df/dp using input2 (where p is m or b)
predicted1 = f(input1)[1]
predicted2 = f(input2)[1]
myGrad_m = (2 * predicted1 * grad1[m]) + (2 * predicted2 * grad2[m]) # 5.76
myGrad_b = (2 * predicted1 * grad1[b]) + (2 * predicted2 * grad2[b]) # 3.2
Above, I used the chain rule and linearity of the derivative to decompose the gradient of the loss() function:
d(loss)/dp = d( sum(f^2) ) / dp = sum( d(f^2)/dp ) = sum( 2*f * df/dp )
Then, I calculated df/dp using Zygote.gradient, and then combined the results at the end.
But notice that I had to combine m and b separately. This was fine because there were only 2 parameters.
However, if there were a 1000 parameters, I would want to do something like this, which is a linear combination of the Zygote.Grads:
myGrad = (2 * predicted1 * grad1) + (2 * predicted2 * grad2)
But, I get an error saying that the + and * operators are not defined for these types. How can I get this shortcut to work?
Just turn each */+ into .*/.+ (i.e. use broadcasting) or you can use map to apply a function to multiple Grads at once. This is described in the Zygote docs here. Note that in order for this to work, all the Grads must share the same keys (so they must correspond to the same parameters).
I'm trying to estimate parameters that will maximize the likelihood of a certain event. My objective function looks like that:
event_prob = function(p1, p2) {
x = ((1-p1-p2)^4)^67 *
((1-p1-p2)^3*p2)^5 *
((1-p1-p2)^3*p1)^2 *
((1-p1-p2)^2*p1*p2)^3 *
((1-p1-p2)^2*p1^2) *
((1-p1-p2)*p1^2*p2)^2 *
(p1^3*p2) *
(p1^4)
return(x)
}
In this case, I'm looking for p1 and p2 [0,1] that will maximize this function. I tried using optim() in the following manner:
aaa = optim(c(0,0),event_prob)
but I'm getting an error "Error in fn(par, ...) : argument "p2" is missing, with no default".
Am I using optim() wrong? Or is there a different function (package?) I should be using for multi-parameter optimization?
This problem can in fact be solved analytically.
The objective function simplifies to
F(p1,p2) = (1-p1-p2)^299 * p1^19 * p2^11
which is to be maximised over the region
C = { (p1,p2) | 0<=p1, 0<=p2, p1+p2<=1 }
Note that F is 0 if p1=0 or p2 =0 or p1+p2 = 1, while if none of those are true then F is positive. Thus the maximum of F occurs in the interior of C
Taking the log
f(p1,p2) = 299*log(1-p1-p2) + 19*log(p1) + 11*log(p2)
In fact it is as easy to solve the more general problem: maximise f over C where
f( p1,..pN) = b*log( 1-p1-..-pn) + Sum{ a[j]*log(p[j])}
where b and each a[j] is positive and
C = { (p1,..pN) | 0<pj, j=1..N and p1+p2+..pN<1 }
The critical point occurs where all the partial derivatives of f are zero, which is at
-b/(1-p1-..-pn) + a[j]/p[j] = 0 j=1..N
which can be written as
b*p[j] + a[j]*(p1+..p[N]) = a[j] j=1..N
or
M*p = a
where M = b*I + a*Ones', and Ones is a vector with each component 1
The inverse of M is
inv(M) = (1/b)*(I - a*Ones'/(b + Ones'*a))
Thus the unique critical point is
p^ = inv(M)*a
= a/(b + Sum{i|a[i]})
Since there is a maximum, and only one critical point, the critical point must be the maximum.
Based on Erwin Kalvelagen's comment: Redefine your function event_prob:
event_prob = function(p) {
p1 = p[1]
p2 = p[2]
x = ((1-p1-p2)^4)^67 *
((1-p1-p2)^3*p2)^5 *
((1-p1-p2)^3*p1)^2 *
((1-p1-p2)^2*p1*p2)^3 *
((1-p1-p2)^2*p1^2) *
((1-p1-p2)*p1^2*p2)^2 *
(p1^3*p2) *
(p1^4)
return(x)
}
You may want to set limits to ensure that p1 and p2 fulfill your constraints:
optim(c(0.5,0.5),event_prob,method="L-BFGS-B",lower=0,upper=1)
Basically, I have
x<-rnorm(5).
I write a vector which takes integers 1 <= n <= 5 then returns in a vector the result from the series (1/n) * sum_{i=1}^n (1/x_i)
so
n=1 -> 1 * 1/x_1
n=2 -> (1/2) * ( 1/(x_1 + x_2) )
n=3 -> (1/3) * ( 1/(x_1 + x_2 + x_3) )
n=4 -> (1/4) * ( 1/(x_1 + x_2 + x_3 + x_4) )
I wrote this function:
series <- function(n){
n=seq(1,5,1)
x<-rnorm(length(n))
print(x)
return ( (1/n)* (1/sum(x[1:length(x[n])])) )
}
But the result is not true, for example
> series(5)
[1] 1.17810059 0.85472777 -0.55077392 -0.03856963 -0.19404827
[1] 0.8003608 0.4001804 0.2667869 0.2000902 0.1600722
for n=2 -> 1/2 * 1/x_1 + 1/x_2 = (1/2) * (1/(1.17810059+ 0.85472777)) but unfortunately, the result according to my code is 0.4001804!
P.S: I want to write the code without loops and without any function needs calling a library! just to define a simple function using the basic known functions in R and then I can save the result, if needed using Vectorize() or outer()
The sum() function is not vectorized. It collapsing everything down to a single value. instead, you can use cumsum() to get the cumulative some of all the values in the vector thus far.
series <- function(n){
n <- seq(1,5,1)
x <- rnorm(length(n))
print(x)
return((1/n)* (1/cumsum(x)))
}
Building on the basic idea from #MrFlick, you can also do:
1/seq_along(x) * 1/cumsum(x)
[1] -1.7841988 -0.6323886 0.4339966 0.2981289 0.2066433
I want to check if a user-defined function is already registered in JuMP/julia. Here's an example:
function foo( f, f1, f2 )
if !function_is_registered(:f) # This is what I'm looking for
JuMP.register(:f,1,f1,f2)
end
####
# Optimization problem here using f
# Leads to some return statement
####
end
f(x) = exp( A * x )
f1(x) = A * exp( A * x )
f2(x) = A * A * exp( A * x )
# Function to register
A = 2
use1 = foo(f, f1, f2)
use2 = foo(f, f1, f2)
# This second usage would fail without the check. Can't re-register f.
As should be obvious from the comments, the check is needed for the second usage. As far as I can tell, JuMP registers functions at a global level - once registered they can't be re-defined locally (right? If they can, this solves my problem too!).
This will do what you want.
using JuMP
using Ipopt
function set_A_sol( A )
f = (x) -> exp( A * x ) - x
f1 = (x) -> A * exp( A * x ) - 1.0
f2 = (x) -> A * A * exp( A * x )
# Local redefinition of f
try
JuMP.register(:f, 1, f, f1, f2)
catch e
if e.msg == "Operator f has already been defined"
ind = pop!( ReverseDiffSparse.univariate_operator_to_id, :f);
deleteat!( ReverseDiffSparse.univariate_operators, ind);
pop!( ReverseDiffSparse.user_univariate_operator_f, ind);
pop!( ReverseDiffSparse.user_univariate_operator_fprime, ind);
pop!( ReverseDiffSparse.user_univariate_operator_fprimeprime, ind);
JuMP.register(:f, 1, f, f1, f2);
end
end
mod = Model(solver=Ipopt.IpoptSolver(print_level=0))
#variable(mod, - Inf <= x <= Inf )
#NLobjective(mod, Min, f(x) )
status=solve(mod)
return getvalue(x)
end
julia> ans1 = set_A_sol(0.5)
1.3862943611200509
julia> ans2 = set_A_sol(1.0)
0.0
julia> ans3 = set_A_sol(2.0)
-0.34657359027997264
Explanation:
If you look at the register function, defined in nlp.jl, "Registering" involves adding the symbol to a dictionary, held in ReverseDiffSparse.
Register a function and check those dictionaries manually to see what they look like.
So "de-registering" simply involves removing all traces of :f and its derivatives from all the places where it has been recorded.
Here's an extended answer based on Tasos's suggestions (thanks Tasos!).
tl;dr You can use try-catch statement for something that is already registered. You can also change parameters in the objective function in the global environment, but cannot wrap them in functions.
The following effectively permits checking for redefinition of a function:
function foo2( f, f1, f2 )
try
JuMP.register(:f,1,f1,f2)
end
####
# Optimization problem here using f
# Leads to some return statement
####
end
end
What's even better is that you can actually use the naive way that JuMP looks for f to change parameters in the objective function (although you need to redefine the model each time as you can't put a #NLparameter in a user-defined objective). For example:
using JuMP
using Ipopt
f = (x) -> exp( A * x ) - x
f1 = (x) -> A * exp( A * x ) - 1.0
f2 = (x) -> A * A * exp( A * x )
# Period objective function
JuMP.register(:f, 1, f, f1, f2)
A = 1.0
mod = Model(solver=Ipopt.IpoptSolver(print_level=0))
#variable(mod, - Inf <= x <= Inf )
#NLobjective(mod, Min, f(x) )
status=solve(mod)
println("x = ", getvalue(x))
# Returns 0
A = 2.0
mod = Model(solver=Ipopt.IpoptSolver(print_level=0))
#variable(mod, - Inf <= x <= Inf )
#NLobjective(mod, Min, f(x) )
status=solve(mod)
println("x = ", getvalue(x))
# Returns -0.34657 (correct)
You can even redefine f to something totally different and that will still work too. However, you can't wrap this in a function. For example:
function set_A_sol( A )
f = (x) -> exp( A * x ) - x
f1 = (x) -> A * exp( A * x ) - 1.0
f2 = (x) -> A * A * exp( A * x )
# Local redefinition of f
try
JuMP.register(:f, 1, f, f1, f2)
end
mod = Model(solver=Ipopt.IpoptSolver(print_level=0))
#variable(mod, - Inf <= x <= Inf )
#NLobjective(mod, Min, f(x) )
status=solve(mod)
return getvalue(x)
end
ans1 = set_A_sol(0.5)
ans2 = set_A_sol(1.0)
ans3 = set_A_sol(2.0)
# All return 1.38629
I don't totally understand why, but it appears that the first time that A is set inside set_A_sol, the JuMP registration fixes A once and for all. Given this is the thing that I ultimately want to be able to do, I'm still stuck. Suggestions welcome!
I defined a function called 'fun5' as follows:
function(y,mu=mu0,lsig=lsig0) {
res = exp(y)/(1+exp(y)) * 1/sqrt(2*pi)/exp(lsig) * exp(-(y-mu)^2/2/exp(lsig)^2)
return(res)
, then integrated the function from negative infinity to positive infinity with two parameters.
integrate(fun5,-Inf,Inf,mu=2.198216,lsig=-3)$value
This integral gives the expectation of a random variable which has logit-normal distribution with mu = 2.198216 and sigma = exp(-3).
This error occurred.
Error in integrate(fun5, -Inf, Inf, mu = 2.198216, lsig = -3) :
non-finite function value
Since the function 'fun5' is a random variable between 0 and 1 multiplied by probability density, it should be positive everywhere, though it might be very close to zero. I don't understand why it has non-finite value somewhere.
Could anybody give an advice?
The problem is that the function
exp(y)/(1+exp(y))
is rounded to NaN when y is too big. You can avoid this replacing it with 1 when y is too big. This function will play the trick:
fun5<-function(y,mu=mu0,lsig=-lsig0) {
res = ifelse(y<100, exp(y)/(1+exp(y)) * 1/sqrt(2*pi)/exp(lsig) * exp(-(y-mu)^2/2/exp(lsig)^2),
1/sqrt(2*pi)/exp(lsig) * exp(-(y-mu)^2/2/exp(lsig)^2))
return(res)}
and now this will work
integrate(fun5,-Inf,Inf,mu=2.198216,lsig=-3)$value
[1] 0.9
We can use, that
exp(y)/(1+exp(y)) is the same as (1 - 1/(1+exp(y))) or also1/(1+exp(-y))
fun5 <- function(y,mu=mu0,lsig=lsig0) 1/(1+exp(-y)) / sqrt(2*pi)/exp(lsig) * exp(-(y-mu)^2/2/exp(lsig)^2)
integrate(fun5,-Inf,Inf,mu=2.198216,lsig=-3)$value
.
> integrate(fun5,-Inf,Inf,mu=2.198216,lsig=-3)$value
[1] 0.9