Tag Info

Hot answers tagged

340

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 ...


188

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 ...


91

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, ...


47

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 ...


29

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}]


24

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 ...


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: ...


18

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. At the moment you can play with solids given by PolyhedronData[... "Faces"]: polyhedronRandomWalk[ PolyhedronData["DuerersSolid", "Faces"] ] ...


17

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 = ...


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

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. ...


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], ...


16

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 ...


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

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

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

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 ...


14

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 = ...


14

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 ...


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

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

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

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

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

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, ...


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

My approach is based on the basic Frenet Trihedron formulas (which were implemented in v.10) and also some basic geometric transformations (matrix rotation and translation). It can be applied to extrude any 2D polygon. 1. Choice of the path I modified a little bit the OP's path for the sake of keeping the 3D graphics simple to view. path[u_] := {Sin[u], ...


13

I have to admit, that I only copied your code and tried it without actually reading what you have done, but I guess I can help to fix at least the second image. What you are after is the "DepthPeelingLayers" settings that you can access with the option inspector: When you raise this number to e.g. 32, the output looks like this This can also be done ...


13

The blue line occurs at the edge of the function, where ϕ wraps from 2π to 0. We can get rid of it by adding BoundaryStyle -> None: SphericalPlot3D[ Abs[.5 + Sin[2 ϕ]/2] Sin[θ] + Abs[.5 + Sin[2 (ϕ + π/2)]/2] Sin[θ], {θ, 0, π}, {ϕ, 0, 2 π}, PlotStyle -> {Opacity[0.3], Yellow}, BoxRatios -> {1, 1, 1/2}, MeshFunctions -> {#3 &}, ...


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], ...



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