I am trying to solve an ODE in R using deSolve. With the following code, I expected the parameter gamma0 takes the values 5 at time step 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 and 10, and 0 otherwise. However, the print(gamma0) shows that gamma0 stays at 0.
Here is my ODE:
library(deSolve)
param <- c(a = 0.1, b = 1)
yini <- c(alpha0 = 6, beta0 = 2)
mod <- function(times, yini, param) {
with(as.list(c(yini, param)), {
gamma0 <- ifelse(times %in% seq(0,10,1), 5, 0)
## print(gamma0)
dalpha0 <- - a*alpha0 + gamma0
dbeta0 <- a*alpha0 - b*beta0
return(list(c(dalpha0, dbeta0)))
})}
times <- seq(from = 0, to = 10, by = 1/24)
out <- ode(func = mod, times = times, y = yini, parms = param)
plot(out, lwd = 2, xlab = "day")
What am I doing wrong?
This is a really simple modification of your function. If you're interested in knowing what you are doing wrong you can look below.
mod <- function(times, yini, param) {
dt = times[2] - times[1]
with(as.list(c(yini, param)), {
gamma0 <- ifelse(times <= 10*dt, 5, 0)
## print(gamma0)
dalpha0 <- - a*alpha0 + gamma0
dbeta0 <- a*alpha0 - b*beta0
return(list(c(dalpha0, dbeta0)))
})}
EDIT
Same as G5W's answer, the problem is with what you are comparing times to.
When you are writing
times %in% seq(0,10,1)
you are not referring to time steps. You simply refer to the values of times.
So, if you want to have it for the first 10 time steps you just need to go with my code or anything that considers the dt.
But here's a question for you:
If you do not need gamma0 to change according to times and want it to be 5 at the first 11 (10) time steps, why you are comparing it to times? Why not simply set it to be 5 for those time steps?
I get a slightly different result from you. If I uncomment the print(gamma0) it prints out 5 twice then prints out 513 zeros. It is not hard to trace why in a superficial way, although you may want more than I will offer here.
Where you have the (commented out) statement print(gamma0) instead, put the line:
cat("g:", gamma0, " t:", times, "\n")
and run the code. You will see that the first two times it displays are 0. Since those are on your list seq(0,10,1) gamma0 is 5. After that, the times values displayed change. Notice that none of them that are printed are from your original list of times seq(from = 0, to = 10, by = 1/24) and none of them are integers so none meet your condition to set gamma0 to 5. ode is doing something with the times (interpolating?) but it is not simply using the values that you provided. In fact, it does not print out 241 values of gamma0 and times. It prints out 515 such values. I note that the result out does have 241 values.
I think from your question that you assumed ode would actually evaluate the function at your times. It does not. It is treating times like a continuous variable. But your condition
gamma0 <- ifelse(times %in% seq(0,10,1), 5, 0)
only tests for 11 specific values - not ranges of values. A continuous variable is quite unlikely to hit exactly those values.
M--'s answer doesn't works for me, what if you just try this?
mod <- function(times, yini, param) {
with(as.list(c(yini, param)), {
if (times < 10) {
gamma0 = 5
} else if (times >= 10) {
gamma0 = 0
}
dalpha0 <- -a * alpha0 + gamma0
dbeta0 <- a * alpha0 - b * beta0
return(list(c(dalpha0, dbeta0)))
})
}
This works as a Headvise type function
Related
Recently, I learned how to write a loop that initializes some number, and then randomly generates numbers until the initial number is guessed (while recording the number of guesses it took) such that no number will be guessed twice:
# https://stackoverflow.com/questions/73216517/making-sure-a-number-isnt-guessed-twice
all_games <- vector("list", 100)
for (i in 1:100){
guess_i = 0
correct_i = sample(1:100, 1)
guess_sets <- 1:100 ## initialize a set
trial_index <- 1
while(guess_i != correct_i){
guess_i = sample(guess_sets, 1) ## sample from this set
guess_sets <- setdiff(guess_sets, guess_i) ## remove it from the set
trial_index <- trial_index + 1
}
## no need to store `i` and `guess_i` (as same as `correct_i`), right?
game_results_i <- data.frame(i, trial_index, guess_i, correct_i)
all_games[[i]] <- game_results_i
}
all_games <- do.call("rbind", all_games)
I am now trying to modify the above code to create the following two loops:
(Deterministic) Loop 1 will always guess the midpoint (round up) and told if their guess is smaller or bigger than the correct number. They will then re-take the midpoint (e.g. their guess and the floor/ceiling) until they reach the correct number.
(Semi-Deterministic) Loop 2 first makes a random guess and is told if their guess is bigger or smaller than the number. They then divide the difference by half and makes their next guess randomly in a smaller range. They repeat this process many times until they reach the correct number.
I tried to write a sketch of the code:
#Loop 2:
correct = sample(1:100, 1)
guess_1 = sample(1:100, 1)
guess_2 = ifelse(guess_1 > correct, sample(50:guess_1, 1), sample(guess_1:100, 1))
guess_3 = ifelse(guess_2 > correct, sample(50:guess_2, 1), sample(guess_2:100, 1))
guess_4 = ifelse(guess_4 > correct, sample(50:guess_3, 1), sample(guess_3:100, 1))
#etc
But I am not sure if I am doing this correctly.
Can someone please help me with this?
Thank you!
Example : Suppose I pick the number 68
Loop 1: first random guess = 51, (100-51)/2 + 51 = 75, (75-50)/2 + 50 = 63, (75 - 63)/2 + 63 = 69, (69 - 63)/2 + 63 = 66, etc.
Loop 2: first random guess = 53, rand_between(53,100) = 71, rand_between(51,71) = 65, rand(65,71) = 70, etc.
I don't think you need a for loop for this, you can create structures since the beginning, with sample, sapply and which:
## correct values can repeat, so we set replace to TRUE
corrects <- sample(1:100, 100, replace = TRUE)
## replace is by default FALSE in sample(), if you don't want repeated guesses
## sapply() creates a matrix
guesses <- sapply(1:100, function(x) sample(1:100, 100))
## constructing game_results_i equal to yours, but could be simplified
game_results_i <- data.frame(
i = 1:100,
trial_index = sapply(
1:100,
function(x) which(
## which() returns the index of the first element that makes the predicate true
guesses[, x] == corrects[x]
)
),
guess_i = corrects,
correct_i = corrects # guess_i and correct_i are obviously equal
)
Ok, let's see if now I match question and answer properly :)
If I got correctly your intentions, in both loops, you are setting increasingly finer lower and upper bounds. Each guess reduces the search space. However, this interpretation does not always match your description, please double check if it can be acceptable for your purposes.
I wrote two functions, guess_bisect for the deterministic loop_1 and guess_sample for loop_2:
guess_bisect <- function(correct, n = 100) {
lb <- 0
ub <- n + 1
trial_index <- 1
guess <- round((ub - lb) / 2) + lb
while (guess != correct) {
# cat(lb, ub, guess, "\n") # uncomment to print the guess iteration
if (guess < correct)
lb <- guess
else
ub <- guess
guess <- round((ub - lb) / 2) + lb
trial_index <- trial_index + 1
}
trial_index
}
guess_sample <- function(correct, n = 100) {
lb <- 0
ub <- n + 1
trial_index <- 1
guess <- sample((lb + 1):(ub - 1), 1)
while (guess != correct) {
# cat(lb, ub, guess, "\n") # uncomment to print the guess iteration
if (guess < correct)
lb <- guess
else
ub <- guess
guess <- sample((lb + 1):(ub - 1), 1)
trial_index <- trial_index + 1
}
trial_index
}
Obviously, guess_bisect always produces the same results with the same input, guess_sample changes randomly instead.
By plotting the results in a simple chart, it seems that the deterministic bisection is on the average much better, as the random sampling may become happen to pick improvements from the wrong sides. x-axis is the correct number, spanning 1 to 100, y-axis is the trial index, with guess_bisect you get the red curve, with many attempts of guess_sample you get the blue curves.
I'm trying to create values conditioned for some parameters given the initial values of states. For example, if D state is D >= 60, the S value will be S=1800. Otherwise, if D state is D <60 the S value will be S=4800. I used function if-else into the ode function (AedesIbag_model). When I run ode with D=70 if-else doesn't switch S parameter value. So I have not achieved to do that this works well. I apologize if my English is not very good. Thank you for any help.
library(deSolve)
AedesIbag_model<-function(t, state, parameters) {
with(as.list(c(state, parameters)), {
dL = R*theta*S - mu_L*L - gamma_L*L - mu_w*L
dP = gamma_L*L - mu_P*P - gamma_P*P - mu_w*P
dA = gamma_P*P - mu_A*A
dD = beta - alpha*D
if (D >= 60) {
S = 1800
} else if (D < 60) {
S = 4800
} else if (D >= 10) {
mu_w = 0.1
} else if (D < 60) {
mu_w = 0.1*100
}
return(list(c(dL, dP, dA, dD)))
})
}
parameters <- list(R = 0.24, theta = 10, S = 0,
gamma_L = 0.2088, gamma_P = 0.384,
beta = 10, mu_L = 0.0105, mu_P = 0.01041,
mu_A = 0.091, mu_w = 0.1, alpha = 10
)
state <- c(L = 100, P = 60, A = 10, D = 70)
times <- seq(0, 100, by = 0.1)
out_1 <- ode(y = state, times = times, func = AedesIbag_model, parms = parameters)
parameters
when I run my model. the parameters conditioned don't change the values. Look!!!
> parameters
$R
[1] 0.24
$theta
[1] 10
$S
[1] 0 #S value doesn't change
$gamma_L
[1] 0.2088
$gamma_P
[1] 0.384
$beta
[1] 10
$mu_L
[1] 0.0105
$mu_P
[1] 0.01041
$mu_A
[1] 0.091
$mu_w
[1] 0 #S value doesn't change
$alpha
[1] 10
I apologize if my English is not very good. Thank you for any help.
I'm guessing you are using pkg deSolve. Looking at your code, the first thing to notice is that trying to assess the function's behavior by printing the value of parameters is not productive. The ode function only accepts those values, but does not modify them, since R is a functional language and therefore should not modify its arguments. The next error to correct is the if-else construction. It would never modify the mu_w parameter in its current form, because either D >= 60 or D < 60 so S might get modified be never mu_w.
I don't know whether if(.){.}else{.} construction will work and started out taking your word for it that it was failing until I realized what I wrote above. So I used a different form of logical operations replacing the cascading if-else construction with Boolean math:
S <- (D >= 60)* 1800 + (D < 60) * 4800
mu_w <- (D >= 10) * 0.1 + (D < 60)* 0.1*100
I also thought that the names of the function arguments to ode should match those in your target functions, so should be parms rather than parameters, but I didn't see much difference in the behavior when I made that change, so maybe arguments are passed by position rather than by name. If you want to see how the result of the ode call evolves, it is more effective to to plot the results:
png(); matplot(out_1, pch=1:3)
legend("topright", 4, unlist(dimnames(out_1)[2]),
pch = 1:5, col = 1:5)
dev.off()
A further note on debugging: Since the value of parameters is not changed, you would need to put a print or cat statement inside the defined function to monitor changes in the local environments values for the named parameters.
Using packageDescription('deSolve') one learns that there is a gitHub hosted webpage that has tutorials. One further learns at that page that there is a help page on the topic ?forcings. I can highly recommend the very readable text, "Solving Differential Equations in R". There is also a link to the dynamic models mailing list: mailing list: https://stat.ethz.ch/mailman/listinfo/r-sig-dynamic-models
After a brief look at the material on the tutorial and `?forcings" my suspicion is that the package authors are advising a piecewise linear function rather than a discontinuous function for parameters that have a regime change.
I am trying to simulate 5000 samples of size 5 from a normal distribution with mean 5 and standard deviation 3. I want to then compute the mean of each sample and make a histogram of the sample means
My current code is not giving me an error but I don't think it's right:
nrSamples = 5000
e <- list(mode="vector",length=nrSamples)
for (i in 1:nrSamples) {
e[[i]] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means <- matrix(NA, 5000,1)
for (i in 1:5000){
sample_means[i] <- mean(e[[i]])
}
Any idea on how to tackle this? I am very very new to R!
You don't need a list in this case. It is a common mistake of new R users to use lists excessively.
observations <- matrix(rnorm(25000, mean=5, sd=3), 5000, 5)
means <- rowMeans(observations)
Now means is a vector of 5000 elements.
You can actually do this without for loops. replicate can be used to create the 5000 samples. Then use sapply to return the mean of each sample. Wrap the sapply call in hist() to get the histogram of means.
dat = replicate(5000, rnorm(5,5,3), simplify=FALSE)
hist(sapply(dat, mean))
Or, if you want to save the means:
sample.means = sapply(dat,mean)
hist(sample.means)
I think your code is giving valid results. list(mode="vector",length=nrSamples) isn't doing what I think you intended (run it in the console and see what happens), but it works out because the first two list elements get overwritten in the loop.
Although there's no need to use loops here, just for illustration here are two modified versions of your code using loops:
# 1. Store random samples in a list
e <- vector("list", nrSamples)
for (i in 1:nrSamples) {
e[[i]] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means = rep(NA, nrSamples)
for (i in 1:nrSamples){
sample_means[i] <- mean(e[[i]])
}
# 2. Store random samples in a matrix
e <- matrix(rep(NA, 5000*5), nrow=5)
for (i in 1:nrSamples) {
e[,i] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means = rep(NA, nrSamples)
for (i in 1:nrSamples){
sample_means[i] <- mean(e[, i])
}
Your code is fine (see below), but I would suggest you try the following:
yourlist <- lapply(1:nrSamples, function(x) rnorm(n=5, mean = 5, sd = 3 ))
yourmeans <- sapply(yourlist, mean)
Here, for each element of the sequence 1, 2, 3, ... nrSamples that I supply as the first argument, lapply executes an function with the given element of the sequence as argument (i.e. x). The function that I have supplied does not depend on x, however, so it is just replicated 5000 times, and the output is stored in a list (this is what lapply does). It is an easy way to avoid loops in situations like these. Needless to say, you could also just run
yourmeans <- sapply(1:nrSamples, function(x) mean(rnorm(n=5, mean = 5, sd = 3)))
Apart from the means, the latter does not store your results though, which may not be what you want. Also note that I call sapply to return a vector, which you can then use to plot your histogram, using e.g. hist(yourmeans).
To show that your code is fine, consider the following:
set.seed(42)
nrSamples = 5000
e <- list(mode="vector",length=nrSamples)
for (i in 1:nrSamples) {
e[[i]] <- rnorm(n = 5, mean = 5, sd = 3)
}
sample_means <- matrix(NA, 5000,1)
for (i in 1:5000){
sample_means[i] <- mean(e[[i]])
}
set.seed(42)
yourlist <- lapply(1:nrSamples, function(x) rnorm(n=5, mean = 5, sd = 3 ))
yourmeans <- sapply(yourlist, mean)
all.equal(as.vector(sample_means), yourmeans)
[1] TRUE
Here, I set the seed to the random number generator to make sure that the random numbers are the same. As you see, your code works fine, though as others have pointed out, loops can easily be avoided.
I am working with the genalg library for R, and try to save all the generations when I run a binary generic algorithm. It does not seems like there is a built-in method for that in the library, so my attempt was to save each chromosome, x, coming through the evaluation function.
To test this method I have tried to insert print(x) in the evaluation function to be able to see all the evaluated chromosomes. However, the number of printed chromosomes does not always match what I am suspecting.
I thought that the number of printed chromosomes would be equal to the number of iterations times the population size, but it does not seems to be try all the time.
The problem is that I want to know from which generation (or iteration) each chromosome belongs, which I can't tell if the number of chromosomes are different from iter times popSize.
What is the reason for this, and how can I "fix" it. Or is there another way of saving each chromosome and from which iteration it belongs?
Below is an example, where I thought that the evaluation function would print 2x5 chromosomes, but only prints 8.
library(genalg)
library(ggplot2)
dataset <- data.frame(
item = c("pocketknife", "beans", "potatoes", "unions", "sleeping bag", "rope", "compass"),
survivalpoints = c(10, 20, 15, 2, 30, 10, 30),
weight = c(1, 5, 10, 1, 7, 5, 1))
weightlimit <- 20
evalFunc <- function(x) {
print(x)
current_solution_survivalpoints <- x %*% dataset$survivalpoints
current_solution_weight <- x %*% dataset$weight
if (current_solution_weight > weightlimit)
return(0) else return(-current_solution_survivalpoints
}
iter = 2
popSize = 5
set.seed(1)
GAmodel <- rbga.bin(size = 7, popSize = popSize, iters = iter, mutationChance = 0.1,elitism = T, evalFunc = evalFunc)
Looking at the function code, it seems like at each iteration (generation) a subset of chromosomes is chosen from the population (population = 5 chromosomes in your example) with a certain probability (0.1 in your case) and mutated. Evaluation function is called only for the mutated chromosomes at each generation (and of course for all the chromosomes in the first iteration to know their initial value).
Note that, this subset do not include elitists group, which in your example you have defined as 1 element big (you have erroneously passed elitism=TRUE and TRUE is implicitly converted to 1).
Anyway, to know the population at each generation, you can pass a monitor function through the monitorFun parameter e.g. :
# obj contains a lot of informations, try to print it
monitor <- function(obj) {
print(paste(" GENERATION :", obj$iter))
print("POPULATION:")
print(obj$population)
print("VALUES:")
print(obj$evaluations)
}
iter = 2
popSize = 5
set.seed(1)
GAmodel <- rbga.bin(size = 7, popSize = popSize,
iters = iter, mutationChance = 0.1,
elitism = 1, evalFunc = evalFunc, monitorFunc = monitor)
I want to skip an error (if there is any) in a loop and continue the next iteration. I want to compute 100 inverse matrices of a 2 by 2 matrix with elements randomly sampled from {0, 1, 2}. It is possible to have a singular matrix (for example,
1 0
2 0
Here is my code
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
repeat {
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
At the third iteration, the matrix is singular and the code stops running with an error message. In practice, I would like to bypass this error and continue to the next loop. I know I need to use a try or tryCatch function but I don't know how to use them. Similar questions have been asked here, but they are all really complicated and the answers are far beyond my understanding. If someone can give me a complete code specifically for this question, I really appreciate it.
This would put NULLs into inverses for the singular matrices:
inverses[[count]] <- tryCatch(solve(x), error=function(e) NULL)
If the first expression in a call to tryCatch raises an error, it executes and returns the value of the function supplied to its error argument. The function supplied to the error arg has to take the error itself as an argument (here I call it e), but you don't have to do anything with it.
You could then drop the NULL entries with inverses[! is.null(inverses)].
Alternatively, you could use the lower level try. The choice is really a matter of taste.
count <- 0
repeat {
if (count == 100) break
count <- count + 1
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
x.inv <- try(solve(x), silent=TRUE)
if ('try-error' %in% class(x.inv)) next
else inverses[[count]] <- x.inv
}
If your expression generates an error, try returns an object with class try-error. It will print the message to screen if silent=FALSE. In this case, if x.inv has class try-error, we call next to stop the execution of the current iteration and move to the next one, otherwise we add x.inv to inverses.
Edit:
You could avoid using the repeat loop with replicate and lapply.
matrices <- replicate(100, matrix(sample(0:2, 4, replace=T), 2, 2), simplify=FALSE)
inverses <- lapply(matrices, function(mat) if (det(mat) != 0) solve(mat))
It's interesting to note that the second argument to replicate is treated as an expression, meaning it gets executed afresh for each replicate. This means you can use replicate to make a list of any number of random objects that are generated from the same expression.
Instead of using tryCatch you could simply calculate the determinant of the matrix with the function det. A matrix is singular if and only if the determinant is zero.
Hence, you could test whether the determinant is different from zero and calculate the inverse only if the test is positive:
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
repeat {
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
# if (det(x)) inverses[[count]] <- solve(x)
# a more robust replacement for the above line (see comment):
if (is.finite(determinant(x)$modulus)) inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
Update:
It is, however, possible to avoid generating singular matrices. The determinant of a 2-by-2 matrix mat is definded as mat[1] * mat[4] - mat[3] * mat[2]. You could use this knowledge for sampling random numbers. Just do not sample numbers which will produce a singular matrix. This, of course, depends on the numbers sampled before.
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
set <- 0:2 # the set of numbers to sample from
repeat {
# sample the first value
x <- sample(set, 1)
# if the first value is zero, the second and third one are not allowed to be zero.
new_set <- ifelse(x == 0, setdiff(set, 0), set)
# sample the second and third value
x <- c(x, sample(new_set, 2, replace = T))
# calculate which 4th number would result in a singular matrix
not_allowed <- abs(-x[3] * x[2] / x[1])
# remove this number from the set
new_set <- setdiff(0:2, not_allowed)
# sample the fourth value and build the matrix
x <- matrix(c(x, sample(new_set, 1)), 2, 2)
inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
This procedure is a guarantee that all generated matrices will have an inverse.
try is just a way of telling R: "If you commit an error inside the following parentheses, then skip it and move on."
So if you're worried that x <- matrix(sample(0:2, 4, replace = T), 2, 2) might give you an error, then all you have to do is:
try(x <- matrix(sample(0:2, 4, replace = T), 2, 2))
However, keep in mind then that x will be undefined if you do this and it ends up not being able to compute the answer. That could cause a problem when you get to solve(x) - so you can either define x before try or just "try" the whole thing:
try(
{
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
inverses[[count]] <- solve(x)
}
)
The documentation for try explains your problem pretty well. I suggest you go through it completely.
Edit: The documentation example looked pretty straightforward and very similar to the op's question. Thanks for the suggestion though. Here goes the answer following the example in the documentation page:
# `idx` is used as a dummy variable here just to illustrate that
# all 100 entries are indeed calculated. You can remove it.
set.seed(1)
mat_inv <- function(idx) {
print(idx)
x <- matrix(sample(0:2, 4, replace = T), nrow = 2)
solve(x)
}
inverses <- lapply(1:100, function(idx) try(mat_inv(idx), TRUE))