Environments and the like have always confused me incredibly in R. I guess therefore this is more of a reference request, since I've been surfing the site for the last hour in search of an answer to no avail.
I have a simple R function called target defined as follows
target <- function(x,scale,shape){
s <- scale
b <- shape
value <- 0.5*(sin(s*x)^b + x + 1)
return(value)
}
I then define the function AR
AR <- function(n,f,...){
variates <- NULL
for(i in 1:n){
z <- runif(1)
u <- runif(1)
if(u < f(z, scale, shape)/c){
variates[i] <- z
}else{next}
}
variates <- variates[!is.na(variates)]
return(variates)
}
in which the function target is being evaluated. Unfortunately, the call returns the following error
sample <- AR(n = 10000, f = target, shape = 8, scale = 5)
Error in fun(z, scale, shape) : object 'shape' not found
I know this has to do with the function AR not knowing where to look for the objects shape and scale, but I thought that was exactly the job of the ellipsis: allowing me to sort of put argument definition "on hold" until one actually calls the function. Where am I wrong and could anyone give me a lead as to where to look for insight on this specific problem?
You are very close, you just need to make use of your ellipses...
NB: c was not defined in AR so I added it and gave it a value.
NB2: I would refrain from using c and sample in your function as these themselves are functions and could cause some confusion downt he road.
AR <- function(n, f, c, ...){
variates <- NULL
for(i in 1:n){
z <- runif(1)
u <- runif(1)
if(u < f(z, ...)/c){ ##instead of using shape and scale use the ellipses and R will insert any parameters here which were not defined in the function
variates[i] <- z
}else{next}
}
variates <- variates[!is.na(variates)]
return(variates)
}
sample <- AR(n = 10000, f = target, shape = 8, scale = 5, c = 100)
Related
The problem is to simulate an equation with variables that change. All the variables are fixed, expect for lower case s and treat_date. Here is the error message:
Error in checkFunc(Func2, times, y, rho) : The number of derivatives
returned by func() (202) must equal the length of the initial
conditions vector (2)
I have tried moving things around but I honestly have no idea what I am doing
seasonal_SI <- function (t, y, parameters) {
S <- y[1]
I <- y[2]
with(as.list(parameters), {
julian_date <- t %% 365
v <- ifelse(julian_date >= treat_date &
julian_date < (treat_date + 10) &
treatment, 0.9, v)
beta <- beta0 + s*beta0*sin(2*pi*(julian_date)/365)
dSdt <- b*(1-c*(S+I))*(S+rho*I)-d*S-beta*S*I
dIdt <- beta*S*I-(d+v)*I
res <- c(dSdt, dIdt)
list(res)
})
}
initials <- c(S=99, I=1)
params <- c(b=.5, c=.01, beta0=5e-3, v=.05, rho=.3, treatment=TRUE,
s=as.numeric(seq(from=0, to=1, by=.01)),
treat_date=as.numeric(seq(from=0, to=355, length.out=101)))
t <- 0:1
library("deSolve")
lsoda(y=initials, times=t, parms=params, func=seasonal_SI)
I would like for it to run and return a graph.
I agree with the former comment, that you may consider to use a parameter list. However, you may also consider to use a forcing function or the event mechanism.
You find help pages in deSolve:
?forcings
?events
and a short tutorial here: https://tpetzoldt.github.io/deSolve-forcing/deSolve-forcing.html
I am trying to do multiple samples of a distribution with a function. The trouble I am having is that when I pass the distribution into the function all the means come out the same as it appears my distribution is not being run each time inside the for loop.
Test line:
test(100,100,dist = rbinom(x, 1, 0.50))
Code
test = function(N, n, dist){
means = matrix(rep(0,times=N,nrow=N,ncol=1))
x = n
for(i in 1:N){
means[i,1]<- mean(dist)
print(means[i,1])
}
}
This question is similar to Passing a function argument to other arguments which are functions themselves but I seem to be having a different type of problem.
One option would be to pass function and parameters separately. E.g.
test(100, 100, dist = rbinom, list(1, 0.5))
test = function(N, n, dist, ...){
means = matrix(rep(0,times=N,nrow=N,ncol=1))
x = n
for(i in 1:N){
means[i, 1] <- mean(do.call(dist, c(x, ...)))
print(means[i, 1])
}
}
Consider a hypothetical example:
sim <- function(n,p){
x <- rbinom(n,1,p)
y <- (x==0) * rnorm(n)
z <- (x==1) * rnorm(n,5,2)
dat <- data.frame(x, y, z)
return(dat)
}
Now I want to write another function simfun where I will call the above sim function and check if y and z columns of the data frame is less than a value k.
simfun <- function(n, p, k){
dat <- sim(n, p)
dat$threshold <- (dat$y<=k & dat$z<=k)
return(dat$threshold)
}
But is it standard to use the argument of sim as the argument of simfun? Can I write simfun <- function(k) and call the sim function inside simfun?
I'd say it's fairly standard to do this sort of thing in R. A few pointers to consider:
Usually you should explicitly declare the argument names so as not to create any unwanted behaviour if changes are made. I.e., instead of sim(n, p), write sim(n = n, p = p).
To get simfun() down to just a k argument will require default values for n and p. There are lots of ways to do this. One way would be to hardcode inside simfun itself. E.g.:
simfun <- function(k) {
dat <- sim(n = 100, p = c(.4, .6))
dat$threshold <- (dat$y<=k & dat$z<=k)
return(dat$threshold)
}
simfun(.5)
A more flexible way would be to add default values in the function declaration. When you do this, it's good practice to put variables with default values AFTER variables without default values. So k would come first as follow:
simfun <- function(k, n = 100, p = c(.4, .6)){
dat <- sim(n, p)
dat$threshold <- (dat$y<=k & dat$z<=k)
return(dat$threshold)
}
simfun(.5)
The second option is generally preferable because you can still change n or p if you need to.
While not great, you could define n and p separately
n <- 1
p <- .5
simfun <- function(k){
dat <- sim(n, p)
dat$threshold <- (dat$y<=k & dat$z<=k)
return(dat$threshold)
}
You can read more about R Environments here: http://adv-r.had.co.nz/Environments.html
I have the following set of functions.
funk <- function(x,b) { 10^b * exp(-x/10) }
lambda <- function(y,k) { exp(-k*y) }
funk1 <- function(y,x,xb,b,k) {
funk(x-xb-y,b) *exp(- integrate(lambda, lower=0, upper = y, k=k)$value) }
funk2 <-function(x,xb,b,k) {
integrate(funk1, lower= 0, upper=x-xb, x=x,xb=xb, b=b,k=k)$value }
funk2_vc <- Vectorize(funk2)
optim_funk2 <- function(param) {
b <-param[1]
k <- param[2]
R1 <- sum((y - funk2_vc(xx,xb,b,k))^2)
-log(R1) }
fit <- optim(par=c(5, 0.05), fn=optim_funk2)
and
xx <- seq(0,500,5)
xb <- seq(0,100,1)
y <- seq(1000,0,-10)
I wish to profile the function funk2 to figure out the path that optim has taken to estimate parameter values and if the function is optimizied for local or global minima.
I am a newbie to R and have no clue how to go about it. All suggestions welcome.
Here's a simple way to track the path of the parameters. I'll use linear regression as an example. Say our data is
x <- 1:10
y <- -3 + 2 * x + rnorm(length(x))
plot(x, y)
So y is a linear function of x plus some noise. Our goal is to find parameters a and b such that the sum of squared errors sum((y - (a + b * x))^2) is minimized. (This can of course be solved algebraically, but for illustration we'll solve it with optim().)
Here's the code to do the optimization and keep track of parameters:
par.path <- matrix(nrow=0, ncol=2, dimnames=list(NULL, c("a","b")))
funk <- function(par) {
a <- par[1]; b <- par[2]
par.path <<- rbind(par.path, par)
sum((y - (a + b * x))^2)
}
optim(par=c(0,0), fn=funk)
The first line creates a 0-row matrix called par.path to store the parameter path. Within the objective function funk, we add the current value of par to par.path. Note that we have to use <<- rather than <- to update par.path because it lives outside the scope of funk. (If we used <-, then funk would create a new local variable also called par.path, and the par.path outside the function wouldn't get updated.) Since optim calls funk repeatedly, par.path will get progressively longer (more rows).
There are various ways to plot the matrix par.path. Since in this case there are only two parameters, we can plot them against each other:
plot(par.path, type='l')
points(par.path[c(1,nrow(par.path)),], col=c("green","red"), cex=2, pch=16)
The 2nd line adds green and red dots to indicate the start and stop of the path. More flexibly, we can plot all the columns of par.path against the iteration number of optim:
matplot(par.path, type='l', col=c("black","red"), lty=1)
legend("bottomleft", c("a","b"), col=c("black","red"), lty=1)
Here are these two plots.
I found out that boot function of the boot package is not working with complex numbers. I am trying to bootstrap a data by taking the eigenvalue of the bivariate matrix. The problem with the eigenvalue is that, it often returns complex numbers, and by that it (boot) gives error. Is there a way to avoid complex numbers?
Here is my codes,
Data <- read.table('http://ubuntuone.com/6n1igcHXq4EnOm4x2zeqFb', header = FALSE)
Mat <- cbind(Data[["V1"]],Data[["V2"]])
Data.ts <- as.ts(Mat)
Below are some functions needed,
library(mvtnorm)
var1.sim <- function(T, n.start=100, phi1=matrix(c(0.7,0.2,0.2,0.7),nr=2),
err.mu=c(0,0), err.sigma2=matrix(c(1,0.5,0.5,1), nr=2),
errors=NULL) {
e <- rmvnorm(n.start + T, err.mu, err.sigma2) # (n.start+T) x 2 matrix
y <- matrix(0, nrow=n.start+T, ncol=2)
if (!is.null(errors) && is.matrix(errors) && ncol(errors) == 2) {
rows <- nrow(errors)
if (rows < n.start + T) {
# replace last nrow(errors) errors
e[seq.int(n.start+T-rows+1,n.start+T),] <- errors
} else {
e <- errors[seq.int(n.start+T+1, rows)]
}
}
for (t in seq.int(2, n.start + T)) {
y[t,] <- phi1 %*% y[t-1,] + e[t,]
}
return(ts(y[seq.int(n.start+1,n.start+T),]))
}
########
coef.var1 <- function(var.fit) {
k <- coef(var.fit)
rbind(k[[1]][,"Estimate"], k[[2]][,"Estimate"])
}
And here is the main method,
library(vars)
library(boot)
y.var <- VAR(Data.ts, p=1, type="none")
y.resid <- resid(y.var)
rm(y.boot)
y.boot <- boot(y.resid, R=100, statistic=function(x,i) {
resid.boot <- x[i,]
y.boot1 <- var1.sim(T=nrow(x), errors=resid.boot)
min(eigen(coef.var1(VAR(y.boot1, p=1, type="none")))$values)
}, stype="i")
y.boot$t
y.ci <- boot.ci(y.boot, type="norm", conf=0.95)$normal[2:3]
list(t=y.boot$t,ci=y.ci)
The problem occurs in y.boot object, particularly this line
min(eigen(coef.var1(VAR(y.boot1, p=1, type="none")))$values)
When the obtain minimum eigenvalue is complex, then boot will return this error
Error in min(eigen(coef.var1(VAR(y.boot1, p = 1, type = "none")))$values) :
invalid 'type' (complex) of argument
Otherwise, there is no problem. Now, it would be safe if this 100 bootstraps is performed once, but I am going to loop this actually about 100 times too. So, there is a big chance that complex values will occur in these loops. Hence, we will obtain the above error again.
Is there a way to avoid these complex values?