Tag Info

Hot answers tagged

47

If you want to make several sequences of the Collatz function for turning it into a graph, you probably want to memorize, which parts you already calculated. What we try to do is to create a graph like this (image from xkcd) When we would calculate the whole chain for each number until it (hopefully) reaches the end sequence 8,4,1 we do a lot of work over ...


28

This is the Collatz function I know: Collatz[1] := {1} Collatz[n_Integer] := Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0 Collatz[n_Integer] := Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0 Generating a graph from this is easy: Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range[500] // Flatten // Union, ...


15

You could make 2d plot and then convert 2d coord to 3d: data1 = {{1, -5.8}, {2, -5.4}, {3, -0.8}, {4, -0.2}, {5, 4.6}, {1, -6.4}, {2, -5.6}, {3, -0.7}, {4, 0.04}, {5, 1.0}, {1, -6.8}, {2, -4.7}, {3, -1.0}, {4, 0.03}, {5, 2.8}}; data = Table[{1, 1.2 - j*.2} i, {j, 4}, {i, data1}]; Logit[p_] = Log[p/(1 - p)]; Invlogit[x_] = Exp[x]/(1 + Exp[x]); ...


12

First, I defined dd as follows: dd = Entity["Polyhedron", "Dodecahedron"] (* regular dodecahedron *) Probing the properties of this Entity object, I can extract the vertex coordinates (I used Short here to truncate the output): dd["VertexCoordinates"]//Short (* {{-Sqrt[1+2/Sqrt[5]],0,Root[1-20 #1^2+80 #1^4&,3]},<<19>>} *) Now, I can use ...


8

[Edit notice: Updated to allow the setting of the vertical direction of the plot and to fix an error.] Here is a slight generalization of my answer to Isometric 3d Plot. To get an isometric view, we need to construct a ViewMatrix that will rotate a vector of the form {±1, ±1, ±1} to {0, 0, 1} and project orthogonally onto the first two coordinates. ...


8

Solution from @chuy looks really nice. Although I think that it was a little bit of work around because it's a visualization only, but the defined structure doesn't really represent the carved dodecahedron. Here is my approach of carving a dodecahedron pumpkin into pentagrams. First we define a function that makes a pentagram from a pentagon. tau = (2 ...


7

Perhaps, cb[p_, d_] := Cuboid[p, p + d {1, 1, 1}] cn[c_, d_, a_] := Rotate[cb[c + {-d/2, -d/2, 0}, d], a, {0, 0, 1}, c] func[n_, d_] := Graphics3D[{cn[{(1 + d/2) Cos[#], (1 + d/2) Sin[#], 0}, d, #] & /@ Range[Pi/n, 2 Pi - Pi/n, 2 Pi/n], Cylinder[{{0, 0, 0}, {0, 0, d}}]}, Boxed -> False, Axes -> False, Background -> Black] ...


6

We can turn your data into a weighted adjacency graph by using Outer and, well, WeightedAdjacencyGraph: adjgraph = WeightedAdjacencyGraph[Outer[EuclideanDistance, zeroth, zeroth, 1, 1]]; tour = FindShortestTour[adjgraph]; Show[ListPointPlot3D[zeroth, PlotRange -> All, PlotStyle -> Black, Boxed -> False], Graphics3D[{Darker[Red], ...


6

I never saw the OP's mail :( The answer is this: the polyhedron is the ideal polyhedron in the Poincare model of hyperbolic space (so the faces are spheres orthogonal to the unit sphere). To produce the picture, first generate the Platonic solid inscribed in the unit sphere. This can be thought of as the ideal polyhedron in the Beltrami-Klein model of ...


5

I'll provide an starting point for 2D case with single particle. Collisions with other particles are likely to be hard to model (or at least require adding an massive amount of WhenEvent rules if implemented this way), since NDSolve and WhenEvent tend to miss discrete events. Also, 3D case would be considerably more complicated to build; likely to take more ...


5

A shot in the dark: Reverse the orientation. Hey, it works...but I don't know why...??? Graphics3D[Polygon /@ Reverse@*pentagram /@ (vert[[#]] & /@ ind)] A guess at what's happening. I'm not sure of the reason why things work correctly when one coordinate is the same for all vertices and do not work when the plane of the polygon is oblique. In ...


4

The second argument to Dynamic is the key. The code does not keep track of ViewVertical, which will change as the graphics are rotated by the mouse. See the references at the end for some of the answers where I used this technique. Manipulate[ Framed[Graphics3D[{PolyhedronData["Dodecahedron", "Faces"]}, ViewPoint -> Dynamic[3.0 {Cos[θ] ...


4

You can make your own satan-worshiping dodecahedron by using texture. The following is more-or-less based on a Neat Example in the Texture documentation. First, download your favourite evil pentagram image: im = Import["http://vignette1.wikia.nocookie.net/sonicfanchara/images/9/9c/\ Goth-pentagram-devil.gif/revision/latest?cb=20131018174814"]; Then ...


4

To make the 2D figure retain its own colors, independently of the 3D lighting, you could add Glow to the 2D figure. This doesn't add any transparency to the image, and from the question I concluded that you're not really looking for transparency: a = ListPlot3D[{{0, 0, 3}, {0, 1, 3}, {1, 0, 3}, {1, 1, 3}, {0.25, 0.5, 1}, {0.75, 0.5, 1}}]; b = ...


3

Not sure about your definition of structure... In 2D you can get something like this. You need it in 3D? hexPoints = Table[{Cos[2 Pi i/6], Sin[2 Pi i/6]}, {i, 0, 5}]; motion[t_] := {0.2 {Cos[8 t], Sin[5 t]}, {0.5 t, 0}, {0.1 t, 0.3 t}}~ Join~Table[{0, 0}, {i, 1, 3}]; points[t_] := hexPoints + motion[t]; hexSegments[t_] := Partition[#, 2] ...


3

That won't work because Epilog yields 2D graphics primitives, so you can't have plot a moving 3D point using Epilog. Instead, make a separate Graphics3D object and Show both of them. So, for instance defining parPlot = ParametricPlot3D[ {x[t], y[t], f[x[t], y[t]]} , {t, 0, 6 Pi} , PlotRange -> All , PerformanceGoal -> "Quality" ]; we can ...


3

gr = Show[PolyhedronData["Dodecahedron"], Boxed -> False, ImageSize -> 400]; gr2 = gr /. Polygon[x_] :> Polygon[#[[{1, 3, 5, 2, 4}]] & /@ x]; Row[{gr, gr2}]


3

polyhed = PolyhedronData["Dodecahedron", "Polyhedron"]; coords = PolyhedronData["Dodecahedron", "VertexCoordinates"]; lines = Graphics3D[Line[Tuples[coords, 2]]]; Show[polyhed, lines] This is a bit of a cheat, since it actually draws lines connecting all pairs of points on the dodecahedron (take a look at the lines object I define in the code); it's ...


2

Since you didn't exactly specify which points you are interested in, in a first attempt I will just extract all the points that ParametricPlot3D has already calculated to plot your ellipse. points = Cases[uno, Line[{pts__}] -> pts, Infinity]; Show[ uno, Graphics3D[{Red, Line[{{0, 0, 0}, #}] & /@ points}], Graphics3D[{Opacity[0.1], Green, ...


2

A version 10 approach: tnb[g_, t_] := Last@FrenetSerretSystem[g[t], t] func[g_, t_, pc_, s_] := Line[g[t] + # & /@ ((Plus @@ (tnb[g, v] #) & /@ Table[PadLeft[s pc[j], 3], {j, 0, 1, 0.05}]) /. v -> t)] Some test functions: arc[t_] := {-t, t, 1/2 t (8 - t)}; helix[t_] := {Cos[ 2 t], Sin[ 2 t], 0.25 t} f[u_] := BSplineFunction[{-{0.25, ...


2

As The Toad remarked in a (now deleted) comment, I have had some experience with building hexagonal meshes (after seeing previous work by Mark McClure). In fact, this was one of the reasons why I asked this question on generalizing Partition[]; I wanted to be able to construct a GraphicsComplex[] mesh that is easier to manipulate, and uses up less space than ...


2

Probably cleaner: f[x_, y_] := 2 E^(-x^2 - y^2); pos[t_] := {##, f@##} & @@ (t/8 {Cos[t], Sin[t]}) Manipulate[ Show[ Plot3D[f[x, y], {x, -Pi, Pi}, {y, -Pi, Pi}, PlotRange -> All, Mesh -> None, PlotStyle -> Opacity@.5, Boxed -> False], ParametricPlot3D[pos@t, {t, 0, 6 Pi}], Graphics3D@{Red, PointSize -> .05, ...


2

What I would do is make the 2D plot background transparent: b = ImageData@Rasterize[ListLinePlot[{0, 4, 2, 7, 4, 9}], Background -> None]; Then you don't have to have to worry about lighting: Show[{c, a}]


1

The title of your post should be rather something like "Why Import rescales my pdb coordinates ?" The answer is actually in the pdb documentation: Yes, for some reason, when Mma imports a PDB file it automatically converts the atoms coordinates (by default in Angstroms) into picometers, and it explains why you observe a completely different PlotRange ...


1

Setting the lighting in a and then showing a and d in the order a first (order matters) does what I think you want in V10.1. No sure if it will work in V9, but I think it might. a = ListPlot3D[{ {0, 0, 3}, {0, 1, 3}, {1, 0, 3}, {1, 1, 3}, {0.25, 0.5, 1}, {0.75, 0.5, 1}}, PlotStyle -> White, Lighting -> {{"Ambient", RGBColor[1., 0.85, ...


1

I'm not sure what exactly you trying to achieve by using the 2D plot as a Texture. The following code gives me white background: a = ListPlot3D[{{0, 0, 3}, {0, 1, 3}, {1, 0, 3}, {1, 1, 3}, {0.25, 0.5, 1}, {0.75, 0.5, 1}}]; b = ListLinePlot[{0, 4, 2, 7, 4, 9}]; Show[{Graphics3D[{EdgeForm[], {Texture[b], Blue, Polygon[{{0, 0, 0}, {1, 0, 0}, {1, ...


1

I am not sure what you are looking for. You can directly combine Graphics3D using Show command. a = ListPlot3D[{{1, 2, 3}, {0, 0, 0}, {-1, 2, -6}, {5, 5, 4}}]; b = ListLinePlot[{0, 4, 2, 7, 4, 9}]; surfacePlot = Show[{Graphics3D[{EdgeForm[], {Texture[b], Polygon[{{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}}, VertexTextureCoordinates ...


1

The link in the comment is excellent. To plot TNB frame to a point you need to a line/arrow from point ($\vec{r}(t)$ to relevant vector, e.g. $\vec{r}(t)+\vec{T}(t)$. There are some indeterminate points (at piecewise junctions but the desired points are well defined). Just for illustration: tang[t_] := r'[t]/Sqrt[r'[t].r'[t]] norm[t_] := ...


1

In case the 3D printer does indeed require triangles that are arranged more like tetrahedra to give the surface a thickness, you can achieve that using RegionDifference, where the construction of a spherical shell is described as an example: shell = RegionDifference[Ball[{0, 0, 0}, 2], Ball[{0, 0, 0}, 1]]; dg = DiscretizeRegion[shell]; pts = ...


1

The routines in the answer Jens linked to can still be used if you just want to lay slices across your arch. Here is how to use them: arch = Table[{-a, a, 1/2 a (8 - a)}, {a, 0, 8}]; figureEight = First @ Cases[ParametricPlot[ BSplineFunction[{-{0.25, 0.25}, {0.25, 0.25}, {0.25, -.25}, {-.25, 0.25}}, ...



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