i want to translate my C++ code to wolfram, to improve my calcs.
C++ code
for(int i = 0; i < N - 1; ++i){
matrix[i][i] += L / 3 * uCoef - duCoef / 2 - (double)du2Coef/L;
matrix[i][i+1] += L / 6 * uCoef + duCoef / 2 + (double)du2Coef/L;
matrix[i+1][i] += L / 6 * uCoef - duCoef / 2 + (double)du2Coef/L;
matrix[i+1][i+1] += L / 3 * uCoef + duCoef / 2- (double)du2Coef/L;
}
all this coef are const, N - size of my matrix.
In[1]:= n = 4; uCoef = 2; duCoef = 3; du2Coef = 7; L = 11.;
matrix = Table[0, {n}, {n}];
For[i = 1, i < n, ++i,
matrix[[i, i]] += L/3*uCoef - duCoef/2 - du2Coef/L;
matrix[[i, i+1]] += L/6*uCoef - duCoef/2 - du2Coef/L;
matrix[[i+1, i]] += L/6*uCoef + duCoef/2 + du2Coef/L;
matrix[[i+1, i+1]] += L/3*uCoef - duCoef/2 + du2Coef/L];
matrix
Out[4]= {
{5.19697, 1.5303, 0, 0},
{5.80303, 11.6667, 1.5303, 0},
{0, 5.80303, 11.6667, 1.5303},
{0, 0, 5.80303, 6.4697}}
Each character that has been changed from your original is hinting there is a fundamental difference between C++ and Mathematica
You should use SparseArray for such banded arrays in mathematica:
n = 5; uCoef = 2; duCoef = 3; du2Coef = 7; L = 11.;
matrix = SparseArray[
{{1, 1} -> L/3*uCoef - duCoef/2 - du2Coef/L,
{i_ /; 1 < i < n, i_} -> -duCoef + 2 L uCoef/3 ,
{n, n} -> ( L/3 uCoef - duCoef/2 + du2Coef/L ),
Band[{1, 2}] -> L/6 uCoef - duCoef/2 - du2Coef/L,
Band[{2, 1}] -> L/6 uCoef + duCoef/2 + du2Coef/L}, {n, n}];
MatrixForm#matrix
Even if you insist on the For loop, initialize the matrix as :
matrix = SparseArray[{{_, _} -> 0}, {n, n}];
Related
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]
What does a function of two variables f(x,n) that gives the equation of a line with a y-intercept of n and an x-intercept of 16-n, look like?
Equation of a line
f[x_] := m x + c
so, for example, when x = 3
y = f[3]
c + 3 m
When x = 16 - n
f[16 - n]
c + m (16 - n)
This must equal n for the OP's solution
Solve[c + m (16 - n) == n, m]
{{m -> (c - n)/(-16 + n)}}
Replace m in another equation of the line
g[x_] := (c - n)/(-16 + n) x + c
For various values of c and n
c = 1;
Show[Table[Plot[g[x], {x, -100, 100}], {n, 2, 4}]]
c = 3;
Show[Table[Plot[g[x], {x, -100, 100}], {n, 2, 4}]]
Forcing a function of the form f(x,n)
h[x_, n_] := (c - n)/(-16 + n) x + c
c = 3;
n = 4;
Plot[h[x, n], {x, -100, 100}]
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.
I am beginner in Mathematica. I write code in mathematica for finding parametric fractal dimension. But it doesn't work. Can someone explain me where I am wrong.
My code is:
delta[0] = 0.001
lambda[0] = 0
div = 0.0009
a = 2
b = 2
terms = 100
fx[0] = NSum[1/n^b, {n, 1, terms}]
fy[0] = 0
For[i = 1, i < 11, i++,
delta[i] = delta[i - 1] + div;
j = 0
While[lambda[j] <= Pi,
j = j + 1;
lambda[j] = lambda[j - 1] + delta[i];
fx[j] = NSum[Cos[n^a*lambda[j]]/n^b, {n, 1, terms}];
fy[j] = NSum[Sin[n^a*lambda[j]]/n^b, {n, 1, terms}];
deltaL[j] = Sqrt[[fx[j] - fx[j - 1]]^2 + [fy[j] - fy[j - 1]]^2];
]
Ldelta[i] = Sum[deltaL[j], {j, 1, 10}];
]
data = Table[{Log[delta[i]], Log[Ldelta[i]]}, {i, 1, 10}]
line = Fit[data, {1, x}, x]
ListPlot[data]
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.