I am eager to use the R package BB to solve a system of non-linear equations, but the syntax does not seem to allow for parameters to be passed to the system of equations. Very strange since this would severely limit what appears to be an otherwise very appealing and powerful alternative to nleqslv().
To be clear: "Normally", you expect a solver to have a space for passing parameters to the underlying objective function. For eg. in nleqslv:
out <- nleqslv(in_x, obj_fn, jac = NULL, other_pars1, other_pars2, method = "Broyden")
Where "in_x" is the vector of initial guesses at a solution, and the "other_pars1, other_pars2" are additional fixed parameters (can be scalars, vectors, matrices, whatever) required by "obj_fn".
In BBsolve, on the other hand, you just have
out <- BBsolve(in_x, obj_fn)
With no space to put in all the "other_pars1, other_pars2" required by obj_fn.
Create a function that "attaches" additional parameters to your objective function. The key concept here is that the return value is itself a function:
gen_obj_fn <- function( obj_fn, other_pars1, other_pars2 )
{
function(x) { obj_fn( x, other_pars1, other_pars2 ) }
}
The output of gen_obj_fn can now be passed directly to BBsolve:
## Previous call using nleqslv():
out <- nleqslv( in_x, myFun, jac = NULL, myParam1, myParam2, ... )
## Equivalent call using BBsolve():
myObjF <- gen_obj_fn( myFun, myParam1, myParam2 )
is.function( myObjF ) ## TRUE
out <- BBsolve( in_x, myObjF )
You haven't shown how you are using BBsolve. As I said in my comment BBsolve certainly does accept additional function arguments.
But you must name those arguments.
See this example for how to do what you seem to want:
library(nleqslv)
f <- function(x,p1=3,p2=2) {
y <- numeric(2)
y[1] <- 10*x[1]+3*x[2]^2 - p1
y[2] <- x[1]^2 -exp(x[2]) -p2
y
}
xstart <- c(1,1)
nleqslv(xstart, f)
library(BB)
BBsolve(xstart,f)
Try slightly different values for p1 and p2:
nleqslv(xstart,f,p1=2.7,p2=2.1)
BBsolve(xstart,f,p1=2.7,p2=2.1)
Both functions find the same solution.
Related
I'm trying to create multiple functions with varying arguments.
Just some background: I need to compute functions describing 75 days respectively and multiply them later to create a Maximum-Likelihood function. They all have the same form, they only differ in some arguments. That's why I wanted to this via a loop.
I've tried to put all the equations in a list to have access to them later on.
The list this loop generates has 75 arguments, but they're all the same, as the [i] in the defined function is not taken into account by the loop, meanging that the M_b[i] (a vector with 75 arguments) does not vary.
Does someone know, why this is the case?
simplified equation used
for (i in 1:75){
log_likelihood[[i]] <-
list(function(e_b,mu_b){M_b[i]*log(e_b*mu_b))})
}
I couldn't find an answer to this in different questions. I'm sorry, if there's a similar thread already existing.
you need to force the evaluation of the variable M_b[i], see https://adv-r.hadley.nz/function-factories.html. Below I try and make it work
func = function(i){
i = force(i)
f = function(e_b,mu_b){i*log(e_b*mu_b) }
return(f)
}
# test
func(9)(7,3) == 9*log(7*3)
#some simulated values for M_b
M_b = runif(75)
log_likelihood = vector("list",75)
for (idx in 1:75){
log_likelihood[[idx]] <- func(M_b[idx])
}
# we test it on say e_b=5, mu_b=6
test = sapply(log_likelihood,function(i)i(5,6))
actual = sapply(M_b,function(i)i*log(5*6))
identical(test,actual)
[1] TRUE
This is called lazy evaluation, where R doesn't evaluate an expression when it is not used. As correctly pointed about by #SDS0, the value you get is at i=75. We try it with your original function:
func = function(i){function(e_b,mu_b){i*log(e_b*mu_b) }}
M_b = 1:3
log_likelihood = vector("list",3)
for (idx in 1:3){
log_likelihood[[idx]] = func(M_b[idx])
}
sapply(log_likelihood,function(f)f(5,6))
[1] 10.20359 10.20359 10.20359
#you get 10.20359 which is M_b[3]*log(5*6)
There is one last option, which I just learned of, which is to do lapply which no longer does lazy evaluation:
func = function(i){function(e_b,mu_b){i*log(e_b*mu_b) }}
log_likelihood = lapply(1:3,function(idx)func(M_b[idx]))
sapply(log_likelihood,function(f)f(5,6))
[1] 3.401197 6.802395 10.203592
I would like to use hash table to implement simple coversion script.
An input should be multiplied with a factor using its symbol, i.e. y = x * 1E-12, should be called e.g. y <- X2Y(x,"p") with "p" being the symbol for 1E-12.
library(hash)
sym2num <- function(x) {
h <- hash( c("f"=1E-15,"p"=1E-12,"n"=1E-9,"mu"=1E-6,"m"=1E-3,"c"=1E-2) )
return(h$x)
}
X2Y <- function(X,x) {
xNum <- sym2num(x)
Y <- X * xNum
return(Y)
}
# y = x * 1E-12
y <- X2Y(x,"p")
print(y)
With the above code I get numeric(0) as result. Any idaes where it goes wrong?
There’s no benefit to using the {hash} library here. Indeed, since you rehash your vector before each subsetting, this will be substantially less efficient than a direct lookup.
Even if you only constructed the hash table once instead of repeatedly, it would probably still be faster not to use it: the hash table implementation carries a substantial constant overhead. It’s only faster than direct vector or list subsetting for fairly large tables.
Instead, just do this:
sym2num <- function(x) {
c(f = 1E-15, p = 1E-12, n = 1E-9, mu = 1E-6, m = 1E-3, c = 1E-2)[x]
}
This is idiomatic, efficient R code.
Fundamentally, the mistake in your R code was the subsetting, h$x. This fails because the subset operator $ doesn’t work with variables, it expects an unevaluated name on its right-hand side. The code will thus always look up the literal name x inside h. thc’s answer shows how to avoid the issue.
Your function sym2num always returns the hash of "x", which is NULL.
h$x is a shortcut for h[["x"]], but what you want is h[[x]].
Instead use this:
sym2num <- function(x) {
h <- hash( c("f"=1E-15,"p"=1E-12,"n"=1E-9,"mu"=1E-6,"m"=1E-3,"c"=1E-2) )
return(h[[x]])
}
I need a function created by a list of commands to fully evaluate so that it is identical to the "manual" version of the function.
Background: I am using ScaleR functions in Microsoft R Server and need to apply a set of transformations as a function. ScaleR is very picky about needing to be passed a function that is phrased exactly as specified below:
functionThatWorks <- function(data) {
data$marital_status_p1_ismarried <- impute(data$marital_status_p1_ismarried)
return(data)
}
I have a function that creates this list of transformations (and hundreds more, hence the need to functionalize its writing).
transformList <- list ("data$ismarried <- impute(data$ismarried)",
"data$issingle <- impute(data$issingle)")
This line outputs the evaluated string that I want to the console, but I am unaware of a way to move it from console output to being used in a function:
cat(noquote(unlist(bquote( .(noquote(transformList[1]))))))
I need to evaluate functionIWant so that it is identical to functionThatWorks.
functionIWant <- function(data){
eval( cat(noquote(unlist(bquote( .(noquote(transformList[1])))))) )
return(data)
}
identical(functionThatWorks, functionIWant)
EDIT: Adding in the answer based on #dww 's code. It works well in ScaleR. It is identical, minus meaningless spacing.
functionIWant <- function(){}
formals(functionIWant) <- alist(data=NULL)
functionIWant.text <- parse(text = c(
paste( bquote( .(noquote(transformList[1]))), ";", "return(data)\n")
))
body(functionIWant) <- as.call(c(as.name("{"), functionIWant.text))
Maybe something like this?
# 1st define a 'hard-coded' function
f1 <- function (x = 2)
{
y <- x + 1
y^2
}
f1(3)
# [1] 16
# now create a similar function from a character vector
f2 <- function(){}
formals(f2) <- alist(x=2)
f2.text <- parse(text = c('y <- x + 1', 'y^2'))
body(f2) <- as.call(c(as.name("{"), f2.text))
f2(3)
# [1] 16
I am currently dealing with a problem. I am working on a package for some specific distributions where among other things I would like to create a function that will fit an mixture to some data. For this I would like to use for example the fitdistr function. The problem is that I don't know from what distributions and weights and number of components the mixture will be composed of. Hence I need a function that will dynamically create an density function of some specified mixture so the fitdistr function can use it. For example if the user will call:
fitmix(data,dist=c(norm,chisq),params=list(c(mean=0,sd=3),df=2),wights=c(0.5,0.5))
to use ML method the code needs to create an density function
function(x,mean,sd,df) 0.5*dnorm(x,mean,sd)+0.5*dchisq(x,df)
so it can call optim or fitdistr.
An obvious solution is to use a lot of paste+eval+parse but I don't think this is the most elegant solution. A nice solution is probably hiding somewhere in non-standard evaluation and expression manipulation, but I have not enough skills in this problematic.
P.S. the params can be used as starting values for the optimizer.
Building expressions is relatively straight forward in R with functions like as.call and bquote and the fact that functions are first class objects in R. Building functions with dynamic signatures is a bit trickier. Here's a pass at some function that might help
to_params <- function(l) {
z <- as.list(l)
setNames(lapply(names(z), function(x) bquote(args[[.(x)]])), names(z))
}
add_exprs <- function(...) {
x <- list(...)
Reduce(function(a,b) bquote(.(a) + .(b)), x)
}
get_densities <- function(f) {
lapply(paste0("d", f), as.name)
}
weight_expr <- function(w, e) {
bquote(.(w) * .(e))
}
add_params <- function(x, p) {
as.call(c(as.list(x), p))
}
call_with_x <- function(fn) {
as.call(list(fn, quote(x)))
}
fitmix <- function(data, dist, params, weights) {
fb <- Reduce( add_exprs, Map(function(d, p, w) {
weight_expr(w, add_params(call_with_x(d), to_params(p)))
}, get_densities(dist), params, weights))
f <- function(x, args) {}
body(f) <- fb
f
}
Note that I changed the types of some of your parameters. The distributions should be strings. The parameters should be a list of named vectors. It would work with a call like this
ff <- fitmix(data, dist=c("norm","chisq"), params=list(c(mean=0,sd=3),c(df=2)),
weights=c(0.5,0.5))
It returns a function that takes an x and a list of named arguments. You could call it like
ff(0, list(mean=3, sd=2, df=2))
# [1] 0.2823794
which returns the same value as
x <- 0
0.5 * dnorm(x, mean = 3, sd = 2) + 0.5 * dchisq(x, df = 2)
# [1] 0.2823794
So I just answered a question and as soon as it was answered (correctly I think), the questioner deleted it. So here it is again:
I am new to R and need help getting this function to work. I need to create a function that can find the log of an mgf for any function and return values for the specified t. I've done lots of research and I found a lot of stuff telling me to use Vectorize() and to make sure I'm defining my parameters properly but i still can't seem to get this to work. I would love if someone could help me out!
I need to write a function that returns a numeric vector for natural log of mgf
# I'm using the expression 2*x as an example
# You can use any integrand as long as it is a function of x
logmgf <- function(integrand, upper, lower, t) {
expression <- function(x, t) {
integrand * exp(x * t)
}
integrate <- integrate(expression(x, t), upper, lower)
logmgf <- log(Vectorize(integrate[1]))
return(logmgf)
}
logmgf(2 * x, upper = Inf, lower = 0, t = 0)
asked 2 hours ago
xiong lui
Let's try something more statistically or mathematically sensible, such as an un-normalized Normal distribution, namely the expression: exp(-x^2)
You are trying to create a new expression (actually an R "call") which will be parsed as the product of that expression times exp(x*t), so you need to a) deliver the function a real R language object and b) work with it using functions which will not mangle it. The quote-function will construct an expression that substitute can manipulate at the "language level". The function-function unfortunately will evaluate the "body" argument in a manner that will not honor your symbolic intent, so you need to use the body<- (function) which expects an expression on the right-hand side of the assignment operator. I'm going to leave in some of the debugging print(.) calls that I used to understand where I was going wrong in my earlier efforts:
logmgf <- function(integrand, upper, lower, t) {
expr <- substitute( integrand *exp(x*t), list(integrand=integrand) )
print(expr)
func <- function(x ){} # builds an empty function in x
body(func)<- expr # could have also set an environment
# but in this case using envir=parent.frame() is not appropriate
print(func)
integral <- integrate( func, upper=upper,
# notice need to name the parameters
lower=lower
# else they would be positionally matched
# (and therefore reversed in this case)
)$value
# the integrate fn returns a loist and the numeric part is in $value
logmgf <- log(integral)
}
res <- logmgf(quote(exp(-x^2)), upper = Inf, lower = -Inf, t = 0)
> res
[1] 0.5723649
MGF's are integrated from -Inf to Inf (or for functions with restricted domains only over the x's with defined values).
I wanted to check that I would get the correct answer from a known argument so I added back the proper normalizing constant for a Normal distribution:
mgf <- function(integrand, upper, lower, t) {
expr <- substitute( integrand *exp(x*t), list(integrand=integrand) )
func <- function(x ){}; body(func)<- expr
integral <- integrate( func, upper=upper, lower=lower)$value
}
res <- mgf(quote((1/sqrt(2*pi))*exp(-x^2/2)), upper = Inf, lower = -Inf, t = 0)
res
#[1] 1