Tag Info

Hot answers tagged

335

I have to confess that I see this as a proper challenge, as I am usually quite creative in finding/combining functions to provide a desired behavior. So I will give it another try. which is generated using box[x_, x1_, x2_, a_, b_] := Tanh[a (x - x1)] + Tanh[-b (x - x2)]; ex[z_, z0_, s_] := Exp[-(z - z0)^2/s] and r[z_, x_] := (*body*).4 (1.0 - .4 ...


186

This might get me suspended from the site butt I cannot resist. The shape you are looking for can probably be approximated (depending how anal you want to be about the outcome) by two assymetric probability distributions. The obvious choices would be a Poasson or a log normal distribution. I will use the latter as it is continuous. Now the bummer is that ...


90

Parametric Buttocks Manipulator Manipulate[ ParametricPlot3D[{ (e u^p + (1 + (c - a u) (u - 1)) Cos[t]^2) Sin[t], (e u^p + (1 + (d - b u) (u - 1)) Cos[t]^2) Cos[t], 2 u}, {t, -0.2, Pi + 0.2}, {u, 0, 1.1}, Lighting -> "Neutral", Mesh -> None, PlotStyle -> Directive[Specularity[0], RGBColor[0.92, 0.85, 0.73]], Axes -> False], {{a, ...


28

Well, an unusual question to answer, what about something like this Plot3D[.7*(1 + Tanh[1 - (2*Y^2 + X^2 + X^4)]) - .3*Exp[-X^2/.0025]* Exp[-(Y - .1)^2/.15] - .2*(Exp[-(X - .7)^2/.02]*Exp[-(Y - .0)^2/.08] + Exp[-(X + .7)^2/.02]*Exp[-(Y - .0)^2/.08]), {X, -1, 1}, {Y, -1, 1}]


26

A major point behind the video is that Mobius transformations are simplest when viewed on the sphere. Thus, we'll never actually define a Mobius transformation - we'll do that part on the sphere. Of course, we will need to project back and forth. Here are the stereo graphic projection and it's inverse implemented as compiled functions for speed. This is ...


23

I'm going to describe the workflow with the aid of an example. In this example, my aim is to produce an accurate and beautiful ray traced image of Richmond's minimal surface (the variation with five "petals"). I want to include Mathematica's parameter grid lines and visually emphasize the surface's boundary. See here for a description of Richmond's surface: ...


23

I sometimes use Pov-Ray to render quantum mechanical wave function data, and I wrote a very basic package that exports simple Mathematica plots and call povray to render the graphics, and then imports it into the notebook. In this way, I can render better looking graphics without leaving Mathematica. Moreover, since the graphics are rendered outside ...


17

To long for a comment, but here's one approach, using information readily available in the docs and on this site: First, make a map that wraps a globe changing the Geoprojection to something a bit more useful. img = With[{Δ = 30}, Row[Table[ GeoGraphics[GeoBackground -> GeoStyling["ReliefMap"], GeoRange -> {{-90, 90}, {λ, λ + Δ}}, ...


16

It seems to me that the logo has three semitransparent layers of triangle meshes. One can start with discretized sphere reg = DiscretizeGraphics[Sphere[], MaxCellMeasure -> {"Length" -> 0.8}] Or with Simon's Geodesate. Then the function for disks in 3D is helpful disk[pos_, {nx_, ny_, nz_}, r_, n_: 16] := With[{θ = ArcTan[Sqrt[nx^2 + ny^2], nz], ...


15

plot = StreamPlot[{y, -Sin[x]}, {x, -Pi, Pi}, {y, -3, 3}, Frame -> None, Epilog -> {PointSize -> Large, Point[{{0, 0}, {π, 0}, {-π, 0}}]}, StreamPoints -> Fine, AspectRatio -> 0.8] Try this: First[Normal@plot] /. a_Arrow :> ( a /. {x_Real, y_Real} :> {Cos[x], Sin[x], y} ...


15

I don't see the advantage of using Mathematica to Export a *.pov file at all. I always (try to) export POVRay *.inc include files that are self-contained and require no editing. For Step 3, Mathematica v10.0.2, stores the triangles in triangles = richmond[[1, 2, 1, 1, 6, 1, 1, 1]] For Step 3, I would avoid editing by writing the following Export. ...


15

A crude attempt This is for Mathematica 10+ only. To construct each face, I use an intersection between a unit 3-ball centred at the origin and a pyramid whose base is at infinity and apex is at the origin. Each edge of the pyramid passes through each vertex of the spherical face. The pyramid is given by ConicHullRegion[{origin}, {vertices}]. The ...


14

Something like this perhaps: model = ExampleData[{"Geometry3D", "StanfordBunny"}]; region = BoundaryDiscretizeGraphics[model]; Rasterize @ RegionPlot3D[region, ColorFunction -> (Glow[GrayLevel[#3]] &), ViewPoint -> {0, 0, 10}, Background -> Black, Boxed -> False, Lighting -> None]


14

Bob Hanlon's answer works very well, but in some ways it is the hard way of doing things. If you have v9 or v10, then it is arguably easier to use the legend constructs within it. Similar to his answer, we get the image and element names: img = Import["ExampleData/1PPT.pdb", "Rendering" -> "BallAndStick", ImageSize -> 500]; elements = ...


14

Update: With the function top defined in the original post you can replicate all the cool things you see in rm-rf's answer in the linked Q/A. For example, with a slight modification of gr1, i.e., Graphics3D[hexTile[20, 20] /. Polygon[l_] :> {Directive[Orange, Opacity[0.8], Specularity[White, 30]], Polygon[l], Polygon[{Pi/5, 0} + {-1, 1} # & ...


14

center = Normalize@{1, 2, 3}; point = Normalize@{0, 2, 1}; with minimum of algebra: Show[ ParametricPlot3D[ Evaluate[ N[center + RotationMatrix[t, center].(point - center)]], {t, 0, 2 Pi}], Graphics3D[{Sphere[], Blue, Sphere[{center, point}, .05]}] , PlotRange -> 1.1 ]


13

Nasser gives good standard ControlActive approach. But that by definition looses quality during motion. I just would like to share a trick that avoids that. Most of the time is spent on rendering your bell shape. But it is static. Plane moves but it is simple, so it should not all the time trigger recomputing of static bell shape. You can separate motion of ...


13

ClearAll[roundedCuboidF] roundedCuboidF[hprof_: 10, vprof_: 10, taper_: 1][box_] := ChartElementDataFunction["DoubleProfileCube", "HorizontalProfile" -> hprof, "VerticalProfile" -> vprof, "TaperRatio" -> taper][box] Graphics3D[roundedCuboidF[][{{0, 1}, {0, 1}, {0, 1}}], Boxed -> False] or ...


13

One of the main bottlenecks in your code are the texture you apply on each surface. Try to use texture = {}; in your drawTile function and the graphics should be faster by magnitudes. Additionally, as Yves mentioned, Tubes are a performance killer too. Therefore, a workaround for your problem might be to Rasterize the texture graphics by yourself and use ...


13

You can fix this problem by using the following Option in Graphics3D: Method -> {"CylinderPoints" -> {200, 1}} Adjust 200 to match your requirements. (Indeed the default is 40.) Edit: I don't know exactly what the second parameter does, but using the single parameter form shown in the documentation linked below results in a big slow-down. I ...


13

Here is a bit clumsy (had very little time) approach виа combination of new functionality Entity and regions. (* get the states *) divisions = EntityValue[Entity["AdministrativeDivision", {_, "UnitedStates"}], "Entities"]; (* get polygons of borders *) dat = EntityValue[ divisions, {"Population", "Polygon"}] /. {GeoPosition -> Identity, ...


13

I tried to generalize for (almost) any reasonable closed path without using the fact that your current path is contained in a known plane. r = 1; R = 2.5*r; a = .8; b = .4; torusF[R_, r_, u_, v_] := {(R + r Cos@v) Cos@u, (R + r Cos@v) Sin@u, r Sin@v} pathF[R_, r_, aa_, bb_, w_] := torusF[R, r, u, v] /. {u -> bb Cos@w, v -> aa Sin@w} t = ...


13

image = Import["http://i.stack.imgur.com/6YRfK.jpg"]; If you want to use your f, uRange and vRange as the arguments to ParamatricPlot3D, you need to wrap each with Evaluate: f = {u, Sin[v]*(u^3 + 2 u^2 - 2 u + 2)/5, Cos[v]*(u^3 + 2 u^2 - 2 u + 2)/5}; uRange = {u, -2.3, 1.3}; vRange = {v, 0, 2 Pi}; ParametricPlot3D[Evaluate@f, Evaluate@uRange, ...


13

Using the same initialization code as Taiki: origin = {0, 0, 0}; points = {{-0.9207, -0.3896, 0.0091}, {-0.8272, 0.5077, -0.2399}, {0.2544, -0.3511, 0.901}, {0.351, 0.6527, 0.6712}, {0.5436, -0.6326, -0.5513}, {0.6016, 0.2317, -0.7643}}; fs = {{1, 3, 5}, {1, 2, 4, 3}, {1, 2, 6, 5}, {3, 4, 6, 5}, {2, 4, 6}}; faces = points[[#]] & /@ fs; Then ...


13

Usage Just use this function with any polyhedron in in form: GraphicsComplex[pts_, Polygon[vertices_, ___]]. When I find time and motivation maybe I will add more DownValues so it can be more general. Atm you can play with solids given by PolyhedronData[... "Faces"]: polyhedronRandomWalk[ PolyhedronData["DuerersSolid", "Faces"] ] It ...


12

You may try this eq = And @@ (Total[({x, y, z} - #)^2] > 1/2 & /@ Select[Tuples[{-1, 0, 1}, 3], Mod[Total[#], 2] == 0 &]) RegionPlot3D[eq, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, Mesh -> None, PlotPoints -> 150] Notice there are small holes at points of contact between the spheres. You can also "bound" by a sphere instead of a ...


12

Mostly the same as @SimonWoods, but it runs on V9: data = ExampleData[{"Geometry3D", "StanfordBunny"}, "VertexData"]; ListSurfacePlot3D[data, MaxPlotPoints -> 50, ColorFunction -> (Glow[GrayLevel[#3]] &), Mesh -> None, Background -> Black, Boxed -> False, ViewPoint -> {0, 0, 10}, Axes -> False]


12

Using Composition I can apply RotationTransform, TranslationTransform , ShearingTransform one after the other. Graphics3D[{ Opacity[1] , Red , Arrow[{{0, 0, 0}, {1, 0, 0}}] , Green , Arrow[{{0, 0, 0}, {0, 1, 0}}] , Blue , Arrow[{{0, 0, 0}, {0, 0, 1}}] , Opacity[0.2] , GeometricTransformation[Cuboid[-{1, 1, 1}/4, {1, 1, 1}/4], ...


12

Conway's game of life is a 2D, two-state, outer totalistic, cellular automaton. I guess the natural thing is to try such CAs in 3D. Here's the evolution of one such CA: twos = Array[2 &, {3, 3}]; twosWithOne = twos; twosWithOne[[2, 2]] = 1; outerTotalisticCA3D[ruleNumber_Integer, duration_Integer, init_List] := CellularAutomaton[ {ruleNumber, ...


12

Just a combination of Graphics3D objects Graphics3D[{Scale[ Cylinder[{{0, 0.9, -0.5}, {2, 0.7, 0.5}}, 0.75], {1, 0.95, 1}], Scale[Cylinder[{{0, -0.9, 0}, {2, -0.7, 0}}, 0.75], {1.0, 0.95, 1}], Scale[Cylinder[{{-1.1, 0, 0}, {-0.3, 0, 0}}, 1.5], {1, 1, 0.5}], Scale[Sphere[{0., 0.75, -0.25}, 1.05], {1.1, 0.9, 1}], Scale[Sphere[{0., -0.75, 0.1}, 1.05], {1.1, ...



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