Good day to you all :)
I'm need some help with the boundary value problem.
This is my equation:
sin(1)*y'' + (1+cos(1)*x^2)*y = -1
-1 < x < 1
y(-1) = y(1) = 0
And I'd like to solve this equation by built-in method.
So, I asked the same question on Maple forum (https://www.mapleprimes.com/questions/225225-Dsolve-Does-Not-Work-solving-A-Boundary-Value-Problem) and there is no build-in method.
Maple have No built-in collocation methods, least squares method, Galerkin method to solve ode's.
dsolve it have method series,but in your case dosen't work.
After that, I decided to try to solve this equation with R.
library('bvpSolve')
fun <- function(x,y,pars) {
d1 = sin(1)*y[2]
d2 = -1 - (1 + cos(1))*y[1]
return(list(c(d1, d2)))
}
init = c(y = 0, dy = NA)
end = c(y = 0, dy = NA)
sol = bvpcol(yini = init, x = seq(-1, 1, 0.01),
func = fun, yend = end, parms = NULL)
x = sol[, 1]
y = sol[, 2]
plot(x, y, type = "l")
It builds graphs (probably correct) (at least they match the graphs in Maple)), but I still can't get the numerical solution.
I'd like to get the same result (http://fredrik-j.blogspot.com/2009/02/galerkins-method-in-sympy.html), but in R.
I'd be very grateful if you could suggest some built-in numerical R methods that would help solve this equation.
I don't realy think it's a good idea to explicitly interpolate the function result (as suggested by the Maple community).Is there a simple and effective way to do this?
Related
I am trying to exercise a simulation of Sierpinski triangle in R with affine transformation and Iterated Function System (IFS). And hopefully, I can further exercise how the simulation of Barnsley's fern can also be done. For those who know Chinese, this video is my starting point of this exercise.
Here is a short introduction of the simulation process:
Create an equilateral triangle, name the vertices A, B, C
Create a random initial point lying inside the triangle ABC
Sample A, B, C with equal chances
If the outcome is A, then move the initial point to the midpoint of A and itself
Repeat step 3, and move the last point to the midpoint of the outcome point and itself.
By doing this repeatedly, we should see the path of the points looks like a Sierpinski triangle.
I wonder how the assignment of variable works inside a self-defined function. I would like to create an object (a matrix or a dataframe) to store the path of simulated points and keep updating the object to keep track of how the points move.
the following is my current codes:
# create the triangle
triangle <- matrix(c(A = c(-1,0),
B = c(1, 0),
C = c(0, sqrt(3))),
byrow = TRUE, nrow = 3, ncol = 2)
colnames(triangle) <- c("X", "Y") # axis name
rownames(triangle) <- c("A", "B", "C")
# sample an initial point inside the triangle ABC
sampleInit <- function(){
X <- runif(1, min = -1, max = 1)
Y <- runif(1, min = 0, max = sqrt(3))
if( (Y >= 0) && (Y <= (sqrt(3)*X + sqrt(3))) && (Y <= -sqrt(3)*X+sqrt(3)) ){
return(cbind(X, Y))
} else {
sampleInit()
}
}
### graph: plot the triangle and the initial point together
graphics.off()
plot(triangle, xlim = c(-1, 1), ylim = c(0, sqrt(3)))
par(new = TRUE)
plot(sampleInit(), xlim = c(-1, 1), ylim = c(0, sqrt(3)), col = "red")
### a three-sided dice: determine the direction to move along
diceRoll <- function(){
return(sample(c("A", "B", "C"), size = 1, prob = c(1/3, 1/3, 1/3)))
}
## path
stepTrace <- as.data.frame(sampleInit())
move <- function(diceOutCome, stepTrace){
lastStep <- tail(stepTrace, 1)
if(diceOutCome == "A"){
X <- (-1 + lastStep[,1])/2
Y <- (0 + lastStep[,2])/2
} else if(diceOutCome == "B"){
X <- (1 + lastStep[,1])/2
Y <- (0 + lastStep[,2])/2
} else if(diceOutCome == "C"){
X <- (0 + lastStep[,1])/2
Y <- (sqrt(3) + lastStep[,2])/2
}
lastStep <- cbind(X, Y)
stepTrace <- rbind(stepTrace, lastStep)
}
move(diceRoll(), stepTrace)
View(stepTrace)
Sorry for the long story and not jumping to the key question directly. My question is that stepTrace (the object I would like to store the path) didn't get updated as I execute the last two lines.
What I imagined was the assignment process in move() updates the dataframe stepTrace, however it turns out it doesn't. I check my code in the debugger, and found out that stepTrace did get updated inside the function call, but it didn't pass the new assigned value outside the function call. That's why I would like to ask how does the assignment process works in R. What is the difference between the this kind of process and other general purpose languages such as Java? (What I imagined to do this exercise in Java would not encounter this kind of assignment issue. Correct me if I am wrong since I am still new to Java)
Similar problems bother me when I tried to assign variables inside a loop. I know there is a base function assign that helps to resolve is issue, but I just don't know what is the mechanism behind it.
I tried to google my question, but I am not sure which keyword I should use, and I didn't find direct answers to my question. Any comment, keyword or external resource to the documentation is appreciated!
In short, your move function does what you want, but it is not advisable to write it like that. In its current form, stepTrace is updated in the function's local environment, but not in the global environment, where your stepTrace lives. They are not the same stepTrace. To fix it, you can run stepTrace <- move(diceRoll(), stepTrace), but beware of the second circle. For a cleaner approach, remove the last stepTrace assignment from move.
From ?return: If the end of a function is reached without calling return, the value of the last evaluated expression is returned.
Consider the following examples:
x <- 5
a <- b <- c <- d <- 1
f1 <- function(x) x + 1
f2 <- function(x) return(x + 1)
f3 <- function(x) x <- x + 1
f4 <- function(x) x <<- x + 1
f1(1)
f2(1)
f3(1) # your problem
f4(1) # x gets replaced with x in f4, 2 in global environment.
a <- b <- c <- d <- 1
a <- f1(1)
b <- f2(1)
c <- f3(1)
d <- f4(1)
f3 and f4 are generally considered bad practice because of side effects, i.e. they (can) modify a non-local variable, f2 might trigger a discussion. For f3, see the result of
c(f3(1))
#> [1] 2
Given our experiment of calling f3(1) by itself, we'd expect a vector of length 0 (?). Consider removing any assignment as the last operation within your functions, and avoid naming your function arguments the same as the objects you intend to change.
#DonaldSeinen explained how to fix your code in his answer. I'll try to point you to documentation for more details.
First, you don't need to go to external documentation. An Introduction to R and The R Language Definition manuals are included in R distributions. The Introduction describes what's going on in lots of detail in section 10.7, "Scope". There's a different description in the Language Definition in section 3.5, "Scope of Variables".
Some people find the language in those manuals to be too technical. An easier to read external reference that gets it right is Wickham's Advanced R, readable online at https://adv-r.hadley.nz/. Scoping is discussed in chapters 6 and 7, especially sections 6.4 and 7.2.
Please see below my code for trying to run a loop of 10000 iterations, every time the code loops I want it to select a new value for my two random variables labelled: premium_A_1 and cost_of_claim.
for (i in 1:10000){
profit_A_scheme1 = c()
premium_A_scheme1=sample(c(200,170,140), size = 1, replace = TRUE, prob = s.d_scheme1)
costclaim_A= runif(1, 0, 400)
profit_A_scheme1[i] = premium_A_scheme1 - costclaim_A
}
The code returns profit_A_scheme_1 = (NA, NA, ..., x) when I was hoping for profit_A_scheme_1 = (x1, x2, ..., xn). Essentially only assigning a value to the final loop and NA for every loop previous. In case anyone tries to run this code the probabilities for the premium r.v. are prob = (0.4510610, 0.3207926, 1 - 0.4510620 - 0.3207926).
Thanks for any help you are able to offer as I've been stuck on this for a minute now.
Try (replace prob =abs(rnorm(3)/100) with your own) :
for (i in 1:10000){
profit_A_scheme1 = NULL
premium_A_scheme1=sample(c(200,170,140), size = 1, replace = TRUE, prob =abs(rnorm(3)/100))
costclaim_A= runif(1, 0, 400)
profit_A_scheme1 = premium_A_scheme1 - costclaim_A
print(profit_A_scheme1)
}
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.
The following code does what I need it to do, but since I am bound to have the same task in future codes, I would like to know what the best way to achieve the outcome is:
p_last = fill(NaN, (n,periods-1))
p_first = ones(n) * 0.5
p = hcat(p_first,p_last)
There are many ways like:
p = fill(NaN, n, periods)
p[:, 1] .= 0.5
or
p = [j == 1 ? 0.5 : NaN for i in 1:n, j in 1:periods]
or similarly:
p = [ifelse(j == 1, 0.5, NaN) for i in 1:n, j in 1:periods]
All of them have the advantage that they allocate only one matrix. The first one is a bit faster but requires two statements.
Suppose I have a vector of probabilities that sum to 1, such as foo = c(0.2,0.5,0.3).
I would like to sample an index from this vector by treating the values as probabilities.
In particular, I'd like to sample 1 with probability 0.2, 2 with probability 0.5, and 3 with probability 0.3.
Here is one implementation, similar to what I would write in C:
sample_index = function(probs) {
r = runif(1)
sum = 0
for (i in 1:length(probs)) {
sum <- sum + probs[i]
if (r < sum) return(i)
}
}
foo = c(0.2,0.5,0.3)
print(sample_index(foo));
Is there a more direct / built-in / canonical way to do this in R?
It always makes me smile and think R is doing a good job when people are looking for a function and repeatedly use its name in their question.
foo <- c(0.2, 0.5, 0.3)
sample(x = 1:3, size = 1, prob = foo)
Depending on your use case, you could make it a little more general:
sample(x = seq_along(foo), size = 1, prob = foo)
But do be careful, sample has sometimes convenient but very often unexpected behavior if its x argument is of length 1. If you're wrapping this up in a function, check the input length
if (length(foo) == 1) foo else sample(x = seq_along(foo), size = 1, prob = foo)