I already have implemented Euler method in Mathematica.
Now I want to convert this method to Heun method (improved Euler).
I have this Euler implementation:
a = 2;(*my a parameter*)
b = .01; (*my b parameter*)
x = 0; (*starting x value*)
p = 1; (*starting p value*)
t = 1; (*step size t*)
f[p_] := a p - b p^2; (*my function*)
f[0] = 1;
eulertable = {}; (*build table (x,p).n steps in loop*)
For[n = 1,
n <= 21, n++,
AppendTo[eulertable, {x, p}];
p = p + t f[p];
x = x + t;]
Now I want to implement this with the Heun method. I already have this implementation of the Heun method.
heun[f_, {x_, x0_, xn_}, {y_, y0_}, steps_] :=
Block[{ xold = x0, yold = y0, sollist = {{x0, y0}}, x, y, h },
h = N[(xn - x0) / steps];
Do[ xnew = xold + h;
k1 = h * (f /. {x -> xold, y -> yold});
k2 = h * (f /. {x -> xold + h, y -> yold + k1});
ynew = yold + .5 * (k1 + k2);
sollist = Append[sollist, {xnew, ynew}];
xold = xnew;
yold = ynew,
{steps}
];
Return[sollist]
]
But I need to convert this method to have the input like it is in my Euler method. So I have to convert the Heun method that I have the parameter a, b, x, t, p, f[].
As I am new with Mathematica I am having problems to convert the method.
Why do you put f[0]=1?
Replace
p = p + t f[p];
x = x + t;
with
p1 = p + t f[p];
p2 = p + t f[p1];
p = (p1+p2)/2;
x = x + t;
Your step size is rather large for the values of your parameters.
Related
I am running this code but it shows a method error. Can someone please help me?
Code:
function lsmc_am_put(S, K, r, σ, t, N, P)
Δt = t / N
R = exp(r * Δt)
T = typeof(S * exp(-σ^2 * Δt / 2 + σ * √Δt * 0.1) / R)
X = Array{T}(N+1, P)
for p = 1:P
X[1, p] = x = S
for n = 1:N
x *= R * exp(-σ^2 * Δt / 2 + σ * √Δt * randn())
X[n+1, p] = x
end
end
V = [max(K - x, 0) / R for x in X[N+1, :]]
for n = N-1:-1:1
I = V .!= 0
A = [x^d for d = 0:3, x in X[n+1, :]]
β = A[:, I]' \ V[I]
cV = A' * β
for p = 1:P
ev = max(K - X[n+1, p], 0)
if I[p] && cV[p] < ev
V[p] = ev / R
else
V[p] /= R
end
end
end
return max(mean(V), K - S)
end
lsmc_am_put(100, 90, 0.05, 0.3, 180/365, 1000, 10000)
error:
MethodError: no method matching (Array{Float64})(::Int64, ::Int64)
Closest candidates are:
(Array{T})(::LinearAlgebra.UniformScaling, ::Integer, ::Integer) where T at /Volumes/Julia-1.8.3/Julia-1.8.app/Contents/Resources/julia/share/julia/stdlib/v1.8/LinearAlgebra/src/uniformscaling.jl:508
(Array{T})(::Nothing, ::Any...) where T at baseext.jl:45
(Array{T})(::UndefInitializer, ::Int64) where T at boot.jl:473
...
Stacktrace:
[1] lsmc_am_put(S::Int64, K::Int64, r::Float64, σ::Float64, t::Float64, N::Int64, P::Int64)
# Main ./REPL[39]:5
[2] top-level scope
# REPL[40]:1
I tried this code and I was expecting a numeric answer but this error came up. I tried to look it up on google but I found nothing that matches my situation.
The error occurs where you wrote X = Array{T}(N+1, P). Instead, use one of the following approaches if you need a Vector:
julia> Array{Float64, 1}([1,2,3])
3-element Vector{Float64}:
1.0
2.0
3.0
julia> Vector{Float64}([1, 2, 3])
3-element Vector{Float64}:
1.0
2.0
3.0
And in your case, you should write X = Array{T,1}([N+1, P]) or X = Vector{T}([N+1, P]). But since there's such a X[1, p] = x = S expression in your code, I guess you mean to initialize a 2D array and update its elements through the algorithm. For this, you can define X like the following:
X = zeros(Float64, N+1, P)
# Or
X = Array{Float64, 2}(undef, N+1, P)
So, I tried the following in your code:
# I just changed the definition of `X` in your code like the following
X = Array{T, 2}(undef, N+1, P)
#And the result of the code was:
julia> lsmc_am_put(100, 90, 0.05, 0.3, 180/365, 1000, 10000)
3.329213731484463
I've got this code:
const a = 2; // always > 0 and known in advance
const b = 3; // always > 0 and known in advance
const c = 4; // always > 0 and known in advance
for (let x = 0; x <= a; x++) {
for (let y = 0; y <= b; y++) {
for (let z = 0; z <= c; z++) {
for (let p = 0; p <= 1; p++) {
for (let q = 0; q <= 2; q++) {
let u = b + x - y + p;
let v = a + b + 2 * c - x - y - 2 * z + q;
let w = c + x + y - z;
}
}
}
}
}
The code generates (a+1)*(b+1)*(c+1)*2*3 triplets of (u,v,w), each of them is unique. And because of that fact, I think it should be possible to write reversed version of this algorithm that will calculate x,y,z,p,q based on u,v,w. I understand that there are only 3 equations and 5 variables to get, but known boundaries for x,y,z,p,q and the fact that all variables are integers should probably help.
for (let u = ?; u <= ?; u++) {
for (let v = ?; v <= ?; v++) {
for (let w = ?; w <= ?; w++) {
x = ?;
y = ?;
z = ?;
p = ?;
q = ?;
}
}
}
I even managed to produce the first line: for (let u = 0; u <= a + b + 1; u++) by taking the equation for u and finding min and max but I'm struggling with moving forward. I understand that min and max values for v are depending on u, but can't figure out the formulas.
Examples are in JS, but I will be thankful for any help in any programming language or even plain math formulas.
If anyone is interested in what this code is actually about - it projects voxel 3d model to triangles on a plain. u,v are resulting 2d coordinates and w is distance from the camera. Reversed algorithm will be actually a kind of raytracing.
UPDATE: Using line equations from 2 points I managed to create minmax conditions for v and code now looks like this:
for (let u = 0; u <= a + b + 1; u++) {
let minv = u <= a ? a - u : -a + u - 1;
let maxv = u <= b ? a + 2 * c + u + 2 : a + 2 * b + 2 * c - u + 3;
for (let v = minv; v <= maxv; v++) {
...
}
}
I think I know what to do with x, y, z, p, q on the last step so the problem left is minw and maxw. As far as I understand those values should depend both on u and v and I must use plane equations?
If the triplets are really unique (didn't check that) and if p and q always go up to 1 and 2 (respectively), then you can "group" triplets together and go up the loop chain.
We'll first find the 3 triplets that where made in the same "q loop" : the triplets make with the same x,y,z,p. As only q change, the only difference will be v, and it will be 3 consecutive numbers.
For that, let's group triplets such that, in a group, all triplets have the same u and same w. Then we sort triplets in groups by their v parameters, and we group them 3 by 3. Inside each group it's easy to assign the correct q variable to each triplet.
Then reduce the groups of 3 into the first triplet (the one with q == 0). We start over to assign the p variable : Group all triplets such that they have same v and w inside a group. Then sort them by the u value, and group them 2 by 2. This let's us find their p value. Remember that each triplet in the group of 3 (before reducing) has that same p value.
Then, for each triplet, we have found p and q. We solve the 3 equation for x,y,z :
z = -1 * ((v + w) - a - b - 3c -q)/3
y = (w - u + z + b - c - p)/2
x = u + y - b - p
After spending some time with articles on geometry and with the huge help from Wolfram Alpha, I managed to write needed equations myself. And yes, I had to use plane equations.
const a = 2; // always > 0 and known in advance
const b = 3; // always > 0 and known in advance
const c = 4; // always > 0 and known in advance
const minu = 0;
const maxu = a + b + 1;
let minv, maxv, minw, maxw;
let x, y, z, p, q;
for (let u = minu; u <= maxu; u++) {
if (u <= a) {
minv = a - u;
} else {
minv = -a + u - 1;
}
if (u <= b) {
maxv = a + 2 * c + u + 2;
} else {
maxv = a + 2 * b + 2 * c - u + 3;
}
for (let v = minv; v <= maxv; v++) {
if (u <= b && v >= a + u + 1) {
minw = (-a + 2 * b - 3 * u + v - 2) / 2;
} else if (u > b && v >= a + 2 * b - u + 2) {
minw = (-a - 4 * b + 3 * u + v - 5) / 2;
} else {
minw = a + b - v;
}
if (u <= a && v <= a + 2 * c - u + 1) {
maxw = (-a + 2 * b + 3 * u + v - 1) / 2;
} else if (u > a && v <= -a + 2 * c + u) {
maxw = (5 * a + 2 * b - 3 * u + v + 2) / 2;
} else {
maxw = a + b + 3 * c - v + 2;
}
minw = Math.round(minw);
maxw = Math.round(maxw);
for (let w = minw; w <= maxw; w++) {
z = (a + b + 3 * c - v - w + 2) / 3;
q = Math.round(2 - (z % 1) * 3);
z = Math.floor(z);
y = (a + 4 * b + q - 3 * u - v + 2 * w + 3) / 6;
p = 1 - (y % 1) * 2;
y = Math.floor(y);
x = (a - 2 * b - 3 * p + q + 3 * u - v + 2 * w) / 6;
x = Math.round(x);
}
}
}
This code passes my tests, but if someone can create better solution, I would be very interested.
I'm not much familiar with this programming language and I just need to run one function to compute some coeficients.
f[x] = x^2 - 2 x + 2
g[x] = x^3 - 2 x^2 - 2 x - 2
f1 = Root[f[x], 1];
f2 = Root[f[x], 2];
g1 = Root[g[x], 1];
g2 = Root[g[x], 2];
g3 = Root[g[x], 3];
foo[rootList, alpha, beta] :=
(
res = {};
For[i = 1, i <= Length[rootList], i++, alphaI = rootList[[i]];
For[j = 1, j <= Length[rootList], j++, betaJ = rootList[[j]];
If[betaJ != beta,
(
kor = Simplify [(alphaI - alpha) / (beta - betaJ)];
res = Append[res, N[kor, 5]];
),
]
]
]
Return[res];
)
roots = [f1, f2, g1, g2, g3];
cs = foo[roots, f1, g1]
this piece of code gives me this error:
Syntax::tsntxi: "For[i=1,i<=Length[rootList],i++,alphaI=rootList[[i]];" is incomplete; more input is needed.
And don't see what is wrong. I'm using mathematica 10.4
Fixing the syntax errors.
f[x_] := x^2 - 2 x + 2
g[x_] := x^3 - 2 x^2 - 2 x - 2
f1 = Root[f[x], 1];
f2 = Root[f[x], 2];
g1 = Root[g[x], 1];
g2 = Root[g[x], 2];
g3 = Root[g[x], 3];
foo[rootList_, alpha_, beta_] :=
(
res = {};
For[i = 1, i <= Length[rootList], i++, alphaI = rootList[[i]];
For[j = 1, j <= Length[rootList], j++, betaJ = rootList[[j]];
If[betaJ != beta,
(
kor = Simplify[(alphaI - alpha)/(beta - betaJ)];
res = Append[res, N[kor, 5]];
)
]
]
];
res
)
roots = {f1, f2, g1, g2, g3};
cs = foo[roots, f1, g1]
I am solving a project in Mathematica 10 and I think that the best way to do it is using a loop like For or Do. After build it I obtain the results I looking for but with a to much big multiplicity. Here is the isolated part of the code:
(*Initializing variables*)
epot[0] = 1; p[0] = 1; \[Psi][0] = HermiteH[0, x] E^(-(x^2/2));
e[n_] := e[n] = epot[n];
(*Defining function*)
\[Psi][n_] := \[Psi][n] = (Sum[p[k]*x^k,{k,0,4*n}]) [Psi][0];
(*Differential equation*)
S = - D[D[\[Psi][n], x], x] + x^2 \[Psi][n] + x^4 \[Psi][n - 1] - Sum[e[n-k]*\[Psi][k],{k,0,n}];
(*Construction of the loop*)
S1 = Collect[E^(x^2/2) S, x, Simplify];
c = Coefficient[S1, x, 0];
sol = Solve[c == 0, epot[n]]; e[n] = epot[n] /. sol;
For[j = 1, j <= 4 n, j++,
c = Coefficient[S1, x, j];
sol = Solve[c == 0, p[j]];
p[j] = p[j] /. sol;];
(*Results*)
Print[Subscript[e, n], "= ", e[n] // InputForm];
Subscript[e, 1]= {{{3/4}}}
Print[ArrayDepth[e[n]]];
3 (*Multiplicity, it should be 1*)
Print[Subscript[\[Psi], n], "= ", \[Psi][n]];
Subscript[\[Psi], 1]= {{E^(-(x^2/2)) (1-(3 x^2)/8-x^4/8)}}
Print[ArrayDepth[\[Psi][n]]];
2 (*Multiplicity, it should be 1*)
After this calculation, the question remaining is how do i substitute this results in the original functions. Thank you very much.
When I was trying to find the maximum value of f using NMaximize, mathematica gave me a error saying
NMaximize::cvdiv: Failed to converge to a solution. The function may be unbounded.
However, if I scale f with a large number, say, 10^5, 10^10, even 10^100, NMaximize works well.
In the two images below, the blue one is f, and the red one is f/10^10.
Here come my questions:
Is scaling a general optimization trick?
Any other robust, general workarounds for the optimizations such
needle-shape functions?
Because the scaling barely changed the shape of the needle-shape of
f, as shown in the two images, how can scaling work here?
thanks :)
Update1: with f included
Clear["Global`*"]
d = 1/100;
mu0 = 4 Pi 10^-7;
kN = 97/100;
r = 0.0005;
Rr = 0.02;
eta = 1.3;
e = 3*10^8;
s0 = 3/100;
smax = 1/100; ks = smax/s0;
fre = 1; tend = 1; T = 1;
s = s0*ks*Sin[2*Pi*fre*t];
u = D[s, t];
umax = N#First[Maximize[u, t]];
(*i=1;xh=0.1;xRp=4.5`;xLc=8.071428571428573`;
i=1;xh=0.1;xRp=4.5;xLc=8.714285714285715;*)
i = 1; xh = 0.1; xRp = 5.5; xLc = 3.571428571428571`;
(*i=1;xh=0.1`;xRp=5.`;xLc=6.785714285714287`;*)
h = xh/100; Rp = xRp/100; Lc = xLc/100;
Afai = Pi ((Rp + h + d)^2 - (Rp + h)^2);
(*Pi (Rp-Hc)^2== Afai*)
Hc = Rp - Sqrt[Afai/Pi];
(*2Pi(Rp+h/2) L/2==Afai*)
L = (2 Afai)/(\[Pi] (h + 2 Rp));
B = (n mu0 i)/(2 h);
(*tx = -3632B+2065934/10 B^2-1784442/10 B^3+50233/10 B^4+230234/10 \
B^5;*)
tx = 54830.3266978739 (1 - E^(-3.14250266080741 B^2.03187556833859));
n = Floor[(kN Lc Hc)/(Pi r^2)] ;
A = Pi*(Rp^2 - Rr^2);
b = 2*Pi*(Rp + h/2);
(* -------------------------------------------------------- *)
Dp0 = 2*tx/h*L;
Q0 = 0;
Q1 = ((1 - 3 (L tx)/(Dp h) + 4 (L^3 tx^3)/(Dp^3 h^3)) Dp h^3)/(
12 eta L) b;
Q = Piecewise[{{Q1, Dp > Dp0}, {Q0, True}}];
Dp = Abs[dp[t]];
ode = u A - A/e ((s0^2 - s^2)/(2 s0 )) dp'[t] == Q*Sign[dp[t]];
sol = First[
NDSolve[{ode, dp[0] == 0}, dp, {t, 0, tend} ,
MaxSteps -> 10^4(*Infinity*), MaxStepFraction -> 1/30]];
Plot[dp''[t] A /. sol, {t, T/4, 3 T/4}, AspectRatio -> 1,
PlotRange -> All]
Plot[dp''[t] A /10^10 /. sol, {t, T/4, 3 T/4}, AspectRatio -> 1,
PlotRange -> All, PlotStyle -> Red]
f = dp''[t] A /. sol;
NMaximize[{f, T/4 <= t <= 3 T/4}, t]
NMaximize[{f/10^5, T/4 <= t <= 3 T/4}, t]
NMaximize[{f/10^5, T/4 <= t <= 3 T/4}, t]
NMaximize[{f/10^10, T/4 <= t <= 3 T/4}, t]
update2: Here comes my real purpose. Actually, I am trying to make the following 3D region plot. But I found it is very time consuming (more than 3 hours), any ideas to speed up this region plot?
Clear["Global`*"]
d = 1/100;
mu0 = 4 Pi 10^-7;
kN = 97/100;
r = 0.0005;
Rr = 0.02;
eta = 1.3;
e = 3*10^8;
s0 = 3/100;
smax = 1/100; ks = smax/s0;
f = 1; tend = 1/f; T = 1/f;
s = s0*ks*Sin[2*Pi*f*t];
u = D[s, t];
umax = N#First[Maximize[u, t]];
du[i_?NumericQ, xh_?NumericQ, xRp_?NumericQ, xLc_?NumericQ] :=
Module[{Afai, Hc, L, B, tx, n, A, b, Dp0, Q0, Q1, Q, Dp, ode, sol,
sF, uF, width, h, Rp, Lc},
h = xh/100; Rp = xRp/100; Lc = xLc/100;
Afai = Pi ((Rp + h + d)^2 - (Rp + h)^2);
Hc = Rp - Sqrt[Afai/Pi];
L = (2 Afai)/(\[Pi] (h + 2 Rp));
B = (n mu0 i)/(2 h);
tx = 54830.3266978739 (1 - E^(-3.14250266080741 B^2.03187556833859));
n = Floor[(kN Lc Hc)/(Pi r^2)] ;
A = Pi*(Rp^2 - Rr^2);
b = 2*Pi*(Rp + h/2);
Dp0 = 2*tx/h*L;
Q0 = 0;
Q1 = ((1 - 3 (L tx)/(Dp h) + 4 (L^3 tx^3)/(Dp^3 h^3)) Dp h^3)/(
12 eta L) b;
Q = Piecewise[{{Q1, Dp > Dp0}, {Q0, True}}];
Dp = Abs[dp[t]];
ode = u A - A/e ((s0^2 - s^2)/(2 s0 )) dp'[t] == Q*Sign[dp[t]];
sol = First[
NDSolve[{ode, dp[0] == 0}, dp, {t, 0, tend} , MaxSteps -> 10^4,
MaxStepFraction -> 1/30]];
sF = ParametricPlot[{s, dp[t] A /. sol}, {t, 0, tend},
AspectRatio -> 1];
uF = ParametricPlot[{u, dp[t] A /. sol}, {t, 0, tend},
AspectRatio -> 1];
tdu = NMaximize[{dp''[t] A /10^8 /. sol, T/4 <= t <= 3 T/4}, {t,
T/4, 3 T/4}, AccuracyGoal -> 6, PrecisionGoal -> 6];
width = Abs[u /. tdu[[2]]];
{uF, width, B}]
RegionPlot3D[
du[1, h, Rp, Lc][[2]] <= umax/6, {h, 0.1, 0.2}, {Rp, 3, 10}, {Lc, 1,
10}, LabelStyle -> Directive[18]]
NMaximize::cvdiv is issued if the optimum improved a couple of orders of magnitude during the optimization process, and the final result is "large" in an absolute sense. (To prevent the message in a case where we go from 10^-6 to 1, for example.)
So yes, scaling the objective function can have an effect on this.
Strictly speaking this message is a warning, and not an error. My experience is that if you see it, there's a good chance that your problem is unbounded for some reason. In any case, this warning is a hint that you might want to double check your system to see if that might be the case.