I am plotting fixed points of a system of differential equations in terms of a parameter. The code is
PX1Y1 = (1 - s1) (y1 + y2);
PX1Y2 = 0;
PX1X2 = 0;
PX2Y1 = 0;
PX2Y2 = s2 (y1 + y2);
PX2X1 = 0;
PY1X1 = s1 (x1 + x2);
PY1Y2 = 0;
PY1X2 = 0;
PY2X1 = 0;
PY2X2 = (1 - s2) (x1 + x2);
PY2Y1 = 0;
x1eq = -x1 (PX1Y1 + PX1Y2 + PX1X2) + x2 PX2X1 + y1 PY1X1 + y2 PY2X1;
x2eq = -x2 (PX2Y1 + PX2Y2 + PX2X1) + x1 PX1X2 + y1 PY1X2 + y2 PY2X2;
y1eq = -y1 (PY1X1 + PY1Y2 + PY1X2) + x1 PX1Y1 + x2 PX2Y1 + y2 PY2Y1;
y2eq = -y2 (PY2X1 + PY2X2 + PY2Y1) + x1 PX1Y2 + x2 PX2Y2 + y1 PY1Y2;
Xsimp[x1_, x2_, y1_, y2_] = Simplify[x1eq + x2eq]
Xeq = Simplify[
Xsimp[X/2 + \[Omega]/2,
X/2 - \[Omega]/2, (1 - X)/2 - (\[Omega] - \[Gamma])/2, (1 - X)/
2 + (\[Omega] - \[Gamma])/2]]
\[Omega]simp[x1_, x2_, y1_, y2_] = Simplify[x1eq - x2eq];
\[Omega]eq =
Simplify[\[Omega]simp[X/2 + \[Omega]/2,
X/2 - \[Omega]/2, (1 - X)/2 - (\[Omega] - \[Gamma])/2, (1 - X)/
2 + (\[Omega] - \[Gamma])/2]]
Manipulate[
Row[{
paramsplot = {s1 -> a, s2 -> b};
sol = NSolve[
{Xeq == 0, \[Omega]eq == 0} /. paramsplot,
{X, \[Omega]}, Reals
];
Plot[
X /. sol, {\[Gamma], -1, 1},
AxesLabel -> {"\[Gamma]", "X fixed points"},
ImageSize-> 300,
PlotRange -> {{-1, 1}, {0, 1}}
],
Plot[
\[Omega] /. sol, {\[Gamma], -1, 1},
AxesLabel -> {"\[Gamma]", "\[Omega] fixed points"},
ImageSize -> 300,
PlotRange -> {{-1, 1}, {-1, 1}}]
}],
{{a, 0.6,"s1 (0, 1)"}, 0, 1},
{{b, 0.4, "s2 (0, 1)"}, 0, 1}
]
And I get this
Is there any way of plotting each fixed point in a different colour? In the sense that what is green, so to say, in the X graph corresponds to what is green in the omega graph, and so on.
Thank you!
Related
I need to make a svg file for a project and I need some parameters that I haven't figured out how to calculate yet.
I have a point of coordinates x1,y1 and a circumference with a center of coordinates x2,y2 with radius r. The point x1,y1 is outside the circumference. How do I calculate the coordinates of the points belonging to the circumference (x3,y3 and x4,y4) from which the two tangent lines would pass? The outer point (x1,y1) will never touch the circumference and will never belong to the circumference.
This is the drawing to make the concept better understood, in red the values to be calculated.
Tangents scheme
Shift coordinate system to make origin in circle center (to get simpler equations). Now point is
x1' = x1 - x2
y1' = y1 - y2
Solve the next equation system (point belongs to circumference and radius is perpendicular to tangent)
x^2 + y^2 = r^2
(x - x1') * x + (y - y1') * y = 0
for unknown x, y.
To get final result, add x2, y2 to solution results (should be two solutions)
import math
def tangpts(px, py, cx, cy, r):
px -= cx
py -= cy
r2 = r*r
r4 = r2*r2
a = px*px+py*py
b = -2*r2*px
c = r4 - r2*py*py
d = b*b-4*a*c
if d < 0:
return None
d = math.sqrt(d)
xx1 = (-b - d) / (2*a)
xx2 = (-b + d) / (2*a)
if (abs(py) > 1.0e-8):
yy1 = (r2 - px * xx1) / py
yy2 = (r2 - px * xx2) / py
else:
yy1 = math.sqrt(r2 - xx1*xx1)
yy2 = -yy1
return((xx1+cx,yy1+cy),(xx2+cx,yy2+cy))
print(tangpts(0.5, 0.5, 0, 0, 1))
print(tangpts(1, 1, 0, 0, 1))
print(tangpts(0, 0, -3, -3, 3))
print(tangpts(2, 0, 0, 0, 1))
print(tangpts(0, 1, 0, 0, 1))
>>>
None #point inside
((0.0, 1.0), (1.0, 0.0)) #common case
((-3.0, 0.0), (0.0, -3.0)) #common case
((0.5, 0.8660254037844386), (0.5, -0.8660254037844386)) #py is zero case
((0.0, 1.0), (0.0, 1.0)) # single tangent case - point at circumference
In order to post the python code for the solution, I'm copying the explanation originally in comments:
The center of the circle is P2(x2, y2), the radius is r. The unknown point P3(x3, y3) satisfies the equation of the circle:
(x3-x2)^2 + (y3-y2)^2 = r^2 (1).
The tangent P1P3 is perpendicular to the radius of the circle P2P3. So apply the Pythagorean theorem to the triangle P1P2P3:
a) the distance between P1 and P2 is (x1-x2)^2 + (y1-y2)^2,
b) the distance between P1 and P3 is (x1-x3)^2 + (y1-y3)^2
c) the distance P2P3 is r, the radius
(x1-x3)^2 + (y1-y3)^2 + r^2 = (x1-x2)^2 + (y1-y2)^2 (2)
We have thus to solve the equations (1) and (2) for x3 and y3.
We now separate the unknowns (a linear relation between x3 and y3 can be obtained by (1)-(2) => (x3-x2)(x1-x2) + (y3-y2)(y1-y2) = r^2), and we get the two equations of second degree.
The python implementation:
import math
def tangentPoints(x1, y1, x2, y2, r):
a = (y1-y2)**2+(x1-x2)**2
bx = -r**2 * (x1-x2)
cx = r**2 * (r**2-(y1-y2)**2)
sqDeltax = math.sqrt(bx**2 - a*cx)
x3 = x2 + (-bx + sqDeltax)/a
x4 = x2 + (-bx - sqDeltax)/a
by = -r**2 * (y1-y2)
cy = r**2 * (r**2 - (x1-x2)**2)
sqDeltay = math.sqrt(by**2 - a*cy)
y3 = y2 + (-by - sqDeltay)/a
y4 = y2 + (-by + sqDeltay)/a
return (x3, y3), (x4, y4)
Given two functions, I need to find their intersection points and show them on the graph. For this particular problem, the functions are: f(x) = - (x - 2) ^ 2, g(x) = x/(x+1).
So far, I have the following:
Plot[{-(x - 2)^2 + 4, x/(x + 1)}, {x, 0, 4}, Filling -> {1 -> {{2}, {White, LightBlue}}}]
NSolve[-(x - 2)^2 + 4 == x/(x + 1), {x, y}]
But I have no idea how to show the points on a graph. How do I do that?
You can use the Epilog option to add graphics primitives to a plot:
intersections = {x, y} /.
NSolve[y == -(x - 2)^2 + 4 && y == x/(x + 1), {x, y}];
Plot[{-(x - 2)^2 + 4, x/(x + 1)}, {x, 0, 4},
Filling -> {1 -> {{2}, {White, LightBlue}}},
Epilog -> {Red, Point[intersections]}]
I have two vectors which I want to integrate in Matematica. Let the vectors be
r = {x, y};
Q = {x1, y1};
then I write this command
Integrate[
1/Norm[-((a*Q)/c) + r],
{a, 0, 1},
Assumptions -> (a*x1)/c > x && x ->
Real && (a*x1)/c ->
Real && x > 0 && (a*y1)/c -> Real && (a*y1)/c > y && y > 0
]
Where c is a positive constant. The output yields the same
Integrate[1/Norm[-((a Q)/c) + r], {a, 0, 1},
Assumptions -> (a x1)/c > 0 && (a x1)/c > x && x ->
Real && (a x1)/c -> Real && x > 0 && (a y1)/c > y && y > 0]
Could you please tell me where I am making a mistake?
I would be grateful if you could help me,
Thanks
r = {x, y};
Q = {x1, y1};
Integrate[1/Sqrt[(-((a*Q)/c) + r).(-((a*Q)/c) + r)], {a, 0, 1},
Assumptions -> Element[{x, y, x1, y1, a, c}, Reals]]
Returns:
(*
(1/Sqrt[x1^2 + y1^2])c (-Log[c (-x x1 - y y1 +Sqrt[(x^2 + y^2) (x1^2 + y1^2)])]+
Log[x1^2 + y1^2 - c (x x1 + y y1) +
(c Sqrt[(x1^2 + y1^2) (x1^2 + c^2 (x^2 + y^2) + y1^2 - 2 c (x x1 + y y1))])/
Abs[c]])
*)
Is it possible to smooth the lines/edges for a polygon? It's currently very sharp and angular and it would be great if those angles actually had curvature to them. Any ideas?
Add additional points into your polygon. The more points that are plotted, the more gradual the curve will be.
Here is a smoothing algorithm based on bSpline that worked for me on Android inspired by https://johan.karlsteen.com/2011/07/30/improving-google-maps-polygons-with-b-splines/
public List<LatLng> bspline(List<LatLng> poly) {
if (poly.get(0).latitude != poly.get(poly.size()-1).latitude || poly.get(0).longitude != poly.get(poly.size()-1).longitude){
poly.add(new LatLng(poly.get(0).latitude,poly.get(0).longitude));
}
else{
poly.remove(poly.size()-1);
}
poly.add(0,new LatLng(poly.get(poly.size()-1).latitude,poly.get(poly.size()-1).longitude));
poly.add(new LatLng(poly.get(1).latitude,poly.get(1).longitude));
Double[] lats = new Double[poly.size()];
Double[] lons = new Double[poly.size()];
for (int i=0;i<poly.size();i++){
lats[i] = poly.get(i).latitude;
lons[i] = poly.get(i).longitude;
}
double ax, ay, bx, by, cx, cy, dx, dy, lat, lon;
float t;
int i;
List<LatLng> points = new ArrayList<>();
// For every point
for (i = 2; i < lats.length - 2; i++) {
for (t = 0; t < 1; t += 0.2) {
ax = (-lats[i - 2] + 3 * lats[i - 1] - 3 * lats[i] + lats[i + 1]) / 6;
ay = (-lons[i - 2] + 3 * lons[i - 1] - 3 * lons[i] + lons[i + 1]) / 6;
bx = (lats[i - 2] - 2 * lats[i - 1] + lats[i]) / 2;
by = (lons[i - 2] - 2 * lons[i - 1] + lons[i]) / 2;
cx = (-lats[i - 2] + lats[i]) / 2;
cy = (-lons[i - 2] + lons[i]) / 2;
dx = (lats[i - 2] + 4 * lats[i - 1] + lats[i]) / 6;
dy = (lons[i - 2] + 4 * lons[i - 1] + lons[i]) / 6;
lat = ax * Math.pow(t + 0.1, 3) + bx * Math.pow(t + 0.1, 2) + cx * (t + 0.1) + dx;
lon = ay * Math.pow(t + 0.1, 3) + by * Math.pow(t + 0.1, 2) + cy * (t + 0.1) + dy;
points.add(new LatLng(lat, lon));
}
}
return points;
}
I have a problem while programing in Mathematica 8, here is my code:
f[t_, y_] := {y, y};
RungeKutta3[a_, b_, Alpha_, n_, f_] :=
Module[{h, j, k1, k2, k3},
h = (b - a)/n;
Y = T = Table[0, {100 + 1}];
Y[[1]] = Alpha;
T[[1]] = a;
For[j = 1, j <= n, ++j,
k1 = f[T[[j]], Y[[j]]];
k2 = f[T[[j]] + h/2, Y[[j]] + k1*h/2];
k3 = f[T[[j]] + h, Y[[j]] + (-k1 + 2 k2)h];
Y[[j + 1]] = Y[[j]] + h/6(k1 + 4 k2 + k3);
(* Print[j, "----->", Y[[j]]];*)
T[[j + 1]] = T[[j]] + h;
];];
RungeKutta3[0., 1., {300., 500}, 2, f];
The thing is, I'm trying to implement a Runge-Kutta method. And I was successful actually, but only with a function f[x_] that had 1 dimension. This code is for 2 dimensions, but it simply doesn't work and I don't know why. Here is an example for a code with 1 dimension only (notice that I have to change the first line to define the function and the last line, when I call "RungeKutta3").
f[t_, y_] := y;
RungeKutta3[a_, b_, Alpha_, n_, f_] :=
Module[{h, j, k1, k2, k3},
h = (b - a)/n;
Y = T = Table[0, {100 + 1}];
Y[[1]] = Alpha;
T[[1]] = a;
For[j = 1, j <= n, ++j,
k1 = f[T[[j]], Y[[j]]];
k2 = f[T[[j]] + h/2, Y[[j]] + k1*h/2];
k3 = f[T[[j]] + h, Y[[j]] + (-k1 + 2 k2)*h];
Y[[j + 1]] = Y[[j]] + h/6*(k1 + 4 k2 + k3);
(* Print[j, "----->", Y[[j]]];*)
T[[j + 1]] = T[[j]] + h;
];];
RungeKutta3[0., 1., 300., 100, f];
To sum up, how do I implemented the Runge-Kutta method for a function with 2 dimensions??
If you could help me out I would be grateful.
Thanks in advance!
PS: the Runge-Kutta method is order 3
----------------------
Problem solved! Check the code, if anybody needs help with anything, just ask!
f[t_, y1_, y2_] := 3 t*y2 + Log[y1] + 4 y1 - 2 t^2 * y1 - Log[t^2 + 1] - t^2;
F[t_, {y1_, y2_}] := {y2, f[t, y1, y2]};
RungeKutta3[a_, b_, [Alpha]_, n_, f_] :=
Module[{h, j, k1, k2, k3, Y, T, R},
h = (b - a)/n;
Y = T = Table[0, {n + 1}];
Y[[1]] = [Alpha]; T[[1]] = a;
For[j = 1, j <= n, ++j,
k1 = f[T[[j]], Y[[j]]];
k2 = f[T[[j]] + h/2, Y[[j]] + k1*h/2];
k3 = f[T[[j]] + h, Y[[j]] + (-k1 + 2 k2)*h];
Y[[j + 1]] = Y[[j]] + h/6*(k1 + 4 k2 + k3);
T[[j + 1]] = T[[j]] + h;
];
R = Table[0, {n + 1}];
For[j = 1, j <= n + 1, j++, R[[j]] = Y[[j]][[1]]];
Print[ListPlot[Transpose[{T, R}]]]
];
RungeKutta3[0., 1, {1., 0.}, 1000, F];
I know basically have a mathematica program that can solve ANY 2nd order equation! Through Runge-Kutta method. just insert your function on
f[t_, y1_, y2_]:= [Insert your function here]
where t is the independent value, y1 is the function itself y(t), y2 is y'(t).
Call the function through:
RungeKutta3[a, b, [Alpha], n, F];
where a is the initial "t" value, b the final "t" value, [Alpha] the initial value of your function and the first derivative (given in the form {y1(a),y2(a0)}), n the number of points equally spaced you want to represent. F is the function you have to insert despite of the function you give to f
Any questions feel free to ask!!
PS: The Runge-Kutta problem solves differential equations with problems of initial values, i used this program as a base to solve a problem of boundary values, if you want it just text me!
Doesn't your code just implement what is already built into Mathematica, namely, if you were to use the option
Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 3}
to NDSolve?
(This is not to suggest there's no value in "rolling your own": perhaps you want to do it as a learning exercise for yourself or for students, or as a student yourself.)