I am trying to get the roots of the function with the modified newton raphson method, but on the second iteration the value for xi+1 blows up to -393, isnt't it supposed to get closer to the expected value of the root? (which is 0.34997). Also I am trying to get the root with an "error" below the "eS" criteria. Pls help
n = 50;
eS = 10^-4;
f[x_] := (x^2 - 10 x + 25) (x - Exp[-3 x])
Plot[f[x], {x, -1, 2}]
xi = 0.5;
Do[
f[xi]; f'[xi]; f''[xi];
xi1 = xi - (f[xi]*f'[xi]/(f'[xi])^2 - f[xi]*f''[xi]);
If[Abs[f[xi]] < 10^-7,
Print["The root is approx= ", xi1 // N, " iterations needed: ", i];
Break[]];
eA = Abs[(xi1 - xi)/xi1];
If[eA < eS,
Print["The root is approx= ", xi1 // N, " iterations needed: ", i];
Break[]];
xi = xi1;
If[i == n, Print["Did not converge in ", n, " iteration(s)"]];
, {i, 1, n}
]
There are many different "Modified Newton Raphson" methods. The one I am familiar with is
u[x_] := f[x]/f'[x]
Do[
xi1 = xi - u[xi]/u'[xi];
If[Abs[f[xi]] < 10^-7,
Print["The root is approx= ", xi1 // N, " iterations needed: ", i];
Break[]];
eA = Abs[(xi1 - xi)/xi1];
If[eA < eS,
Print["The root is approx= ", xi1 // N, " iterations needed: ", i];
Break[]];
xi = xi1;
If[i == n, Print["Did not converge in ", n, " iteration(s)"]];, {i, 1, n}]
Here is a more functional way (no Do loop)
FixedPointList[# - u[#]/u'[#] &, .5]
(* {0.5, 0.372215, 0.350544, 0.34997, 0.34997, 0.34997, 0.34997} *)
Related
for work I have to solve the Optical Bloch Equations for a 2-Level System and I appear to be really stuck on my code in Mathematica:
O=1;
g=1;
d=0;
sol3=NDSolve
[
{
x'[t]==g y[t] + I/2 (O* b[t] - O a[t]),
y'[t]==-g y[t]+ I/2 (O a[t]-O* b[t]),
a'[t]==-(g/2+I d) a[t] + I/2 =O* (y[t]-x[t]),
b'[t]==-(g/2-I d) b[t] + I/2 O* (x[t]-y[t]),
x[0]==1,
y[0]==0,
b[0]==0,
a[0]==0
},
{x,y},{t,0,100}
]
The Error I get is: Syntax::tsntxi: "whole DE-System" is incomplete; more input is needed.
I would be very grateful if you could point out my error(s)
Thank you all :)
w = 1;
g = 1;
d = 0;
swl3 = NDSolve[{
x'[t] == g y[t] + I/2 (w*b[t] - w a[t]),
y'[t] == -g y[t] + I/2 (w a[t] - w*b[t]),
a'[t] == -(g/2 + I d) a[t] + I/2 w*(y[t] - x[t]),
b'[t] == -(g/2 - I d) b[t] + I/2 w*(x[t] - y[t]),
x[0] == 1, y[0] == 0, b[0] == 0, a[0] == 0},
{x, y, a, b},
{t, 0, 100}]
Plot[Evaluate[{x[t], y[t], a[t], b[t]} /. swl3], {t, 0, 100}]
a[t] and b[t] are complex so they don't appear in the plot. You can plot the real and imaginary part separately.
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 want to sum the matrices which is computed before.
For r=1, n=3; Subscript[P, i] are 3x3 matrices like P1,P2,P3.
My codes are like this :
'Y = Inverse[S];
Print["Y=", MatrixForm[Y]];
For[i = 1, i <= n, i++,
Subscript[P, i] = MatrixForm[Outer[Times, S[[All, i]], Y[[i]]]];
Print["CarpimS=", MatrixForm[S[[All, i]]]];
Print["CarpimY=", MatrixForm[Y[[i]]]];
Print["P=", MatrixForm[Outer[Times, S[[All, i]], Y[[i]]]]];
];
toplamP = MatrixForm[ConstantArray[0, {n, n}]];
For[i = 2. r + 1, i <= n, i++,
toplamP = toplamP + Subscript[P, i];
];
Print["ToplamP=", toplamP];'
But mathematica gives me only P3 and and P3 doesn't have a matrix form.
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.
Clear[x, y, h, k, FirstSlope, SecondSlope];
h = [Pi]; y[[Pi]] = 0;
dy[x_, y_] = (Cos[x] - 3 x^2 y)/x^3;
Do[{x[k] = [Pi] + h*(k - [Pi]),
FirstSlope = dy[x[k], y[k]],
SecondSlope = dy[x[k] + h, y[k] + h*FirstSlope],
y[k + [Pi]] = y[k] + (h*(FirstSlope + SecondSlope))/2}, {k, [Pi],
5[Pi]}] Table[{x[k], y[k]}, {k, [Pi], 5[Pi]}];
MatrixForm[%]
Above image is my error. I'm trying to use Heun's method and my problem is:
1) I want it to stop at y[5 Pi] but it keeps going. I can manipulate it so that it goes to y[5 Pi], but I want to know why exactly it's doing this.
2) y[k] is not evaluating at k=pi,2pi,3pi, etc.