I'm trying to find the roots of a function like this
f <- function(x) {
sum( tanh(Carray + x) ) - x
}
library(rootSolve)
roots <- uniroot.all(f,c(0,1))
where x is a scalar and Carray is an array. The problem seems to be that uniroot.all sends to f a whole array of x'es at once, and then R gets confused about doing Carray+x (warning: "longer object length is not a multiple of shorter object length").
Function f works as intended when x is a scalar. I am not sure how to vectorize f so that I can pass to it an array of x'es.
If we knew the size of Carray, it would maybe be possible to vectorize f more naturally, but for a general Carray you could use Vectorize:
roots <- uniroot.all(Vectorize(f), c(0, 1))
yes, example:
f <- function(x) {
sum(tanh(y+x))/100-x
}
vf <- Vectorize(f)
y=runif(100,-1,1)
f(x=0.5)
f(x=-0.5)
vf(x=1:2)
uniroot.all(vf,c(-.99,.99))
Related
Is there a way to make the following code idea work in R without defining f as a function of x and a?
f=function(x) a*x
g=function(y){
a=2
return(f(y))
}
The context is that I am composing several functions and at each stage, the output of some function is potentially a new parameter in the subsequent functions. I want to avoid making the parameters variables of each function because there (1) just too many and (2) some functions need vector inputs which become even messier when adding all parameters as scalar inputs to these functions.
With environments it's possible to define a in a new environment and call f.
f <- function(x) a*x
g <- function(y){
env <- new.env()
env$a <- 2
environment(f) <- env
do.call(f, list(y), envir = env)
}
g(1:5)
#[1] 2 4 6 8 10
Note that the environment of f hasn't changed.
environment(f)
#<environment: R_GlobalEnv>
It looks to me somewhat like a closure, a nice programming construct of a function that returns a function:
f <- function(a){
return(function(x) a*x)
}
g <- f(2)
g(3)
I am not sure if the code below is for your objective
f <- function(...) prod(...)
g <- function(...) f(c(a=2,...))
I now ended up using the superassignment operator which worked for my purposes.
f=function(x) a*x
g=function(y){
a<<-2
return(f(y))
}
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]])
}
Why there is no error reported when b is not supplied but required inside the function? Thanks!
f2 <- function(a,b) {a[b]}; f2(a=rep(1, 2))
I understand that there is no error in this function:
f <- function(x) {
10
}
f(stop("This is an error!"))
due to lazy evaluation
But this
f <- function(x) {
force(x)
10
}
f(stop("This is an error!"))
or this
f <- function(x) {
x
10
}
f(stop("This is an error!"))
will produce an error. Because in both cases x is used within the function. Both the above two examples are from http://adv-r.had.co.nz/Functions.html. Since b is also used within f2, should it be necessary to add force inside f2? Thanks!
x[b] returns (a duplicate of) x if b is missing. From the R source:
static SEXP VectorSubset(SEXP x, SEXP s, SEXP call)
{
R_xlen_t stretch = 1;
SEXP indx, result, attrib, nattrib;
if (s == R_MissingArg) return duplicate(x);
https://github.com/wch/r-source/blob/ec2e89f38a208ab02449b706e13f278409eff16c/src/main/subset.c#L169
From the documentation, in which 'empty' means 'missing', not NULL:
An empty index selects all values: this is most often used to replace all the entries but keep the attributes.
It has to do with the [ function, not lazy evaluation. You'll get an error if you do the following:
f3 <- function(a,b) {a+b}; f3(a = 1)
Note that since b is not defined, R is interpreting it as if it didn't exist. Try doing:
a <- c(1,1)
a[]
It seems that the subsetting function ( `[` ) actually takes ... as a parameter. I.e., specifying indices to subset are optional.
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
Suppose you define a function in R using the following code:
a <- 1
f <- function(x) x + a
If you latter redefine a you will change the function f. (So, f(1) = 2 as given but if you latter on redefine a =2 then f(1) = 3. Is there a way to force R to use the value of a at the time it compiles the function? (That is, f would not change with latter redefinitions of a).
The above is the shortest case I could thought of that embodies the problem I am having. More specifically, as requested, my situation is:
I am working with a bunch of objects I am calling "person". Each person is defined as a probability distribution that depends on a n dimensional vector $a$ and a n dimensional vector of constrains w (the share of wealth).
I want to create a "society" with N people, that is a list of N persons. To that end, I created two n by N matrices A and W. I now loop over 1 to N to create the individuals.
Society <- list()
### doesn't evaluate theta at the time, but does w...
for (i in 1:Npeople) {
w <- WealthDist[i,]
u <- function(x) prod(x^A[i,])
P <- list(u,w)
names(P) <- c("objective","w")
Society[[length(Society)+1]] <- P
}
w gets is pass-by-value, so each person gets the right amount of wealth. But A is pass-by-reference -- everybody is being assigned the same function u (namely, the function using i = N)
To finish it up, the next steps are to get the Society and, via two optimizations get an "equilibrium point".
You can create a function which uses a locked binding and creates a function to complete your purpose. The former value of a will be used for w which will be stored in the environment of the function and will not be replaced by further values changes of a.
a <- 1
j <- new.env() # create a new environment
create.func <- function () {
j$w <<- a
function (x) {
x+ j$w
}
}
f <- create.func()
a <- 2
f(2)
[1] 3 # if w was changed this should be 4
Credits to Andrew Taylor (see comments)
EDIT: BE CAREFUL: f will change if you call create.func, even if you do not store it into f. To avoid this, you could write this code (it clearly depends on what you want).
a <- 1
create.func <- function (x) {
j <- new.env()
j$w <- a
function (x) {
x + j$w
}
}
f <- create.func()
f(1)
[1] 2
a <- 2
q <- create.func()
q(1)
[1] 3
f(1)
[1] 2
EDIT 2: Lazy evaluation doesn't apply here because a is evaluated by being set to j$w. If you had used it as an argument say:
function(a)
function(x)
#use a here
you would have to use force before defining the second function, because then it wouldn't be evaluated.
EDIT 3: I removed the foo <- etc. The function will return as soon as it is declared, since you want it to be similar to the code factories defined in your link.
EDIT by OPJust to add to the accepted answer that in spirit of
Function Factory in R
the code below works:
funs.gen <- function(n) {
force(n)
function(x) {
x + n
}
}
funs = list()
for (i in seq(length(names))) {
n = names[i]
funs[[n]] = funs.gen(i)
}
R doesn't do pass by reference; everything is passed to functions by value. As you've noticed, since a is defined in the global environment, functions which reference a are referencing the global value of a, which is subject to change. To ensure that a specific value of a is used, you can use it as a parameter in the function.
f <- function(x, a = 1) {
x + a
}
This defines a as a parameter that defaults to 1. The value of a used by the function will then always be the value passed to the function, regardless of whether a is defined in the global environment.
If you're going to use lapply(), you simply pass a as a parameter to lapply().
lapply(X, f, a = <value>)
Define a within f
f <- function(x) {a<-1;x + a}