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
Related
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 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.
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
How can I tell R to use the default value of a function argument without i) omitting the argument in the function call and ii) without knowing what the default value is?
I know I can use the default value of mean in rnorm():
rnorm(n = 100) # by omitting the argument
# or
rnorm(n = 100, mean = 0) # by including it in the call with the default value
But assume I don't know the default value but want to include it explicitly in the function call. How can I achieve that?
You can access the argument list and default values via:
> formals(rnorm)
$n
$mean
[1] 0
$sd
[1] 1
formals("rnorm") also works. Some simple examples:
> rnorm(10,mean = formals(rnorm)$mean)
[1] -0.5376897 0.4372421 0.3449424 -0.9569394 -1.1459726 -0.6109554 0.1907090 0.2991381 -0.2713715
[10] -1.4462570
> rnorm(10,mean = formals(rnorm)$mean + 3)
[1] 2.701544 2.863189 1.709289 2.987687 2.848045 5.136735 2.559616 3.827967 3.079658 5.016970
Obviously, you could store the result of formals(rnorm) ahead of time as well.
As #joran has already pointed out, formals() exposes the default values. However, as I understand the question, what you're really after is the construction of the call expression. To that end, it is useful to combine formals() with as.call() to produce the call itself. The following function does just that, by producing a function that produces "argument-completed calls," for a given function name f:
drop_missing <- function(sig) {
sig[!sapply(sig, identical, quote(expr =))]
}
complete_call <- function(f) {
nm <- as.name(f)
sig <- formals(args(f))
make_call <- function() {
args <- match.call()[-1]
sig[names(args)] <- args
as.call(c(nm, drop_missing(sig)))
}
formals(make_call) <- sig
make_call
}
Example usage:
complete_call("log")(1)
#> log(x = 1, base = exp(1))
complete_call("rnorm")(10)
#> rnorm(n = 10, mean = 0, sd = 1)
complete_call("rnorm")()
#> rnorm(mean = 0, sd = 1)
Remarks:
1) The output is a language object. To execute the call, you need to evaluate it, e.g.,
eval(complete_call("rnorm")(10))
#> [1] -0.89428324 -1.78405483 -1.83972728 ... (output truncated)
2) If you want complete_call() to accept a function, rather than the name of a function, you could write nm <- as.name(deparse(substitute(f))) in place of the given assignment. However, that would not work in a nested call, where you would get as.name("f") for nm, because of R's rules fo lexical scoping.
3) Without the call to args() in the assignment of sig, complete_call() would only work for closures, since primitive and builtin functions don't have formals.
I have the following problem: I'm writing a function which first constructs a long character string which stands for a mathematical function, e.g. "1/(1+exp(-x1+4x3))". I now want to maximize this function, but unfortunately I cannot do so because the mathematical function is only saved as a character string and not as an R-function. How can I solve this problem? Thanks in advance!
If we know what the arguments are ahead of time then (1) would be preferred as it is simpler (4 lines of code) but if we don't then (2) covers generating them as well (8 lines of code).
1) dynamic body This will convert the string s into a function f2 of 2 arguments which we can call from f1 having one argument as required by optim:
s <- "1/(1+exp(-x1+4*x3))" # test input
f1 <- function(x) do.call("f2", as.list(x)) # f1 calls f2
f2 <- function(x1, x3) {}
body(f2) <- parse(text = s)
optim(c(0, 0), f1, control = list(fnscale = -1))
2) dynamic body + dynamic args In the above we dynamically created the body from the string assuming we knew the arguments but if you want to dynamically create both the body and arguments then try this. Here f2 no longer necessarily has 2 arguments but has nv arguments and what they are is derived from the input s.
s <- "1/(1+exp(-x1+4*x3))" # test input - same as above
f1 <- function(x) do.call("f2", as.list(x)) # function on one argument - same as above
# f2 has nv arguments
f2 <- function() {}
p <- parse(text = s)
v <- all.vars(p) # character string of variable names used for arguments
nv <- length(v)
formals(f2) <- setNames(rep(alist(x=), nv), v)
body(f2) <- p
optim(numeric(nv), f1, control = list(fnscale = -1)) # first arg different from (1)
I'm writing a function which first constructs a long character string which stands for a mathematical function
Don't do that. I'm sure there is a better approach.
because the mathematical function is only saved as a character string and not as an R-function
You'd need to parse the string (after making it valid R syntax):
expr <- parse(text = gsub("((?<=\\d)[[:alpha:]])", "\\*\\1","1/(1+exp(-x1+4x3))", perl = TRUE))
Then you can use this expression to "find the maximum" with whatever method you'd like to use.
However, as fortune 106 says:
If the answer is parse() you should usually rethink the question.