Please, I am trying to solve definite integral and its work but the results not simplified.
F = Integrate[(x^4*Exp[x])/(Exp[x] - 1)^2, {x, 0, 44}]
This is the result
(1/(15 (-1 + E^44)))4 (-\[Pi]^4 +
E^44 (\[Pi]^4 +
30 (-1874048 + 42592 Log[-1 + E^44] - 2904 PolyLog[2, 1/E^44] -
132 PolyLog[3, 1/E^44] - 3 PolyLog[4, 1/E^44])) +
30 (-42592 Log[-1 + E^44] +
3 (468512 + 968 PolyLog[2, 1/E^44] + 44 PolyLog[3, 1/E^44] +
PolyLog[4, 1/E^44])))
You need to convert the result to a numerical value.
F = Integrate[(x^4*Exp[x])/(Exp[x] - 1)^2, {x, 0, 44}];
N[F]
25.9758
Visualisation
Show[Plot[(x^4*Exp[x])/(Exp[x] - 1)^2, {x, -4, 48}],
Plot[(x^4*Exp[x])/(Exp[x] - 1)^2, {x, 0, 44},
Filling -> Axis, PlotRange -> All]]
Is it possible to find he center of sphere and its radius from 3 points on the surface ?
I'm building a model for a segmented brain structure were the three points would be within the structure; head, tail and middle.
Thank you,
Express that the center of the sphere is equidistant to the three given points and coplanar with them (assuming that the three given points are on a great circle).
(X - Xa)² + (Y - Ya)² + (Z - Za)² = R²
(X - Xb)² + (Y - Yb)² + (Z - Zb)² = R²
(X - Xc)² + (Y - Yc)² + (Z - Zc)² = R²
|X Y Z 1|
|Xa Ya Za 1|
|Xb Yb Zb 1| = 0
|Xc Yc Zc 1|
Subtracting the first equation from the second and the third, you get rid of the quadratic terms.
(2X - Xb - Xa)(Xb - Xa) + (2Y - Yb - Ya)(Yb - Ya) + (2Z - Zb - Za)(Zb - Za) = 0
(2X - Xc - Xa)(Xc - Xa) + (2Y - Yc - Ya)(Yc - Ya) + (2Z - Zc - Za)(Zc - Za) = 0
Now you have an easy linear system of 3 equations in 3 unknowns.
For conciseness you can translate the three points so that Xa=Ya=Za=0, and the equations simplify as
|X Y Z |
|Xb Yb Zb| = 0
|Xc Yc Zc|
(2X - Xb) Xb + (2Y - Yb) Yb + (2Z - Zb) Zb = 0
(2X - Xc) Xc + (2Y - Yc) Yc + (2Z - Zc) Zc = 0
or
(Yb Zc - Yc Zb) X + (Zb Xc - Zc Xb) Y + (Xb Yc - Xc Yb) Z = 0
2 Xb X + 2 Yb Y + 2 Zb Z = Xb² + Yb² + Zb²
2 Xc X + 2 Yc Y + 2 Zc Z = Xc² + Yc² + Zc²
Then, R² = X² + Y² + Z², and don't forget to translate back.
It is indeed possible, but it will always give you a sphere which the surface input points will be on its equator (meaning there are other, larger spheres that have these 3 points on it's surface if there's a fourth not coplanar point given).
But I think the smallest sphere is what you want. The following code written in C# gives you a Vector3 with the center of the sphere. The distance can then be obtained with Vector3.Distance (or a simple pithagorean distance) between any of the input points and the resulting center.
static public Vector3 BarycentricToWorld3D(Vector3 p1, Vector3 p2, Vector3 p3, float u, float v, float w) {
return (u * p1 + v * p2 + w * p3) / (u + v + w);
}
static public Vector3 CircleBariCenter3D(Vector3 p1, Vector3 p2, Vector3 p3) {
Vector3 a = p3 - p2;
Vector3 b = p1 - p3;
Vector3 c = p2 - p1;
float u = Vector3.Dot(a, a) * Vector3.Dot(c, b);
float v = Vector3.Dot(b, b) * Vector3.Dot(c, a);
float w = Vector3.Dot(c, c) * Vector3.Dot(b, a);
return BarycentricToWorld3D(p1, p2, p3, u, v, w);
}
Notice there's no checking for colinear points, which will make this fail. It should be trivial to add such checking by simply feeding this colinear points and watching it fail in the debugger.
Credits: I got a maxscript source for this 10+ years ago and lost the original author and location, and translated it into C# quite recently.
To address the question we start with the following toy model problem being here just a case study:
Given two circles on a plane (its centers (c1 and c2) and radii (r1 and r2)) as well as a positive number r3, find all circles with radii = r3 (i.e all points c3 being centers of circles with radii = r3) tangent (externally and internally) to given two circles.
In general, depending on Circle[c1,r1], Circle[c2,r2] and r3 there are 0,1,2,...8 possible solutions. A typical case with 8 solutions :
I slightly modified a neat Mathematica implementation by Jaime Rangel-Mondragon on Wolfram Demonstration Project, but its core is similar:
Manipulate[{c1, a, c2, b} = pts;
{r1, r2} = Map[Norm, {a - c1, b - c2}];
w = Table[
Solve[{radius[{x, y} - c1]^2 == (r + k r1)^2,
radius[{x, y} - c2]^2 == (r + l r2)^2}
] // Quiet,
{k, -1, 1, 2}, {l, -1, 1, 2}
];
w = Select[
Cases[Flatten[{{x, y}, r} /. w, 2],
{{_Real, _Real}, _Real}
],
Last[#] > 0 &
];
Graphics[
{{Opacity[0.35], EdgeForm[Thin], Gray,
Disk[c1, r1], Disk[c2, r2]},
{EdgeForm[Thick], Darker[Blue,.5],
Circle[First[#], Last[#]]& /# w}
},
PlotRange -> 8, ImageSize -> {915, 915}
],
"None" -> {{pts, {{-3, 0}, {1, 0}, {3, 0}, {7, 0}}},
{-8, -8}, {8, 8}, Locator},
{{r, 0.3, "r3"}, 0, 8},
TrackedSymbols -> True,
Initialization :> (radius[z_] := Sqrt[z.z])
]
We can easily conclude that in a generic case we have an even number of solutions 0,2,4,6,8 while cases with an odd number of solutions 1,3,5,7 are exceptional - they are of zero measure in terms of control ranges. Thus changing in Manipulate c1, r1, c2, r2, r3 one can observe that it is much more difficult to track cases with an odd number of circles.
One could modify on a basic level the above approach : solving purely symbolically equations for c3 as well as redesignig Manipulate structure with an emphasis on changing number of solutions. If I'm not wrong Solve can work only numerically with Locator in Manipulate, however here Locator seems to be crucial for simplicity of controlling c1, r1, c2, r2 as well as for the whole implementation.
Let's state the questions, :
1. How can we force Manipulate to track seamlessly cases with an odd number of solutions (circles) ?
2. Is there any way to make Solve to find exact solutions of the underlying equations?
( I find the answer by Daniel Lichtblau to be the best approach to the question 2, but it seems in this instance there is still an essential need for sketching of a general technique of emphasizing measure zero sets of solutions while working with Manipulate )
These considerations are of less importance while dealing with exact solutions
For example Solve[x^2 - 3 == 0, x] yields {{x -> -Sqrt[3]}, {x -> Sqrt[3]}}
while in case from the above of slightly more difficult equations extracted from Manipulate setting the following arguments :
c1 = {-Sqrt[3], 0}; a = {1, 0}; c2 = {6 - Sqrt[3], 0}; b = {7, 0};
{r1, r2} = Map[ Norm, {a - c1, b - c2 }];
r = 2.0 - Sqrt[3];
to :
w = Table[Solve[{radius[{x, y} - {x1, y1}]^2 == (r + k r1)^2,
radius[{x, y} - {x2, y2}]^2 == (r + l r2)^2}],
{k, -1, 1, 2}, {l, -1, 1, 2}];
w = Select[ Cases[ Flatten[ {{x, y}, r} /. w, 2], {{_Real, _Real}, _Real}],
Last[#] > 0 &]
we get two solutions :
{{{1.26795, -3.38871*10^-8}, 0.267949}, {{1.26795, 3.38871*10^-8}, 0.267949}}
similarly under the same arguments and equations, putting :
r = 2 - Sqrt[3];
we get no solutions : {}
but in fact there is exactly one solution which we would like to emphasize:
{ {3 - Sqrt[3], 0 }, 2 - Sqrt[3] }
In fact, passing to Graphics such a small difference between two different solutions and the uniqe one is indistinguishable, however working with Manipulate we cannot track carefully with a desired accuracy merging of two circles and usually the last observed configuration when lowering r3 before vanishing all solutions (reminding so-called structural instability) looks like this :
Manipulate is rather a powerful tool, not only a toy, and its mastering could be very useful. The considered issues when appearing in a serious research are frequently critical, for example: in studying solutions of nonlinear differential equations, occurence of singularities in its solutions, qualitative behavior of dynamical systems, bifurcations, phenomena in Catastrophe theory and so on.
As this is a measure zero set, tools that require some granularity will generally have trouble with the concept. Perhaps better is to look for the singularity locus explicitly, where solutions have multiplicity or in other ways depart from the nearby solution behavior(s). It will be a part of the discriminant variety. In particular, you can grab the relevant part by setting your defining polynomials to zero and simultaneously making the Jacobian determinant zero.
Here is your example. I will eventually (wlog) put one center at the origin and the other at (1,0).
centers = Array[c, {2, 2}];
radii = Array[r, 3];
circ[cen_, rad_, x_, y_] := ({x, y} - cen).({x, y} - cen) - rad^2
I'll use your 'k' for both polynomials. Your formulation has pairs (k,l) where each is +-1. We can just use k, arrange by squaring to get a polynomial in k^2, and replace that with 1.
polys =
Table[Expand[
circ[centers[[j]], radii[[3]] + k*radii[[j]], x, y]], {j, 2}]
Out[18]= {x^2 + y^2 - 2 x c[1, 1] + c[1, 1]^2 - 2 y c[1, 2] +
c[1, 2]^2 - k^2 r[1]^2 - 2 k r[1] r[3] - r[3]^2,
x^2 + y^2 - 2 x c[2, 1] + c[2, 1]^2 - 2 y c[2, 2] + c[2, 2]^2 -
k^2 r[2]^2 - 2 k r[2] r[3] - r[3]^2}
We'll remove the part that is linear in k, square the rest, square that removed part, and equate the two. We also then replace k with unity.
p2 = polys - k*Coefficient[polys, k];
polys2 = Expand[p2^2 - (k*Coefficient[polys, k])^2] /. k -> 1;
We now get the determinant of the Jacobian and add that to the brew.
discrim = Det[D[polys2, #] & /# {x, y}];
allrelations = Join[polys2, {discrim}];
Now set the centers as noted earlier (could have done this from the beginning, one would suppose).
ar2 =
allrelations /. {c[1, 1] -> 0, c[1, 2] -> 0, c[2, 1] -> 0,
c[2, 2] -> 0}
Out[38]= {x^4 + 2 x^2 y^2 + y^4 - 2 x^2 r[1]^2 - 2 y^2 r[1]^2 +
r[1]^4 - 2 x^2 r[3]^2 - 2 y^2 r[3]^2 - 2 r[1]^2 r[3]^2 + r[3]^4,
x^4 + 2 x^2 y^2 + y^4 - 2 x^2 r[2]^2 - 2 y^2 r[2]^2 + r[2]^4 -
2 x^2 r[3]^2 - 2 y^2 r[3]^2 - 2 r[2]^2 r[3]^2 + r[3]^4, 0}
We now eliminate x and y to get the locus in r[1],r[2],r[3] parameter space that determines where we'll have multiplicity in our solutions.
gb = GroebnerBasis[ar2, radii, {x, y},
MonomialOrder -> EliminationOrder]
{r[1]^6 - 3 r[1]^4 r[2]^2 + 3 r[1]^2 r[2]^4 - r[2]^6 -
8 r[1]^4 r[3]^2 + 8 r[2]^4 r[3]^2 + 16 r[1]^2 r[3]^4 -
16 r[2]^2 r[3]^4}
If I did this all correctly, then we now have the polynomial defining the locus in parameter space where solution sets can get silly. Off this set they should never have multiplicity, and real counts should always be even. The intersection of this set with real space will be a 2d surface in the 3d space of the radii parameters. It will separate regions that have 0, 2, 4, 6, or 8 real solutions from one another.
Last, I'll point out that in this example the variety in question reduces nicely into a product of planes. I guess from a geometric view this is not too surprising.
Factor[gb[[1]]]
Out[43]= (r[1] - r[2]) (r[1] + r[2]) (r[1] - r[2] - 2 r[3]) (r[1] +
r[2] - 2 r[3]) (r[1] - r[2] + 2 r[3]) (r[1] + r[2] + 2 r[3])
I am working on a geometry problem that requires finding the intersection of two parabolic arcs in any rotation. I was able to intesect a line and a parabolic arc by rotating the plane to align the arc with an axis, but two parabolas cannot both align with an axis. I am working on deriving the formulas, but I would like to know if there is a resource already available for this.
I'd first define the equation for the parabolic arc in 2D without rotations:
x(t) = ax² + bx + c
y(t) = t;
You can now apply the rotation by building a rotation matrix:
s = sin(angle)
c = cos(angle)
matrix = | c -s |
| s c |
Apply that matrix and you'll get the rotated parametric equation:
x' (t) = x(t) * c - s*t;
y' (t) = x(t) * s + c*t;
This will give you two equations (for x and y) of your parabolic arcs.
Do that for both of your rotated arcs and subtract them. This gives you an equation like this:
xa'(t) = rotated equation of arc1 in x
ya'(t) = rotated equation of arc1 in y.
xb'(t) = rotated equation of arc2 in x
yb'(t) = rotated equation of arc2 in y.
t1 = parametric value of arc1
t2 = parametric value of arc2
0 = xa'(t1) - xb'(t2)
0 = ya'(t1) - yb'(t2)
Each of these equation is just a order 2 polynomial. These are easy to solve.
To find the intersection points you solve the above equation (e.g. find the roots).
You'll get up to two roots for each axis. Any root that is equal on x and y is an intersection point between the curves.
Getting the position is easy now: Just plug the root into your parametric equation and you can directly get x and y.
Unfortunately, the general answer requires solution of a fourth-order polynomial. If we transform coordinates so one of the two parabolas is in the standard form y=x^2, then the second parabola satisfies (ax+by)^2+cx+dy+e==0. To find the intersection, solve both simultaneously. Substituting in y=x^2 we see that the result is a fourth-order polynomial: (ax+bx^2)^2+cx+dx^2+e==0. Nils solution therefore won't work (his mistake: each one is a 2nd order polynomial in each variable separately, but together they're not).
It's easy if you have a CAS at hand.
See the solution in Mathematica.
Choose one parabola and change coordinates so its equation becomes y(x)=a x^2 (Normal form).
The other parabola will have the general form:
A x^2 + B x y + CC y^2 + DD x + EE y + F == 0
where B^2-4 A C ==0 (so it's a parabola)
Let's solve a numeric case:
p = {a -> 1, A -> 1, B -> 2, CC -> 1, DD -> 1, EE -> -1, F -> 1};
p1 = {ToRules#N#Reduce[
(A x^2 + B x y + CC y^2 + DD x + EE y +F /. {y -> a x^2 } /. p) == 0, x]}
{{x -> -2.11769}, {x -> -0.641445},
{x -> 0.379567- 0.76948 I},
{x -> 0.379567+ 0.76948 I}}
Let's plot it:
Show[{
Plot[a x^2 /. p, {x, -10, 10}, PlotRange -> {{-10, 10}, {-5, 5}}],
ContourPlot[(A x^2 + B x y + CC y^2 + DD x + EE y + F /. p) ==
0, {x, -10, 10}, {y, -10, 10}],
Graphics[{
PointSize[Large], Pink, Point[{x, x^2} /. p /. p1[[1]]],
PointSize[Large], Pink, Point[{x, x^2} /. p /. p1[[2]]]
}]}]
The general solution involves calculating the roots of:
4 A F + 4 A DD x + (4 A^2 + 4 a A EE) x^2 + 4 a A B x^3 + a^2 B^2 x^4 == 0
Which is done easily in any CAS.