Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Graphics and Visualization sorted by activeLabeling several plots by Table at once
https://community.wolfram.com/groups/-/m/t/2248612
Hi, having this command:
Table[Plot3D[u[r, phi, n] // Re, {r, 0, 4}, {phi, 0, 2 Pi}], {n, 0, 5,
1}](*Real Part*)
I would like to label all the six plots that are generated, in one go.
It does not work by the usual AxesLabel. How do I put labels on all axes of the 6 outputs from the given command?
Thanks!Ser Man2021-04-20T14:36:12ZIdentity zones of the "isodynamic map"
https://community.wolfram.com/groups/-/m/t/2249660
&[Wolfram Notebook][1]
[1]: https://www.wolframcloud.com/obj/761d9efb-8716-424f-b97a-791a5ba82054Dan Reznik2021-04-21T17:19:54ZWallace-Bolyai-Gerwien theorem: an example
https://community.wolfram.com/groups/-/m/t/2249637
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=hero_image.gif&userId=20103
[2]: https://www.wolframcloud.com/obj/fecd3de8-591f-4227-9161-da156cadb99cSandor Kabai2021-04-21T16:03:04ZPlot and animate numerically calculated integral?
https://community.wolfram.com/groups/-/m/t/2248138
I want to plot the expression formed from numerically calculated Poisson integrals (aka fundamental solutions of heat equation). I can only get numerical values.
ODE system. We extract the solutions. They will serve as initial conditions in Poisson integrals.
Then we choose parameter, some x and t and integration limits. After that we consctruct the expression. I need to plot and animate `q` for any x and t intervals. By this code I can only get numerical values.
s = NDSolve[{u'[x] == -3 W[x] + x, W'[x] == u[x] - W[x]^3, u[0] == -1,
W[0] == 1}, {u, W}, {x, 0, 200}]
G = First[u /. s]
g = First[W /. s]
\[Epsilon] = 1/10
T = -1/2
X = 10
p1 = -200
p2 = 200
Q1 = 1/( 2 Sqrt[Pi *((T) + 1)*(\[Epsilon])^(2)]) NIntegrate[
Exp[-(Abs[X - \[Xi]])^2/(4*((T) +
1)*(\[Epsilon])^(2))] g[\[Xi]] G[\[Xi]] \
(-1/(2*(\[Epsilon])^2)), {\[Xi], p1, p2}]
Q2 = 1/( 2 Sqrt[Pi *((T) + 1)*(\[Epsilon])^(2)]) NIntegrate[
Exp[-(Abs[X - \[Xi]])^2/(4*((T) +
1)*(\[Epsilon])^(2))] g[\[Xi]], {\[Xi], p1, p2}]
q = (-2 (\[Epsilon])^2 )*(Q1/Q2)
I think it should be very simple, but I am a newbie in Wolfram Mathematica, so I'm sorry if the question is too trivial. Hope to get help.Kevin Bates2021-04-20T06:20:07ZApollonius, Thale's theorem and Orthic triangle
https://community.wolfram.com/groups/-/m/t/2247692
*The largest solid circle is always tangent to three dashed circles, whose diameters coincide with the sides of given triangle respectively.*
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2021-04-19_15-24-09.gif&userId=23928
[2]: https://www.wolframcloud.com/obj/wolfram-community/Published/Apollonius_2.nb
[Original]: https://www.wolframcloud.com/obj/shenghuiy/Published/Apollonius.nbShenghui Yang2021-04-19T21:23:14Z[GIF] Things That Go Bump in the Night (Vibrational mode of the triangle)
https://community.wolfram.com/groups/-/m/t/985795
![Vibrational mode of the equilateral triangle][1]
**Things That Go Bump in the Night**
This is the $(1,2)$ vibrational mode of an equilateral triangle, in the same spirit as [_Drumbeat_][2], which showed the $(1,2)$ mode on the disk, and [_The Band Plays On_][3] and [_Good Vibrations_][4], which showed the nodal lines of a family of vibrational modes on the square and on the disk, respectively.
I found an analytic expression for the vibrational modes of the equilateral triangle in B.R. Seth's paper ["Transverse vibrations of triangular membranes"][5] (available [here][6] for free); he in turn credits Lamé's [_Leçons sur la Théorie Mathématique de L'Elasticité des Corps Solides_][7] from 1866, which is encoded in the following function (as noted in Seth's paper, the $(0,n)$ modes have a somewhat nicer expression in [trilinear coordinates][10], so I wouldn't be surprised if the general $(m,n)$ mode does as well):
EquilateralVibration[m_, n_, {x_, y_}, t_] := Module[
{a = Sqrt[3]/2},
(2 Sin[(m - n) \[Pi] x/a] Cos[2 (m + n) \[Pi] y] -
2 Sin[(2 m + n) \[Pi] x/a] Cos[2 n \[Pi] y] +
2 Sin[(2 n + m) \[Pi] x/a] Cos[2 m \[Pi] y]) Cos[t]
];
From there, it was just a matter of finding a nice presentation; as in, for example, [_Catecoid_][8], I ended up wanting a mesh without the surface and ended up using an idea from [this thread][9] (this time, [@J. M.][at0]'s answer) to get variable-color mesh lines.
Here's the rest of the code:
EqMaxVal = With[
{m = 1, n = 2, x = Sqrt[3]/6, y = 1/2, t = 0.},
EquilateralVibration[m, n, {-(x/2) + (Sqrt[3] y)/2, (Sqrt[3] x)/2 + y/2}, t]
];
With[{m = 1, n = 2},
Manipulate[
Show[
ParametricPlot3D[
Evaluate@Table[
{#[[1]], #[[2]], EquilateralVibration[m, n, {#[[1]], #[[2]]}, t]},
{x, 0, Sqrt[3]/2, Sqrt[3]/32}],
{y, 0, 1},
RegionFunction -> Function[{x, y, z}, x - Sqrt[3] y <= 0 && x/Sqrt[3] + y <= 1],
PlotRange -> {{0, Sqrt[3]/2}, {0, 1}, {-6, 6}}, Boxed -> False,
Axes -> None, PlotStyle -> Thickness[.005],
ColorFunction -> Function[{x, y, z}, ColorData["DeepSeaColors"][(z + EqMaxVal)/(2 EqMaxVal)]],
ColorFunctionScaling -> False]
& /@ {{x, y}, {-(x/2) + (Sqrt[3] y)/2, (Sqrt[3] x)/2 + y/2},
{-(Sqrt[3]/4) + x/2 + (Sqrt[3] y)/2, 1/4 + (Sqrt[3] x)/2 - y/2}},
BoxRatios -> {Sqrt[3]/2, 1, 1/EqMaxVal}, ViewPoint -> {-2, 0, 2},
ImageSize -> {540, 405}, ViewAngle -> \[Pi]/9, Background -> Black],
{t, 0, 2 \[Pi]}]
]
[2]: http://community.wolfram.com/groups/-/m/t/899038
[3]: http://community.wolfram.com/groups/-/m/t/899910
[4]: http://community.wolfram.com/groups/-/m/t/923734
[5]: http://dx.doi.org/10.1007/BF03172447
[6]: http://repository.ias.ac.in/70966/1/15-pub.pdf
[7]: https://archive.org/details/leonssurlathori09lamgoog
[8]: http://community.wolfram.com/groups/-/m/t/928065
[9]: http://mathematica.stackexchange.com/questions/6916/can-the-color-in-meshstyle-be-specified-by-a-colorfunction-such-as-sunsetcolor
[10]: http://mathworld.wolfram.com/TrilinearCoordinates.html
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=tri21r.gif&userId=610054
[at0]: http://community.wolfram.com/web/pleasureoffiguringClayton Shonkwiler2016-12-25T17:59:39ZFractal tetrahedra (Mitsubishi logo in 3D)
https://community.wolfram.com/groups/-/m/t/2248375
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=mit_man.gif&userId=20103
[2]: https://www.wolframcloud.com/obj/06ac2e6c-83ee-411b-b327-850af7589be6Sandor Kabai2021-04-20T14:25:53ZAdding shaded areas to a plot?
https://community.wolfram.com/groups/-/m/t/2248544
f[x_] := 1/Sqrt[2 [Pi]] Exp[-(x^2/9)]
Plot[f[x], {x, -10, 10}]
From here on how can I create the same imagemicheal yousri2021-04-20T11:21:18ZPerspective anamorphism and the ambiguous garage roof
https://community.wolfram.com/groups/-/m/t/2246017
![enter image description here][1]
Looking at the YouTube illusion "[Ambiguous Garage Roof][2]" by the Kokichi Sugihara demonstrates once more that what we see does not always represent reality. His beautiful illusion is based on perspective anamorphism. This kind of anamorphic effect shows a completely deformed image and only needs a specific viewpoint to see the undeformed picture. It would be hard to equal the perfection of Mr. Sugihara but we can explore this type of anamorphic illusions with Mathematica...
![enter image description here][3]
Above is a deformed tubular curve observed by the eye as a circular one. The eye tends to put the observed image in a plane perpendicular to the view direction: the "*view plane*". We take the view plane as parallel with the y-axis and forming the viewing angle phi with the z-axis.
viewPlane = InfinitePlane[{0, 0, 0}, {{0, 1, 0}, {1, 0, Cot[phi]}}];
The "*projection surface*", where the deformed image is located, can be any surface flat or curved. Here are two examples: a sphere (L) and a sinusoidal surface (R). In both cases, the deformed (perspective anamorphic) image is very different but the same circle is seen by the observer if he has the right viewing angle.
![enter image description here][4]
The projection surface we will use here is a folded set of rectangles parallel to the x-axis:
projProfile = {{-2.5, -3.9}, {-1.05, -2.8}, {0, -3.9}, {1.05, -2.8}, \
{2.5, -3.9}};
projectSurface =
RegionUnion[
Rationalize[
Polygon /@
Map[Flatten[#, 1] &,
Transpose[{Partition[Prepend[#, -10] & /@ projProfile, 2, 1],
Reverse /@
Partition[Prepend[#, 10] & /@ projProfile, 2, 1]}]]]];
![enter image description here][5]
The *observed image* consists of image points. Rays, straight lines perpendicular to the view plane, are leaving the image points and will intersect the projection surface to form the *anamorphic image*. This is a function that computes these intersections:
intersect[pt_List] :=
Quiet[First[{x, y, z} /.
NSolve[Element[{x, y, z}, HalfLine[pt, {1, 0, -Tan[phi]}]] &&
Element[{x, y, z}, projectSurface], {x, y, z}]]]
To start with our function, we compute the anamorphic image of a circle in the view plane:
phi = Pi/4;
circle = Table[
Prepend[AngleVector[{0, 2}, {2, t}], 0], {t, 0, 2 Pi, Pi/20}];
virtCircle = RotationTransform[phi, {0, 1, 0}][circle];
rays = HalfLine[#, {1, 0, -Tan[phi]}] & /@ virtCircle;
anaCircle = intersect /@ virtCircle;
Graphics3D[{{Opacity[.35],
InfinitePlane[{0, 0, -4}, {{0, 1, 0}, {1, 0, 0}}]}, {Opacity[.25],
viewPlane, projectSurface[[-1]]}, {Green, Tube[virtCircle, .1],
Tube[anaCircle, .1]}, {AbsoluteThickness[.5], Red, Thin, rays}}]
![enter image description here][6]
The perspective anamorphic image is a curve in the projection plane. It takes different shapes as we change our viewing angle. These shapes range from the original circle over the anamorphic image to the projection surface profile. The observer sees the original circle only if the viewing angle is phi.
![enter image description here][7]
We now look at the garage roof cross section profile. This consists of line segments defined by a list of point coordinates. We chose a roof profile with sections aligned to the projection surface profile:
roofProfile = {{0, -2, 0}, {0, -1.05`, 0.6}, {0, 0, 1}, {0, 1.05,
0.8}, {0, 2, 0}};
ListLinePlot[{projProfile, Rest /@ roofProfile}]
![enter image description here][8]
This is the roof profile and its anamorphic image on the projection surface:
![enter image description here][9]
We are now ready to test the complete garage roof as a set of 4 rectangles between roof profiles at the front and back:
roofBack = roofProfile /. {x_, y_, z_} -> {x, y, z + 4 Cos[phi]};
roofLines =
Transpose[{roofProfile,
roofProfile /. {x_, y_, z_} -> {x + 4, y, z}}];
virtlRoofs =
RotationTransform[phi, {0, 1, 0}] /@ {roofBack, roofProfile};
anaRoofs = Map[intersect, virtlRoofs, {2}];
Graphics3D[{AbsoluteThickness[3],
Map[Line, {roofProfile,
TranslationTransform[{4, 0, 0}] /@ roofProfile, roofLines}]},
Boxed -> False]
![enter image description here][10]
Here is the perceived roof in the view plane and its anamorphic image in the projection surface.
Graphics3D[{{Opacity[.35],
InfinitePlane[{0, 0, -4}, {{0, 1, 0}, {1, 0, 0}}]}, {Opacity[.25],
viewPlane, Opacity[.15], projectSurface[[-1]]}, {Gray,
Tube[virtlRoofs, .03], Tube[Transpose[virtlRoofs], .03]}, {Gray,
Tube /@ anaRoofs, Tube /@ Transpose[anaRoofs]}, {Red,
Map[HalfLine[#, {1, 0, -Tan[phi]}] &, virtlRoofs, {2}]}}]
![enter image description here][11]
This GIF shows a sequence of different viewing directions of the complete garage with its anamorphic roof:
Module[{pts1},
pts1 = RotationTransform[\[Phi], {0, 0, 1}] /@
Join[Flatten[{anaRoof2, anaRoof1},
1], {{3.52, -2., -3.9 - 1}, {7.52, -2., -3.9 - 1}, {3.52,
2., -3.9 - 1}, {7.52, 2., -3.9 - 1}}];
frames =
ParallelTable[
Graphics3D[{FaceForm[LightGray], EdgeForm[Thick],
ph = Polyhedron[
pts1, {{1, 2, 7, 6}, {1, 2, 7, 6} + 1, {1, 2, 7, 6} +
2, {1, 2, 7, 6} + 3, {1, 6, 12, 11}, {5, 10, 14, 13}, {11,
12, 14, 13}}]}, Lighting -> "Neutral", Boxed -> False,
ViewPoint ->
20 {-Cos[\[Phi]], Sin[\[Phi]], Tan[\[Pi]/4]}], {\[Phi], \[Pi]/4,
0, -\[Pi]/160}];
Export[NotebookDirectory[] <> "garage views.GIF", frames,
AnimationRepetitions -> \[Infinity]]];
![enter image description here][12]
Since the projection surface used is a developable surface, we can build the anamorphic garage and its roof out of cardboard paper . This code computes the 2D development of the anamorphic roof...
development[d_, d1_, d2_, d3_, d4_, d5_, z0_ : 40, d0_ : 2.5] :=
Module[{projProfile, devlOrdinates, anchors},
projProfile = {{-d0, d1 - z0}, {-d, d2 - z0}, {0, d3 - z0}, {d,
d4 - z0}, {d0, d5 - z0}};
devlOrdinates =
Prepend[Accumulate@
Apply[EuclideanDistance, Partition[projProfile, 2, 1], {1}], 0];
Interpolation[Transpose@{projProfile[[All, 1]], devlOrdinates},
InterpolationOrder -> 1]]
With[{d1 = 0.1`, d2 = 1.2, d3 = 0.1, d4 = 1.2, d5 = 0.1, d = 1.05},
projProfile = {{-2.5, -3.9}, {-1.05, -2.8}, {0, -3.9}, {1.05, -2.8}, \
{2.5, -3.9}};
roofProfile = {{0, -2, 0}, {0, -1.05`, 0.6}, {0, 0, 1}, {0, 1.05,
0.8}, {0, 2, 0}};
anaOrdinates1 =
development[d, d1, d2, d3, d4, d5] /@ roofBack[[All, 2]];
anaOrdinates2 =
development[d, d1, d2, d3, d4, d5] /@ roofProfile[[All, 2]];
devVertices1 = Transpose@{anaRoof1[[All, 1]], anaOrdinates1};
devVertices2 = Transpose@{anaRoof2[[All, 1]], anaOrdinates2};]
Graphics[{{AbsoluteThickness[3],
Line /@ Transpose[{devVertices1,
devVertices2}]}, {AbsoluteThickness[2], Line[devVertices1],
Line[devVertices2]}}]
![enter image description here][13]
... and we can use it tomake a complete garage from it.
![enter image description here][14]
This collage shows the garage from different view angles. Only a viewing angle from 45 degrees with view plane parallel to the y axis will give he desired, "realistic", view.
![enter image description here][15]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3178introcollage.jpg&userId=68637
[2]: https://www.youtube.com/watch?v=KtA6u1HIqbg
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=5160circleperspectiveeyeflat.png&userId=68637
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10693surfaceexamples.png&userId=68637
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2733projectionsurface.png&userId=68637
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=8907circleperspective.png&userId=68637
[7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ring1.gif&userId=68637
[8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=crosssectionprofiles.png&userId=68637
[9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=profileperspective.png&userId=68637
[10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=roof.png&userId=68637
[11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=roofprojection.png&userId=68637
[12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=garageviews.gif&userId=68637
[13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=development.png&userId=68637
[14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=papergarage.JPG&userId=68637
[15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=collage-3.jpg&userId=68637Erik Mahieu2021-04-17T12:55:02ZPlotting Bessel and Hankel functions on an interval?
https://community.wolfram.com/groups/-/m/t/2247269
![enter image description here][1]
Hello, I try to prepare this function for plotting, but it appeared more difficult than expected. I have written the following code for the three respective functions on the image:
u3[r_, \[Phi]_] := BesselJ[r, n]*Exp[I n phi], {r, 0, 0.5}, {\[Phi], 0, 2 \[Pi]}, {n, 0, 5};
u4[r_, \[Phi]_] := (BesselJ[3*r, n] + BesselY[3*r, n])*Exp[I n phi], {r, 0.5, 1}, {\[Phi], 0, 2 \[Pi]}, {n, 0, 5};
u5[r_, \[Phi]_] := HankelH1[r, n]*Exp[I n phi], {r, 0.5, 10}, {\[Phi], 0, 2 \[Pi]}, {n, 0, 5};
Then I was going to make a function W which sums the three together, and then plot W.
But I get an error over and over again for the Bessel and Hankel formulation. Based on the image given, where zeta 1 and 2 are constants, what is wrong here?
Any help appreciated!
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=9533Untitled.jpg&userId=967554Ser Man2021-04-19T13:17:04ZError in NDSolveValue[ ]: solve the heat equation in 2D?
https://community.wolfram.com/groups/-/m/t/2245405
Dear All, As I'm learning Mathematica, I encountered troubles I can't seem to solve on my own. Here's My code :
Clear["Global`*"];
HeatEq = \!\(
\*SubscriptBox[\(\[PartialD]\), \(t\)]\(T[x, y, t]\)\) == Laplacian[
T[x, y, t],{x, y}];
L = 2; l = 1/2; tmax = 15;
\[CapitalOmega] = Rectangle[{0, 0}, {L, l}];
boundaries = {T[x, y, 0] == 5, T[0, y, t] == 0, T[L, y, t] == 0,
T[x, 0, t] == 0, T[x, l, t] == 0};
boundaries2 = {DirichletCondition[T[x, y, t] == 0, True],
T[x, y, 0] == 5};
sol = NDSolveValue[Join[{HeatEq}, boundaries2],
T, {x, y} \[Element] \[CapitalOmega], {t, 0, tmax}];
Animate[DensityPlot[
sol[x, y, t], {x, y} \[Element] \[CapitalOmega]], {t, 0, tmax}]
As you wander through my code, here is what it is supposed to do :
- Clear all variables previously used, and define the Heat equation in 2 dimensions of space
- Define the rectangle I'm going to cool down.
- Define the boundaries (0°C on the edges, 5°C elsewhere)
- Solve the equation, and get the temperature.
- Plot an animation over time of the cooling
If facing two major issues here. The first one concerns the boundaries conditions. When I use the DirichletCondition, it seems to work "on its own", and yet produces strange results (Where the boundaries are not respected in the simulation). Moreover, As you can see I defined an original boundary condition, and exposing all of them, edge per edge. Yet this one doesn't work, and I really don't understand why. It produces the message : "Boundary condition T[x,1/2,t]==0 is not specified on a single edge of the boundary of the computational domain".
In a second time, I just can't seem to find how you fix a color scale for the integrity of a sequence of density plot. I want to have each color affected to a single value of temperature, for every density plot in a list. And after hours of testing of changes for ColourFunction, I got nothing viable.
I've been searching on the web for hours, and I can't find any solution. Would you kindly help me? I'm looking forward to your answers!
Kind Regards.Alexandre Barboteu2021-04-16T14:39:38ZFitting multi-datasets sharing same parameters?
https://community.wolfram.com/groups/-/m/t/2245184
I have three data sets and three fitting functions.
I want to fit three curves in the same time, because these fitting curves share the fitting parameters.
The figure is one example.
I have three data sets (blue, red, green).
Blue ones should be fitted by the function y=ax^2.
Red ones should be fitted by the function y=ax+b.
Green ones should be fitted by the function y=bx+2a.
In this kind of situation I want to find the best a and b.
normal "Findfit" allows only one functions.
Does anyone have ideas to solve?
![example of data][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=fit.PNG&userId=2245141Masahiro Haze2021-04-16T11:44:59Z