Hot answers tagged

51

Edit: Added the reversal and some refinements ω = 1; posP[t_, φ_] := Sin[ω t + φ] {Cos[φ], Sin[φ]} posL[φ_] := {-#, #} &@{Cos[φ], Sin[φ]} Animate[ Graphics[{PointSize[0.02], Table[{Black, Line[posL[π i]], Hue[i], Point[posP[t, π i]]}, {i, 0, 1, 1/(3π-Abs[9.43-t])}] }, PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}} ], {t, 0, 6π, 0.2} ]


40

I'd like to expand on Quantum_Oli's answer to give an intuitive explanation for what's happening, because there's a neat geometric interpretation. At one point in the animation it looks like there is a circle of colored dots moving about the center, this is a special case of so called hypocycloids known as Cardano circles. A hypocyloid is a curve generated ...


23

What you need to do here is to generate a ParametricPlot to give the 2D goat/silo problem, and then we can rotate it with RevolutionPlot3D. From reading the page on MathWorld, we can see that we need to make a circle involute to describe the portion of the area where the goat's circle is limited by the presence of the silo. In Cartesian coordinates, this ...


14

moon = Import[ "https://upload.wikimedia.org/wikipedia/commons/f/f0/Full_Moon_as_\ Seen_From_Denmark.jpg"] Here are two ways to get something like that: with Texture or with ColorFunction Texture: pic = ImageCrop @ ImageResize[ColorConvert[moon, "Grayscale"], Scaled@.3] Worse quality than is possible with this image but I had to make it smaller ...


13

Here is an approach based on direct construction of Image3D from ImageData. The basic idea is taken from the subsection "Volume Creation" of the section "Scope" on the Documentation page for Image3D, some other ideas are from the answer by Kuba: moon = Import[ "https://upload.wikimedia.org/wikipedia/commons/f/f0/Full_Moon_as_Seen_From_Denmark.jpg"]; ...


8

So I can't seem to find a nice plottable form for the normal modes of an elastic sphere, if you can please let me know. This talks about the vector spherical harmonics, and people often show sketches of the displacements involved in the fundamental and overtones for the spheroidal and toroidal modes, but I don't find plottable equation forms for them (or I ...


8

You can add transparency to a color function. No need to make the whole plot to have one color. Show[SliceContourPlot3D[-z, z == fe[m, p], {m, -3, 3}, {p, -3, 3}, {z, -6, 6}, ColorFunction -> Function[{z}, Opacity[0.4, #] &@ColorData["TemperatureMap"][z]], ContourStyle -> None]]


8

You can use ContourShading with Directives to achieve both. α = 1; β = 1; tmp = 0.1316; ρ = 0.01; t = -1.5; fe[m_, p_] := 1/2*(t - 1)*p^2 + 1/4*p^4 + (1/2*α^2*β*m^2*(t - tmp)) + 1/4 α^2*(β)*(m^4) + 1/2*(ρ*(p^2)*(m^2)) ; SliceContourPlot3D[-z, z == fe[m, p], {m, -3, 3}, {p, -3, 3}, {z, -6, 6}, ContourShading -> Directive[Red, ...


7

From Version 10.2 upwards we can now use SliceContourPlot3D and SliceDensityPlot3D to achieve this: SliceContourPlot3D[x + Sin[5 z] + y^2, "CenterCutBox", {x, -0.5, 0.5}, {y, -0.5, 0.5}, {z, -0.5, 0.5}, Boxed -> False, Axes -> False, Contours -> 20, ColorFunction -> Hue] You can increase Contours to 10 or higher to ...


6

Update: Speaking of "pie slices", you can use SectorChart3D directly as follows: ClearAll[sliceF] sliceF[opts : OptionsPattern[]][x_, y_, r_: {0, 2}, h_: 2] := SectorChart3D[{{(y - x) Degree, r[[2]], h}, {(360 - y + x) Degree , r[[2]], h}}, SectorOrigin -> {{x Degree}, r[[1]]}, opts] sliceF[BoxRatios -> 1, Axes -> True][30, 70] ...


6

I'm not sure what kinds of calculations you'll want to do on the intersection line; but to get a sample of points on the intersection line, you could use DiscretizeRegion and MeshCoordinates: f[x_, y_, z_] = x^4 + y^4 + z^4 - 1; g[x_, y_, z_] = x - 2 y + z - 2; ContourPlot3D[{f[x, y, z] == 0, g[x, y, z] == 0}, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, ...


5

One way is to use MeshFunctions to plot F[..] = 0: MeshFunctions -> {Function[{x, y, z, s1, s2}, Cos[s1] + Cos[s2] + Cos[s1] Cos[s2] + 1]}, Mesh -> {{0}}, MeshStyle -> {Directive[Thick, Lighter@Blue]} The function F is the mesh function Function[{x, y, z, s1, s2}, Cos[s1] + Cos[s2] + Cos[s1] Cos[s2] + 1] where the equation F[..] == 0 is ...


4

Perhaps not entirely what you'd want but for fun sake: Example: SliceContourPlot3D[-z, z == fe[m, p], {m, -3, 3}, {p, -3, 3}, {z, -6, 6},ContourShading -> None]; Output: Reference: ContourShading


4

See if the following can give you a starting point: radius = 3; height = 3; angle = 30 Degree; RegionPlot3D[ x^2 + y^2 <= radius^2 && x >= 0 && 0 <= y <= ArcTan[angle] x && 0 <= z <= height, {x, 0, 4}, {y, 0, 4}, {z, 0, height}, Mesh -> None, PlotPoints -> 100, PlotRangePadding -> {Scaled[0.05], ...


4

For version 9: f[x_, y_, z_] := x^3 + y^2 - z^2 g[x_, y_, z_] := x^2 + y^2 + z^2 - 1 cp3d = ContourPlot3D[{f[x, y, z]==0, g[x, y, z]==0}, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, BoundaryStyle -> {1 -> None, 2 -> None, {1, 2} -> {Thick, Red}}, ContourStyle -> Opacity[.7], Mesh -> None, ImageSize -> 400]; points = Cases[Normal@cp3d, ...


4

I agree on two counts: X3D is a logical export format, but Mathematica's X3D support is, at best, limited. Fortunately, the correspondence between Mathematica's GraphicsComplex and X3D is close enough that it is quite easy to roll your own exporter. To do so, let's begin with your own plot. We'll then extract out the primitives and directives that are ...


3

Here are two additional approaches, one uses RegionIntersection, the other uses DiscretizeGraphics: f[x_, y_, z_] = x^4 + y^4 + z^4 - 1; g[x_, y_, z_] = x - 2 y + z - 2; regF = ImplicitRegion[f[x, y, z] == 0, {x, y, z}]; regG = ImplicitRegion[g[x, y, z] == 0, {x, y, z}]; reg = DiscretizeRegion @ RegionIntersection[regF, regG] MeshCoordinates @ reg // ...


3

Assuming this is not just ContourPlot. Just minor changes: α = 1; β = 1; tmp = 0.1316; ρ = 0.01; t = -2; fe[m_, p_] := 1/2*(t - 1)*p^2 + 1/4*p^4 + (1/2*α^2*β*m^2*(t - tmp)) + 1/4 α^2*(β)*(m^4) + 1/2*(ρ*(p^2)*(m^2)) Now, Show[SliceContourPlot3D[ z - fe[m, p], {z == -4}, {m, -2.05216, 2.05217}, {p, -2.35669, 2.35669}, {z, -5, 0}], ...


3

Just to record an answer to the question, here are two possible ways of defining a cone: c1 = Cone[{{1, 1, 1}, {0, 0, 0}}, Norm[{1, 1, 1}] Tan[0.186393]]; c2 = {CapForm["Butt"], Tube[{{1, 1, 1}, {0, 0, 0}}, {Norm[{1, 1, 1}] Tan[0.186393], 0}]}; Table[ Graphics3D[{Thick, Line[{{-1, -1, -1}, {1, 1, 1}}], Line[{{1, -1, -1}, {-1, 1, 1}}], Line[{{-1, ...


3

One or both of the following plots may be what you looking for. α = 1; β = 1; Tmp = 0.1316; ρ = 0.01; T = -2; FreeEnergy = 1/2*(T - 1)*P^2 + 1/4*P^4 + (1/2*α^2*β*M^2*(T - Tmp)) + 1/4 α^2*(β)*(M^4) + 1/2*(ρ*(P^2)*(M^2)); Plot[Evaluate[FreeEnergy /. M -> 0], {P, -2.35669, 2.35669}] Plot[Evaluate[FreeEnergy /. P -> 0], {M, -2.05216, ...


3

In this case, the KnotData evaluates directly to a parametric curve, KnotData["Trefoil", "SpaceCurve"] (* {Sin[#1] + 2 Sin[2 #1], Cos[#1] - 2 Cos[2 #1], -Sin[3 #1]} & *) so that no sampling is necessary. ParametricPlot3D[ KnotData["Trefoil", "SpaceCurve"][t], {t, 0, 2 \[Pi]}, PlotRange -> All, Axes -> None, Boxed -> False, ViewPoint ...


2

You can move the patch around the left torus to see where it's mapped on the right torus by func. func = Function[{u, v}, {u + v, 2 u}]; func = Function[{u, v}, {u + v, 2 u}]; nmesh = 10; mesh = {(-0.5 + Range[-nmesh, 2 nmesh])/nmesh, (-0.5 + Range[-nmesh, 2 nmesh])/nmesh}; param = Function[{u, v}, {(2 + Cos[2 π v]) Sin[2 π u], (2 + Cos[2 π ...


2

I am not sure how well the following is answering your question. Here is the general idea: Write a function that finds distances from an arbitrary point to each of the lines defined by the polygons sides (line segments). Use some sort of dynamic manipulation to plot the most interesting point-segment distances. I assume it is important to stay in 3D, ...


2

If you just want to make a plot of the region in question, this is good RevolutionPlot3D[{{x, (x + 8)^4}, {x, 8 x + 64}}, {x, -8, -6}, {th, 0, 2 π}, Mesh -> None, Axes -> False, Boxed -> False, BoxRatios -> {1, 1, .3}] But try as I might, I can't seem to find a way to get the volume of the region using Volume - this would involve ...


2

Here's a symbolic-algebraic way, based on the cylindrical algebraic decomposition (CAD) that Reduce computes. (* Disk/Washer method *) Clear[x, y, z]; eqns = {y == (x - 2)^4, 8 x - y == 16}; axis = x == 10; {depV} = Variables[Subtract @@ axis]; {indepV} = Complement[{x, y}, {depV}]; vars = {indepV, depV}; components = Map[ Reduce[#, vars] &, (* ...


2

This is a bit late, but I only recently learned of the "AdjacentFaceIndices" property in PolyhedronData[], and this is what led me to figure out how to cleanly deal with generating the required triangles. First, generate the extra pentagram points from the original dodecahedron's vertices: np = First @ Normal[PolyhedronData["Dodecahedron", "Faces"]] /. ...


2

Try this With[{color = RGBColor[0.95, 0.93, 0]}, Show[ RegionPlot3D[ z <= -2 x^2 - 2 y^2 && z <= 8 x + y - 20, {x, -10, 10}, {y, -10, 10}, {z, -100, 0}, PlotStyle -> color, Mesh -> None], RegionPlot3D[ x^2 + y^2 <= 50, {x, -10, 10}, {y, -10, 10}, {z, -500, -100}, PlotStyle -> color, ...


2

There is a problem with syntax in VertexRenderingFunction, can't explain more because I don't know what was the goal there. With[{ atoms = ChemicalData["Valeraldehyde", "VertexTypes"] } , GraphPlot3D[ ChemicalData["Valeraldehyde", "EdgeRules"], EdgeRenderingFunction -> ( { Specularity[White, 100], Cylinder[#1, .05] }& ...


2

If you have OpenBabel installed, you can use its built-in structure optimization methods to generate 3D structures from SMILES structure format provided by Mathematica: Import["!obabel -:\"" <> ChemicalData["Valeraldehyde", "SMILES"] <> "\" -o xyz --gen3d --conformer --nconf 50 --score energy --weighted", "XYZ"] Unfortunately it does not ...


1

I've always wished the moon was more habitable. Starting from the OPs picture: moon = ColorConvert[ Import["https://upload.wikimedia.org/wikipedia/commons/f/f0/Full_\ Moon_as_Seen_From_Denmark.jpg"], "Grayscale"]; ReliefPlot[ImageData[moon], ColorFunction -> "GreenBrownTerrain"]



Only top voted, non community-wiki answers of a minimum length are eligible