Tag Archives: Mathematica

October 6, 2009 · 9:21 pm

Producing a simple 3d Animation with Mathematica 7.0 running in parallel on four kernels.

This is an advance on something I am currently working for www.isallaboutmath.com

I need to produce some Spheres in 3d rotating in space so I figure since I have Mathematica 7.0 and it produces very good 3d images I should be able to use it.

I am going to list the code and explained what it does

p1[\[Theta]_] := RotationTransform[\[Theta], {0, 0, 1}][{0, 3.5, 0}];
a1[\[Theta]_] :=
RotationTransform[\[Theta], {0, 0, 1}][{0, 3.5, -1/2}];
a2[\[Theta]_] := RotationTransform[\[Theta], {0, 0, 1}][{0, 3.5, 1/2}];
r[\[Theta]_] :=
Rasterize[
Style[Graphics3D[{Sphere[{0, 0, 0}, .8], Sphere[p1[\[Theta]], 1/4],
{Orange, Tube[{a1[\[Theta]], a2[\[Theta]]}, 0.04]},
{Blue, Tube[{{0, 0, 0}, p1[\[Theta]]}, 0.04]},
{Red, Tube[{{0, 0, -1}, {0, 0, 1}}
]}}, PlotRange -> 4.5, Boxed -> False, Background -> Black,
ImageSize -> {790, 480}, ViewPoint -> {3, 3, 3},
BaseStyle -> Yellow, Axes -> False, AspectRatio -> 1]
, Antialiasing -> True], RasterSize -> 2500];
DistributeDefinitions[p1];
DistributeDefinitions[r];
DistributeDefinitions[a1];
DistributeDefinitions[a2];
ParallelTable[
Export["planeta" <> ToString[\[Theta]] <> “.png”,
r[N[\[Theta], 4]/100], ImageResolution -> 2500,
ImageSize -> {790, 480}], {\[Theta], 0, 628, 1}]

p1[\[Theta]_] := RotationTransform[\[Theta], {0, 0, 1}][{0, 3.5, 0}];

a1[\[Theta]_] :=

RotationTransform[\[Theta], {0, 0, 1}][{0, 3.5, -1/2}];

a2[\[Theta]_] := RotationTransform[\[Theta], {0, 0, 1}][{0, 3.5, 1/2}];

r[\[Theta]_] :=

Rasterize[

Style[Graphics3D[{Sphere[{0, 0, 0}, .8], Sphere[p1[\[Theta]], 1/4],

{Orange, Tube[{a1[\[Theta]], a2[\[Theta]]}, 0.04]},

{Blue, Tube[{{0, 0, 0}, p1[\[Theta]]}, 0.04]},

{Red, Tube[{{0, 0, -1}, {0, 0, 1}}

]}}, PlotRange -> 4.5, Boxed -> False, Background -> Black,

ImageSize -> {790, 480}, ViewPoint -> {3, 3, 3},

BaseStyle -> Yellow, Axes -> False, AspectRatio -> 1]

, Antialiasing -> True], RasterSize -> 2500];

DistributeDefinitions[p1];

DistributeDefinitions[r];

DistributeDefinitions[a1];

DistributeDefinitions[a2];

ParallelTable[

Export["planet" <> ToString[\[Theta]] <> “.png”,

r[N[\[Theta], 4]/100], ImageResolution -> 2500,

ImageSize -> {790, 480}], {\[Theta], 0, 628, 1}]

The first 3 lines are making rotations around the z axis in 3d space of a point located at (0,3.5,0) and two other points located at (0,3.5,-1/2) and (0,3.5,1/2).

The next line where we define the function r is the meat of the program and where most of the hard work is done we use Rasterize to get an image the argument we use in the function defined represents the angle of rotation of the object we are rotating in our case we will be rotating a sphere and a line.

Since doing this computations is very computer intensive task and Mathematica 7.0 by default give you access to 4 parallel kernels we decided to use the parallel power of Mathematica 7.0.  So we need to distribute the definitions of the functions we have created and that is archive with DistributeDefinitions and can be seen on the next 4 lines.

Finally we get to the ParallelTable this is very much equivalent to Table command in Mathematica but it is executed in parallel!

We use Export to produce an image on a local directory  and in our case we are exporting png images (a type of compressed raster image) we are using also very high resolution as to produce very good quality images.

Since we need to output a sequence of images they need to be name in an increasing and ordered sequence so that the graphics program where we will assemble the animation can pick up the images easily. In our case we use Adobe After Effect CS4 to transform the sequence of images out of Mathematica 7.0 to produce the animation. This method produce images of very good quality. The images in this case will be named planet1.png, planet2.png, …. up to planet628.png

and the rotation of the angle will go from 0 to 6.28 or approximately 2 Pi! so one complete round trip around the center.

This is one image of the animation.

planeta19

The image seems to be a little squash this has to do with Mathematica producing images for video once it gets into Adobe After Effect we can select Interpret Footage with Pixel Aspect Ratio of 0.91 ratio and then the sphere will look round again!

Here is the short animation

The results of this will appear in an upcoming animation for www.isallaboutmath.com about Thales of Miletus.

Leave a Comment

Filed under math, Mathematica, mathematics

Tagged as , ,

May 17, 2009 · 8:50 am

The Oracle of Wolfram. Wolframalpha.

It could be said this is the comming of age of search engine. We have seen yahoo first then google and many other minor stars. Get ready now we have

http://www.wolframalpha.com/ 

What is so different or new about this search engine?

Well to start it uses Mathematica to produce the result of the queries! Mathematica is a wonderful software that allows one to do very sofisticated mathematical computation and that have a lot of information embeded in the system.

Wolframalpha allows one to not just search for information but to find new information from existing information in other words to mined information to ask questions to correlated information.

 I found some cute things from Wolframalpha already.

At one point I guess their servers were overwhelm and I got this answer!

I’m sorry Dave, I’m afraid I can’t do that. (Famous line from Arthur C Clarke 2001 Space Odyssey.

WolframAlpha2

On the other hand I try something simple like getting Pi to 100,000 digits and after paging a few times got this errors that shows part of the inner workings of the system is Mathematica Code !!!

 

wolfram1

To learn more about wolfram alphahttp://www.wolfram.com/products/mathematica/madepossible/wolframalpha.html

Leave a Comment

Filed under Mathematica

Tagged as , ,

July 28, 2008 · 7:56 pm

Is all about math Word Cloud.

Have you ever desired to look some document quickly or Web Site and have a very general idea about what it is without going into details?

There is this novel site at http://wordle.net that produces a picture of words that appear in the document and the most frequent words appear bigger.

Very Nice Tool!

2 Comments

Filed under math

Tagged as , ,

July 10, 2008 · 9:32 am

Creating a Mathematica demonstration on Fermat’s Theorem on Stationary Points

One of the new features of Mathematica 6.0 and above is that it allows you to create a new type of Mathematica notebook called a Mathematica Demonstration.

A Mathematica Demonstration usually consists of some sort of animation that can be manipulated thru some windows controls on the notebook. This is created using some new Mathematica 6.0 code.

The main part of the code is contained within

Manipulate[]

The Manipulate command resembles the Animate [] command of prior Mathematica versions. The main differences is that with Manipulate you may be able to use all the control types while with the Animate[] you may control one or multiple parameters with slider control.

When I got Mathematica I wanted to try my hands at creating a new Demonstration and I decided to create a demonstration on Fermat’s Theorem on Stationary Points.
This is a very beautiful theorem that states

If c is a local extremum in the interval (a,b) and f is differentiable at c, then f’(c)=0.

There is a very simple geometric interpretation of this theorem. As we know the first derivative of a function f could be interpreted as the slope of the tangent line thru the point (c,f(c)) if such derivative exist.  When the slope of the tangent line is zero  f’(c)=0.

My basic idea for the demo was to build a line segment tangent to a point c and I could vary the position of the point c and the line segment tangent  will get redraw.

I wanted to build the segment so that the length from (c,f(c)) to each of the ends of the segments was the same or that (c,f(c)) was the mid point of the segment. To accomplish this I figure the derivative of f at a point c and then computed the equation of the tangent line to f at c and then found the intersection of that line with a unit circle center on (c,f(c)). So the resulting Mathematica code looks like this nightmare!

Manipulate[
Plot[2 Sin[x] + x, {x, 0, 2 Pi},
Epilog -> {{Line[{{(
2 c + 4 c Cos[c] + 4 c Cos[c]^2 -
Sqrt[2] Sqrt[1 + 2 Cos[c] + 2 Cos[c]^2])/(
2 (1 + 2 Cos[c] + 2 Cos[c]^2)), (2 Cos[c] + 1) ((
2 c + 4 c Cos[c] + 4 c Cos[c]^2 -
Sqrt[2] Sqrt[1 + 2 Cos[c] + 2 Cos[c]^2])/(
2 (1 + 2 Cos[c] + 2 Cos[c]^2))) + 2 Sin[c] +
c – (2 Cos[c] + 1) c}, {(
2 c + 4 c Cos[c] + 4 c Cos[c]^2 +
Sqrt[2] Sqrt[1 + 2 Cos[c] + 2 Cos[c]^2])/(
2 (1 + 2 Cos[c] + 2 Cos[c]^2)), (2 Cos[c] + 1) ((
2 c + 4 c Cos[c] + 4 c Cos[c]^2 +
Sqrt[2] Sqrt[1 + 2 Cos[c] + 2 Cos[c]^2])/(
2 (1 + 2 Cos[c] + 2 Cos[c]^2))) + 2 Sin[c] +
c – (2 Cos[c] + 1) c}}]}, {Darker@Red, PointSize[0.015],
Point[{c, 2 Sin[c] + c}]}},
PlotLabel ->
Style[StringJoin["slope: " , ToString[N[2 Cos[c] + 1]]], 12],
AspectRatio -> Automatic, ImageSize -> {500, 400},
AxesLabel -> {Row[{Style["x", Italic], ” value”}],
TraditionalForm[2 Sin[x] + x]}], {{c, 2.08979, “value c”}, 0,
2 Pi}]

I have decided to simplify the code a bit to make the code more readable.

f[x_] = 2 (Sin[x]) + x;
d[x_] = D[f[x], x];
r = 1.5;
p1 := x /. Solve[(x -
c)^2 + ((d[c]) x + (f[c] – (d[c]) c) – (f[c]) )^2 == r^2,
x][[1]];
f1[c_] = p1;
p2 := x /. Solve[(x -
c)^2 + ((d[c]) x + (f[c] – (d[c]) c) – (f[c]) )^2 == r^2,
x][[2]];
f2[c_] = p2;
SetOptions[Plot,
Ticks -> {{-1, 0, 1, 2, 3, 4, 5, 6, 7}, {-1, 1, 2, 3, 4, 5, 6, 7}},
PlotRangePadding -> 1.5, AspectRatio -> Automatic,
Background -> Black, ImageSize -> {640, 480}, AxesLabel -> {x, y},
AxesStyle -> Directive[20, Thick, Orange]];
Manipulate[
Show[Plot[f[x], {x, -1, 2 Pi},
Epilog -> {
Inset[
Style[StringJoin["value:", ToString[N[c]]], Yellow, 20], {2, 7},
Alignment -> Center],
Inset[
Style[StringJoin["Slope:" , ToString[N[d[c], 5]]], Yellow,
20], {2.5, 6.5}],
If[lin, {Thick, Dashed, Green, Line[{{c, 0}, {c, f[c]}}]}, {}],
If[lin && der, {Thick, Dashed, Green,
Line[{{c, 0}, {c, d[c]}}]}, {}],
If[circle, {White, Circle[{c, f[c]}, r]}, {}], {Thick, Yellow,
Line[{{f1[c], (d[c]) (f1[c]) + f[c] – (d[c]) c}, {f2[
c], (d[c]) (f2[c]) + f[c] – (d[c]) c}}]},
If[der, {Red, PointSize[0.02], Point[{c, d[c]}]}, {}],
{Red, PointSize[0.02], Point[{c, f[c]}]}}
,
(*PlotLabel->Style[StringJoin["value:",ToString[N[c]],” “,
“Slope:” ,ToString[N[d[c],5]]],Yellow,20],*)
PlotStyle -> Directive[Red, Thick]
], If[der,
Plot[d[x], {x, -1.001, c}, PlotStyle -> Directive[Blue, Thick]
], {}
]
], {{c, (2 \[Pi])/3, “Value c”}, -1, 2 Pi,
0.001}, {{circle, False, “Show Circle”}, {False, True}}, {{der,
True, “Show Derivative”}, {False, True}},
{{lin, True, “Show line”}, {False, True}}]

And I also added three check boxes to be able to see the graph of the derivative of the function f(x) and also to be able to see the circle.

The original mathematica demonstration I created is at Wolfram demonstration.

1 Comment

Filed under math, Mathematica

Tagged as ,

June 17, 2008 · 9:21 pm

One easy problem and One not so easy problem.

A few post ago we used Mathematica to draw the altitudes of an arbitrary triangle of given coordinates. Now we are solving these other two problems The first figure the red lines represent the medians and on the second figure the yellow lines represent the angle bisectors. So our problem consist in finding the Mathematica code to produce these figures.

Let us do the easy one first. To draw a triangle and the medians we will use the Lineal Bezier equation we have use before and since we are interested in finding the mid points on each side the resulting Mathematica code is very simple.

a = {0, 0};
b = {3, 0};
c = {1, 2};
BAB[t_, a_, b_] := (1 – t) a + t b;
Graphics[{Background -> Black,
{{Thick, Blue, Line[{a, b, c, a}]},
{Thick, Red, Line[{c, BAB[1/2, a, b]}]},
{Thick, Red, Line[{a, BAB[1/2, c, b]}]},
{Thick, Red, Line[{b, BAB[1/2, c, a]}]}
},
Inset[Text[Style["A", White, Italic, Large]], {-.1, 0}],
Inset[Text[Style["B", White, Italic, Large]], {3.1, 0}],
Inset[Text[Style["C", White, Italic, Large]], {1.1, 2.1}]}]

Now for the angle bisectors it is a bit harder. We are going to need some property the bisectors satisfy that will allow us to get the coordinates of the intersection of each bisector with each of the sides. One property that could help us is this one.

Theorem: For a triangle ABC If CQ is the bisector thru the angle ACB then AC/CB=AQ/QB.

Notice we will need to find some distances between sides that are given by coordinates so the function EuclideanDistance will be of help. Since we can easily compute AC/CB we need to find Q in AB such that AQ/QB is equal to AC/CB but this is not difficult to achieve if we use the function Nearest. We can guess the best value of Q by building a table where Q is going from A to B and then we pick the best value that approaches to the ratio AC/CB. We can accomplished that with the following Mathematica Code.

a = {0, 0};
b = {3, 0};
c = {1, 2};
ac = EuclideanDistance[a, c];
bc = EuclideanDistance[b, c];
ab = EuclideanDistance[a, b];
cc = ac/bc;
BAB[t_, a_, b_] := (1 – t) a + t b;
N[cc];
tabl = Table[
EuclideanDistance[a, BAB[t, a, b]]/
EuclideanDistance[b, BAB[t, a, b]], {t, 0.000001, 1, 0.001}];
nearest = Nearest[tabl, N[cc]];
Flatten[Position[tabl, First[nearest]]]

that will give us the value 443 that we will use in conjunction with the 0.001 doing similarly for the other sides of the triangle we get the very compact solution

a = {0, 0};
b = {3, 0};
c = {1, 2};
BAB[t_, a_, b_] := (1 – t) a + t b;
Graphics[{Background -> Black,
{{Thick, Blue, Line[{a, b, c, a}]},
{Thick, Yellow, Line[{c, BAB[443*0.001, a, b]}]},
{Thick, Yellow, Line[{a, BAB[428*0.001, c, b]}]},
{Thick, Yellow, Line[{b, BAB[486*0.001, c, a]}]}
},
Inset[Text[Style["A", White, Italic, Large]], {-.1, 0}],
Inset[Text[Style["B", White, Italic, Large]], {3.1, 0}],
Inset[Text[Style["C", White, Italic, Large]], {1.1, 2.1}]}]

Again this time Nearest comes to the rescue and helps us get the best value from a list of possible values!

Leave a Comment

Filed under geometry, math, mathematics

Tagged as , , , , ,

January 19, 2008 · 9:31 pm

Producing animations with Mathematica 6.0 is as easy as pie

Mathematica 6.0 by Wolfram is a mile stone!

The system allow one to produce with ease animations of mathematical objects like

capture-017f.gif

I was set into animating a cycloid. This is the curve describe by a point on a circle rotating over a line without slipping.

This is actually a very interesting curve that was studied by Galileo, Roberval, Fermat, Descartes, Huygen and Johann Bernoulli in fact he discover this curve is a brachistochrone even more he propose the problem of finding the curve of fastest descent and inaugurating with this problem the variational calculus.

capture-016f.gif

The animation above creates a curve named prolate cycloid one is able to find the meaning of the word prolate in

Websters Dictionary

Prolate:

1. Stretched out; extended; especially, elongated in the direction of a line joining the poles; as, a prolate spheroid; – opposed to oblate.

and also the definition for

Curtate:

1.(Astron.) Shortened or reduced; – said of the distance of a planet from the sun or earth, as measured in the plane of the ecliptic, or the distance from the sun or earth to that point where a perpendicular, let fall from the planet upon the plane of the ecliptic, meets the ecliptic.

and we also have then the curtate cycloid.

you may also consult Mathworld at

cycloid

prolate cycloid

curtate cycloid

Brachistochrone Problem

Tautochrone Problem

if you like to reproduce the above animations using Mathematica 6.0

you could use the following code

Manipulate[
Graphics[
{

{Thick, Yellow, Disk[{x, 1}, 1]},
{Thick, Orange, Circle[{x, 1}, 1]},
{Blue, Thickness[.008],
Line[{{x, 1}, {x - q Sin[x], 1 – q Cos[x]}}]},
{PointSize[Large], Red, Point[{x, 1}]},
{PointSize[Large], Magenta, Point[{x - q Sin[x], 1 – q Cos[x]}]},
If[trace,
{Red, Thick,
Line[
Table[{t - q Sin[t], 1 – q Cos[t]}, {t, 0, x, 0.001}]
]}]

}, AspectRatio -> Automatic, Background -> Black,
ImageSize -> {640, 480}, ImagePadding -> 100, AxesOrigin -> {0, 0},
If[va, Axes -> True, Axes -> {True, False}],
AxesStyle -> Directive[Thick, Orange, If[p < 2 Pi, 24, 12]],
PlotRange -> {{-1, 2 p + .5}, {-.5, 2.3}},
If[ticks, Ticks -> {Range[IntegerPart[2 p + .5]], {1, 2}},
Ticks -> {{None}, {None}}]
], {{x, 0}, 0, 2 p, 0.001}, {{q, 1}, 0.01, 5, 0.001}, {{p, Pi},
0.01, 4 Pi,
0.001}, {trace, {True, False}}, {ticks, {True, False}}, {va, {True,
False}}
]

If you like the above posting you may also enjoy this

Building a Geometric figure with Mathematica

This is a blog posting from www.isallaboutmath.com

6 Comments

Filed under geometry, math, Mathematica, programming

Tagged as , , , , , , ,

December 11, 2007 · 8:10 am

Building a Geometric figure with Mathematica.

Not too long ago I wrote here a small piece on creating beautiful figures, I was trying to explain a non trivial example on how to use METAPOST a system created by John D Hobby to build a geometric figure.

I was reading a blog post by Chris Carlson of Wolfram Research named “Always the Right Time for Mathematica” and decided to give Mathematica a try with the same problem in my prior blog post.

So here is the problem again in case you are too lazy to read my prior posting!

Build the following figure. (The lines in red are the altitudes of the triangle)

trianglefig-1.gif

Well, here is the issue. Mathematica is a general purpose computer system but is not specifically design for graphics like METAFONT, still it should be very straight forward to build some figure like above.Fortunately Mathematica is very rich on Mathematics and this should make the solution easy. We can see multiple path of solution to the problem at hand.

Mathematica provide some native commands that allow one to draw lines and point in such and such Cartesian coordinates. So to draw the triangle ABC with Mathematica we can use the following command.

Graphics[{Thick,Blue,

Line[{{0,0},{3,0},{1,2},{0,0}}],

Black,Inset[Text[Style["A",Italic,Large]],{-.1,0}],

Black,Inset[Text[Style["B",Italic,Large]],{3.1,0}],

Black,Inset[Text[Style["C",Italic,Large]],{1.1,2.1}]

}]

]

Where the Line[] Mathematica function draws the triangle and the Inset places the vertex labels in the figure.

triangulefig2-2.gif

The hard part is figuring out how to find the coordinates for the altitudes feet. If we can find a way to get those coordinates then our problem is solve.

Since we are trying to build the altitudes to the triangle. We need to search for properties the altitudes of a triangle satisfy that will facilitate this construction.

Geometrically we can characterize the altitudes of a triangle as the line segment from a vertex to the opposite side and this segment is perpendicular to that side.

triangulefig2-2min.gif

Other property is: the altitude from a vertex is the minimal length segment we can build from the vertex to the opposite side.

And yet another property: One can build by reflection symmetry with respect to the side the vertex when reflected this way will produce another symmetrically opposite vertex and joining those two by a segment , half that segment will be the altitude.

You may find the proof to the above facts in some geometry book. If not you should try to proof them yourself.

We will discuss first the minimal path approach.

It seems that if we can build some function depending on one variable that give us any of the points between B and C then we shall be able to find the distance between any of those points and the point A. We should be able to repeat the same procedure for the other vertex.

triangulefig2-2line.gif

Well it is good to know the linear Bezier curve equation.

B(t)=C+(B-C)t with t from [0,1]

Since B(t) gives us any point between B and C this shall come very handy in our computations.

Now all we need is to find the distance from B(x) to A and then that should give us a function depending on x. Finding the zeros of first derivative to this function we shall be able to find the values of x such that the distance from B(x) to A is minimal.

This can be performed using the following Mathematica code.

m[v_?MatrixQ]:=Module[{x,a=v[[1]],b=v[[2]],c=v[[3]]},

sol=Solve[D[Simplify[EuclideanDistance[c,BAB[x,a,b]],x>0],x]Š0,x];

{Red,Thick,Line[{c,BAB[First[x/.sol],a,b]}]}

]

So all that remains for us is to draw the graph

BAB[t_,a_,b_]=(1-t) a+t b;

m[v_?MatrixQ]:=Module[{x,a=v[[1]],b=v[[2]],c=v[[3]]},

sol=Solve[D[Simplify[EuclideanDistance[c,BAB[x,a,b]],x>0],x]Š0,x];

{Red,Thick,Line[{c,BAB[First[x/.sol],a,b]}]}

]

l[v_?MatrixQ]:=Module[{a=v[[1,1]],col=v[[1,2]],b=v[[2]]},

{col,Inset[Text[Style[a,Italic,Large]],b]}

]

Module[{a={0,0},b={3,0},c={1,2}},

Graphics[{Thick,Blue,

Line[{a,b,c,a}],

Map[m,{{a,b,c},{a,c,b},{b,c,a}}],

Map[l,{{{"A",Red},{-.1,0}},{{"B",Blue},{3.1,0}},{{"C",Black},{1.1,2.1}}}]

}]

]

This solution is valid for A,B and C that form a non obtuse triangle. Can you see why?

I was still not completely satisfied with this solution. Because I wanted something that did not had to use calculus knowledge. So it is fortunate that Mathematica provide other functions like Nearest[], that allow to find from a list of points the closest point to a given point.

I can produce the list of points easily using the table

Something like

Table[BAB[x,{3,0},{1,2}],{x,0,1,0.01}]

And this

Nearest[Table[BAB[x,{3,0},{1,2}],{x,0,1,0.01}],{0,0}]

Should get me a point sufficiently close to the base of the altitude. We repeat the same procedure for the others so the resulting code looks like this.

BAB[t_,a_,b_]=(1-t) a+t b;

Module[{AA=Flatten[Nearest[Table[BAB[x,{3,0},{1,2}],{x,0,1,0.01}],{0,0}]],

BB=Flatten[Nearest[Table[BAB[x,{0,0},{3,0}],{x,0,1,0.01}],{1,2}]],

CC=Flatten[Nearest[Table[BAB[x,{0,0},{1,2}],{x,0,1,0.01}],{3,0}]]

},

Graphics[{Thick,Blue,

Line[{{0,0},{3,0},{1,2},{0,0}}],

Red,Line[{{0,0},AA}],

PointSize[Large],Orange,Point[AA],

Red,Line[{{1,2},BB}],

PointSize[Large],Orange,Point[BB],

Red,Line[{{3,0},CC}],

PointSize[Large],Orange,Point[CC]

}

]

]

Yet one last solution this time using the symmetry of the vertex with respect to each of the side and finding the middle point.

BAB[t_,a_,b_]=(1-t) a+t b;

Module[{rab=ReflectionTransform[Cross[{3,0}-{0,0}],{0,0}],

rac=ReflectionTransform[Cross[{1,2}-{0,0}],{0,0}],

rcb=ReflectionTransform[Cross[{1,2}-{3,0}],{3,0}]

},

Graphics[{Thick,Blue,

Line[{{0,0},{3,0},{1,2},{0,0}}],

Red,Line[{{1,2},BAB[1/2,{1,2},rab[{1,2}]]}],

Red,Line[{{3,0},BAB[1/2,{3,0},rac[{3,0}]]}],

Red,Line[{{0,0},BAB[1/2,{0,0},rcb[{0,0}]]}]

}]

]

triangulefig2-2symm.gif

In this case we are using Cross[] to get the perpendicular vector to a given vector and ReflectionTransform[] will give us the corresponding transformation Matrix that performs the reflection symmetry that we need. This solution should be valid for any triangle define by the points A,B and C.

We can see from the 3 solutions above, that Mathematica is a very powerful system when it comes to mathematical computation and it is not difficult once one have the mathematical knowledge to use a system like Mathematica to come up with a solution to a given problem.

If you do have Mathematica and like to try your hands at this problem then try solving it this other way by finding the intersection of a line perpendicular to the given side that passes by the vertex opposite to the side. This should be fairly straight forward!

This is a blog posting from www.isallaboutmath.com

2 Comments

Filed under geometry, graphics, math, Mathematica, mathematics

Tagged as , , ,