Re: A New Scientist article verified with Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg107255] Re: [mg107238] A New Scientist article verified with Mathematica
- From: "David Park" <djmpark at comcast.net>
- Date: Sun, 7 Feb 2010 06:11:23 -0500 (EST)
- References: <31983818.1265446250129.JavaMail.root@n11>
Hello Sigismond.
Unfortunately, I do not have access to the New Scientist magazine and so I
don't know what the actual message to be conveyed is. But I can say some
things about doing the graphics and making dynamic presentations. But, as
usual, I will use the Presentations package from my web site because I
believe it makes things much easier.
First, you can write your graphic more simply by using a single Graphics
statement.
Graphics[
{{Red, Circle[{0, 0}, 2]},
Circle[{2, 0}, 2],
{Red, Dashed, Circle[{5, 0}, 2]}},
Axes -> True]
If you want to specify coordinates directly in the complex plane you can use
the Presentations ComplexCircle routine. Here I raised the black circle to
better illustrate the use of a complex number for the center.
Needs["Presentations`Master`"]
Graphics[
{{Red, ComplexCircle[0, 2]},
ComplexCircle[2 + I, 2],
{Red, Dashed, ComplexCircle[5, 2]}},
Axes -> True]
If we want to specify the circles by equations we can use ContourDraw and
here I also switch to Draw2D as the graphics container (just a slightly
modified Graphics).
Draw2D[
{{Red, ContourDraw[x^2 + y^2 == 4, {x, -3, 8}, {y, -3, 3}]},
ContourDraw[(x - 2)^2 + y^2 == 4, {x, -3, 8}, {y, -3, 3}],
{Red, Dashed,
ContourDraw[(x - 5)^2 + y^2 == 4, {x, -3, 8}, {y, -3, 3}]}},
Axes -> True]
We could also draw the circles as single parameter curves in the complex
plane. This uses the Presentations routine ComplexCurve, a rather nice idea
of Murray Eisenberg.
Draw2D[
{{Red, ComplexCurve[2 E^(I \[Theta]), {\[Theta], 0, 2 \[Pi]}]},
ComplexCurve[2 + 2 E^(I \[Theta]), {\[Theta], 0, 2 \[Pi]}],
{Red, Dashed,
ComplexCurve[5 + 2 E^(I \[Theta]), {\[Theta], 0, 2 \[Pi]}]}},
Axes -> True]
I lieu of a specific dynamic diagram for the New Scientist article, I will
show an example from Presentations PlaneGeometry Tutorial. The PlaneGeometry
section contains routines for drawing dynamic geometric diagrams, and
specifically it has routines for finding intersections of lines and circles
with each other. The tutorial also has a set of graded examples of
constructing custom dynamic diagrams. In any case, the following
specification creates a display that contains:
1) a line that can be repositioned with two red CirclePoint locators. (The
line is extended beyond the segment defined by the locators.)
2) two circles that can be repositioned with CirclePoint locators at their
centers.
3) triangular locators (DragLocators) on each circle circumference that can
be used to alter the radii of the circles.
4) white CirclePoints that mark the intersections of all of these objects.
(Just real intersections in this case, of course,)
5) A listing of the intersection locations at the bottom of the diagram.
As you drag the objects around, or adjust the radii of the circles, the
intersections come and go.
Module[
{ptc1 = {-5, -2}, sr1 = 3., ptc2 = {5, 2}, sr2 = 4,
ptA = {-5, 3}, ptB = {5, 3},
ptr1, ptr2, intersectionsc1l, intersectionsc2l, intersectionsc1c2,
allintersections, numintersections,
calcAll,
unithandle = ToCoordinates@PolarToComplex@ComplexPolar[1, \[Pi]/4]},
calcAll[p1_, p2_, c1_, c2_, s1_, s2_] :=
(ptr1 = parametrizedLine[{c1, c1 + unithandle}][s1];
ptr2 = parametrizedLine[{c2, c2 + unithandle}][s2];
intersectionsc1l = lineCircleIntersection[{ptc1, s1}, {p1, p2}];
intersectionsc2l = lineCircleIntersection[{ptc2, s2}, {p1, p2}];
intersectionsc1c2 = circlesIntersection[{c1, s1}, {c2, s2}];
allintersections =
Join[intersectionsc1l, intersectionsc2l, intersectionsc1c2];
numintersections = Length[allintersections]);
(* Initialize diagram *)
calcAll[ptA, ptB, ptc1, ptc2, sr1, sr2];
panelpage[
{Draw2D[
{Dynamic@
{Circle[ptc1, Abs[sr1]],
Circle[ptc2, Abs[sr2]],
DrawRayLine[{ptA, ptB}],
CirclePoint[#, 3, Black, White] & /@ allintersections},
(* Locators for the line *)
DrawLocators[{ptA, ptB}, CirclePointLocator[3, Red],
calcAll[ptA, ptB, ptc1, ptc2, sr1, sr2]],
(* Locators for the centers of the circle *)
Locator[
Dynamic[ptc1, (ptc1 = #;
calcAll[ptA, ptB, ptc1, ptc2, sr1, sr2]) &],
CirclePointLocator[2, Legacy@SapGreen]],
Locator[
Dynamic[ptc2, (ptc2 = #;
calcAll[ptA, ptB, ptc1, ptc2, sr1, sr2]) &],
CirclePointLocator[2, Legacy@Sepia]],
(* Locator for the radii handles,
constrained along a radial line *)
Locator[
Dynamic[ptr1, (sr1 =
inverseParametrizedLine[#, {ptc1, ptc1 + unithandle}];
calcAll[ptA, ptB, ptc1, ptc2, sr1, sr2]) &],
DragLocator[\[Pi]/4, Legacy@SapGreen]],
Locator[
Dynamic[ptr2, (sr2 =
inverseParametrizedLine[#, {ptc2, ptc2 + unithandle}];
calcAll[ptA, ptB, ptc1, ptc2, sr1, sr2]) &],
DragLocator[\[Pi]/4, Legacy@Sepia]]},
PlotRange -> 12,
ContentSelectable -> False,
ImageSize -> 450](* Draw2D *),
Dynamic@
pagelet[
phrase[Style["Intersections:", 16, Bold]],
phrase["line - green circle: ", intersectionsc1l],
phrase["line - sepia circle: ", intersectionsc2l],
phrase["circle - circle: ", intersectionsc1c2]
](* pagelet *)
},
Style["Intersections with Circles", 16],
paneWidth -> 600] (* panelpage *)
]
Now, let's go to 3D cases. First let's do an intersection of a line and a
cone. Here are their parametrizations:
unitcone[r_, \[Theta]_] := {r Cos[\[Theta]], r Sin[\[Theta]], r}
line[point_, direction_][s_] := point + s direction
We solve for the s parameters for a specific line that intersects the cone.
Flatten@{Thread[(unitcone[r, \[Theta]] /. {Cos[\[Theta]] -> c\[Theta],
Sin[\[Theta]] -> s\[Theta]}) ==
line[{-2, 0, -1}, {1, 0, 6/10}][s]],
c\[Theta]^2 + s\[Theta]^2 == 1}
Solve[%, s, {r, c\[Theta], s\[Theta]}]
svals = Select[s /. %, FreeQ[#, Complex] &]
Then draw the line, cone and intersections.
Draw3DItems[
{(* Draw the cone *)
Opacity[.6, Lighter@Green],
ParametricDraw3D[
unitcone[r, \[Theta]], {r, -1, 1}, {\[Theta], 0, 2 \[Pi]},
Mesh -> None],
(* Draw the line *)
Opacity[1, Black],
ParametricDraw3D[line[{-2, 0, -1}, {1, 0, 6/10}][s], {s, 1, 3}],
(* Mark the intersection points *)
Red, AbsolutePointSize[5],
Point[line[{-2, 0, -1}, {1, 0, 6/10}] /@ svals]},
NeutralLighting[0, .5, .0],
NiceRotation,
Boxed -> False]
Finally, let's do an intersection of a plane and a cone. I will start with a
standard plane and then rotate and translate it to a new position.
standardplane[u_, v_] := {u, v, 0}
newplane[u_, v_] =
standardplane[u, v] //
RotationTransform[\[Pi]/4, {0, 1, 0}, {0, 0, 0}] //
TranslationTransform[{0, 0, 1/2}]
The following solves for the curve in the newplane, which is the
intersection of the plane and the cone. We end up with a parametrization,
ufunc, of the intersection curve.
newplane[u, v] == unitcone[r, \[Theta]] // Thread
% /. {Cos[\[Theta]] -> ca, Sin[\[Theta]] -> sa}
Flatten[{%, ca^2 + sa^2 == 1}]
Eliminate[%, {ca, sa, r}]
Part[Solve[%, u], 1, 1]
ufunc[v_] = u /. %
Then draw the diagram.
Draw3DItems[
{(* Draw the cone *)
Opacity[.6, Lighter@Green],
ParametricDraw3D[
unitcone[r, \[Theta]], {r, -3, 3}, {\[Theta], 0, 2 \[Pi]},
Mesh -> None],
(* Draw the plane *)
Opacity[.6, Orange],
ParametricDraw3D[newplane[u, v], {u, -5, 3}, {v, -3, 3},
Mesh -> None],
(* Draw the cone-plane intersection *)
Opacity[1], Black, AbsoluteThickness[2],
ParametricDraw3D[newplane[ufunc[v], v], {v, -2, 2}]},
NeutralLighting[0, .5, .0],
NiceRotation,
Boxed -> False]
But cone-cone intersections are generally much more difficult - at least for
me.
David Park
djmpark at comcast.net
http://home.comcast.net/~djmpark/
From: sigismond kmiecik [mailto:sigismond.kmiecik at wanadoo.fr]
Hello to everybody
In the last Xmas issue of the New Scientist magazine there is on page
40 a small article about the continuity principle applied to
intersecting circles.
I used Mathematica to confirm its conclusions but some questions remain
to be answered.
These circles are represented by
Show[{Graphics[{Red, Circle[{0, 0}, 2]}], Graphics[Circle[{2, 0}, 2]],
Graphics[{Red, Dashed, Circle[{5, 0}, 2]}]}, AxesOrigin -> {0, 0},
PlotRange -> {{-3, 8}, {-3, 3}}, Axes -> True ]
The intersection coordinates of the red (non-dashed) and black circle is
found by:
Solve [{ x^2 + y^2 - 4 == 0, (x - 2)^2 + y^2 - 4 == 0 }, {x, y}=
]
And there is indeed an imaginary intersection of the red and red-dashed
circle even if they are not touching - as found by:
Solve [{ x^2 + y^2 - 4 == 0, (x - 5)^2 + y^2 - 4 == 0 }, {x, y}=
]
My questions are:
- Is there a way to draw with Mathematica these three circles using
their cartesian equations and not the Circle graphics =91primitive=92 ?
- How can I transform the list of rules solutions to the last equation
above in order to represent them on the complex plane (I thought about
a ListPlot [{Re[],Im[]}=85 but I know not enough of Mathematica to
obtain that)
- And last is there a Mathematica notebook on the web dealing with the
intersection of planes with cones?
Thanks
Sigismond Kmiecik