Manipulate [ Show [graphics ]]]
in [Mathematica]
|
Prev: Trouble with coupled quadratic equations where the
Next: Symbolize, subscripted variables, and annoying TraditionalForm
From: leigh pascoe on 12 Mar 2010 07:09 Dear Experts, I am plotting some frequencies and a function in a 3D graph. Each frequency is a real number between [0,1], so I am plotting these in a tetrahedron where the frequency is measured along the sides of the unit tetrahedron. The basic tetrahedral axes and transformations are encoded as follows: First define a linear transform to put points in tetrahedral coordinates and draw the tertrahedral box v1 = {0, 0, 0}; v2 = {1, 0, 0}; v3 = {0, 1, 0}; v4 = {0, 0, 1}; lintrans[v_] := Module[{mat = {{1/2, -1/2, 0}, {-1/(2*Sqrt[3]), -1/(2*Sqrt[3]), 1/Sqrt[3]}, {-Sqrt[2/3], -Sqrt[2/3], -Sqrt[2/3]}}, tr = {0, 0, Sqrt[2/3]}}, mat.v + tr] tetrahedron[{v1_, v2_, v3_, v4_}] := {Line[{v1, v2, v3, v1}], Line[{v1, v2, v4, v1}], Line[{v1, v4, v3, v1}], Line[{v4, v2, v3, v1}]}; g2 = Graphics3D[{Thickness[0.01], tetrahedron[ lintrans /@ {{0, 0, 0}, {1, 0, 0}, {0, 1, 0}, {0, 0, 1}}]}]; Then plot the surface x2*x3==x1*(1-x2-x3-x1) g1 = ParametricPlot3D[ lintrans[{x1, x2, (x1 - x1^2 - x1*x2)/(x1 + x2)}], {x1, 0, 1}, {x2, 0, 1}, Mesh -> All, WorkingPrecision -> 20]; and show these together Show[g1, g2, PlotRange -> {0, 1}] The first problem I have is that the function is not collinear with the axis of the tetrahedron as it should be (rounding error?), although it is basically correct. It is necessary to rotate the graphic to see the full bend of the surface in 3D. Is there a way to correct this minor imperfection? Then I would like to plot some individual points in the same graphic. Eventually these points will be complicated functions of parameters that can be Manipulated to show the movement of the points relative to the curve as the parameters are changed. I tried for example g3 = ListPointPlot3D[ lintrans /@ {{.2, .3, .4}, {.2, .5, .1}, {.3, .7, ..1}, {.4, .5, .1}}]; Show[g1, g2, g3, PlotRange -> {0, 1}] which plots the points inside the tetrahedron. Firstly, how can I make the individual points more visible (e.g. red filled circles)? A 3D point would be nice. When I try to manipulate this graphic it doesn't work g3 := ListPointPlot3D[ lintrans /@ {{.2*w1, .3, .4}, {.2, .5*w2, .1}, {.3, .7, .1* w3}, {.4, .5*w1, .1}}]; Manipulate[ Show[g1, g2, g3, PlotRange -> {0, 1}], {w1, 0, 1}, {w2, .2, .9}, {w3, .4, .5}] In fact I don't see the points at all. How do I make these points display dynamically? Finally, it is possible that the individual points will be complex for some parameter values. Can I conditionally make these disappear inside a Manipulate statement? Thanks for any suggestions. Leigh
From: leigh pascoe on 16 Mar 2010 05:44
Le 12/03/2010 19:28, Daniel Lichtblau a =E9crit : > leigh pascoe wrote: >> Dear Experts, >> >> I am plotting some frequencies and a function in a 3D graph. Each >> frequency is a real number between [0,1], so I am plotting these in a >> tetrahedron where the frequency is measured along the sides of the >> unit tetrahedron. The basic tetrahedral axes and transformations are >> encoded as follows: >> >> First define a linear transform to put points in tetrahedral >> coordinates and draw the tertrahedral box >> v1 == {0, 0, 0}; >> v2 == {1, 0, 0}; >> v3 == {0, 1, 0}; >> v4 == {0, 0, 1}; >> lintrans[v_] :== >> Module[{mat == {{1/2, -1/2, 0}, {-1/(2*Sqrt[3]), -1/(2*Sqrt[3]), >> 1/Sqrt[3]}, {-Sqrt[2/3], -Sqrt[2/3], -Sqrt[2/3]}}, >> tr == {0, 0, Sqrt[2/3]}}, mat.v + tr] >> >> tetrahedron[{v1_, v2_, v3_, v4_}] :== {Line[{v1, v2, v3, v1}], >> Line[{v1, v2, v4, v1}], Line[{v1, v4, v3, v1}], >> Line[{v4, v2, v3, v1}]}; >> g2 == Graphics3D[{Thickness[0.01], >> tetrahedron[ >> lintrans /@ {{0, 0, 0}, {1, 0, 0}, {0, 1, 0}, {0, 0, 1}}]}]; >> >> Then plot the surface x2*x3====x1*(1-x2-x3-x1) >> >> g1 == ParametricPlot3D[ lintrans[{x1, x2, (x1 - x1^2 - x1*x2)/(x1 + >> x2)}], {x1, 0, 1}, {x2, 0, 1}, Mesh -> All, WorkingPrecision -> 20]; >> >> and show these together >> >> Show[g1, g2, PlotRange -> {0, 1}] >> >> The first problem I have is that the function is not collinear with >> the axis of the tetrahedron as it should be (rounding error?), >> although it is basically correct. It is necessary to rotate the >> graphic to see the full bend of the surface in 3D. Is there a way to >> correct this minor imperfection? >> >> Then I would like to plot some individual points in the same graphic. >> Eventually these points will be complicated functions of parameters >> that can be Manipulated to show the movement of the points relative >> to the curve as the parameters are changed. I tried for example >> >> g3 == ListPointPlot3D[ lintrans /@ {{.2, .3, .4}, {.2, .5, .1}, {.3, >> .7, .1}, {.4, .5, .1}}]; >> Show[g1, g2, g3, PlotRange -> {0, 1}] >> >> which plots the points inside the tetrahedron. >> >> Firstly, how can I make the individual points more visible (e.g. red >> filled circles)? A 3D point would be nice. >> >> When I try to manipulate this graphic it doesn't work >> >> g3 :== ListPointPlot3D[ >> lintrans /@ {{.2*w1, .3, .4}, {.2, .5*w2, .1}, {.3, .7, .1* >> w3}, {.4, .5*w1, .1}}]; >> Manipulate[ >> Show[g1, g2, g3, PlotRange -> {0, 1}], {w1, 0, >> 1}, {w2, .2, .9}, {w3, .4, .5}] >> >> In fact I don't see the points at all. How do I make these points >> display dynamically? >> >> Finally, it is possible that the individual points will be complex >> for some parameter values. Can I conditionally make these disappear >> inside a Manipulate statement? >> >> Thanks for any suggestions. >> >> Leigh >> > > To respond to your first issue, it is definitely not rounding error. > > Not sure if it matters, but your transformation matrix is not > orthogonal. You need a factor of 1/2 for the last row to make it that > way. > > As for the mapping of the surface, you allow both x1 and x2 to extend > to 1, but your tetrahedron effectively restricts their sum to 1 (if I > understand correctly). Try instead > > g1 == ParametricPlot3D[ > UnitStep[1 - x2 - x1]* > lintrans[{x1, x2, (x1 - x1^2 - x1*x2)/(x1 + x2)}], {x1, 0, > 1}, {x2, 0, 1}, Mesh -> All, WorkingPrecision -> 20]; > > Daniel Lichtblau > Wolfram Research > > > > Thank you for the suggestion. This is really much nicer, but one edge now lies slightly inside the tetrahedral axis. The surface is in fact defined along the axes and should be continuous with them. What I am trying to plot is the surface condition x2*x3-x1*(1-x1-x2-x3)====0. This can be done by solving for x3 in terms of the other variables, as shown above, but that leaves undefined the points where x1and x2 are both 0. Within the tetrahedron x1, x2, x3 can take any value in [0,1] but subject to the restriction x1+x2+x3<==1. Similarly on the surfaces of the= tetrahedron one of the coordinates will be zero, while the other two may vary between [0,1] subject to the restriction that their sum is <==1, while on the axes two of the coordinates are zero with the third being restricted to the interval [0,1]. Perhaps I need some sort of ImplicitParamatricPlot3D, but this doesn't seem to exist in Mathematica... All of this is of course just a fudge to represent, in 3 dimensions, 4 frequencies that must sum to one . I was able to display the individual points and the surface together by putting the ListPointPlot3D command directly inside the Manipulate function, rather than defining it as a delayed function (not very elegant but at least it works). The plotted points then respond to the slider bars and have the required appearance. Manipulate[ Show[g1, g2, ListPointPlot3D[ lintrans /@ {{.2*w1, .3, .4}, {.2, .5*w2, .1}, {.3, .7, .1*w3}, {.4, ..5*w1, .1}}, PlotStyle -> Directive[PointSize[.03], Red]], PlotRange -> {0, 1}], {w1, 0, 1}, {w2, .2, .9}, {w3, .1, .8}] Thanks again Leigh .. |