Tag Info

Hot answers tagged

25

Yet another method: Let us calculate values of function on appropriate rectangular grids, which we will convert to textures (1 pixel = 1 value). Interpolation between pixels is built-in. f = 2 #1^2 + 2 #2^2 + #3^2 + #1 #2 &; PolyhedronData["Cube"] // N // Normal // toTriangles // texturize[f, 50, Hue, Lighting -> "Neutral", Axes -> True] ...


22

One can also use MeshFunctions: Clear[f]; f = {x, y, z} \[Function] x + Sin[5 z] + y^2; cube = PolyhedronData["Cube", "RegionFunction"]; mesh = 15; RegionPlot3D[cube[x/2, y/2, z/2], {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, MeshFunctions -> {f}, Mesh -> mesh, MeshShading -> ColorData["Rainbow"] /@ Range[0, 1, 1/(mesh + 1)], PlotPoints -> 50, ...


17

Something to get you started? f[{x_, y_}] := -Cos[x] x^2 - y^2 xy = First[ ContourPlot[f[{x, y}], {x, -1, 1}, {y, -1, 1}]] /. {x_?AtomQ, y_?AtomQ} :> {x, y, 1}; xz = First[ ContourPlot[f[{x, y}], {x, -1, 1}, {y, -1, 1}]] /. {x_?AtomQ, y_?AtomQ} :> {x, -1, y}; yz = First[ ContourPlot[f[{x, y}], {x, -1, 1}, {y, -1, 1}]] /. ...


17

I don't have time to do the full-monty on the question, but perhaps this little-known functionality might be of use: Needs["MultivariateStatistics`"] (* fake some data *) data = RandomVariate[BinormalDistribution[{20, 20}, {5, 5}, .75], 500]; Show[{ListPlot[data, PlotRange -> Automatic, AspectRatio -> 1], Graphics[{Red, ...


12

Another way using textures: v = {{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}, {-1, -1, 1}, {1, -1, 1}, {1, 1, 1}, {-1, 1, 1}}; idx = {{1, 2, 3, 4}, {1, 2, 6, 5}, {2, 3, 7, 6}, {3, 4, 8, 7}, {4, 1, 5, 8}, {5, 6, 7, 8}}; vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}; f[{x_, y_, z_}] := x^2 - y^2 - z^2 q[j_] := MapThread[ Prepend, {{Min@#, Max@#} & ...


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

The color function used is the standard "jet" colormap that is ubiquitous in figures generated using MATLAB. This answer (by J. M.) has an exact ColorFunction for reproducing the jet colormap: jet[u_?NumericQ] := Blend[ {{0, RGBColor[0, 0, 9/16]}, {1/9, Blue}, {23/63, Cyan}, {13/21, Yellow}, {47/63, Orange}, {55/63, Red}, {1, RGBColor[1/2, 0, 0]}}, ...


11

For example: Manipulate[ ContourPlot3D[Norm[{x, y, z}]^ (3 + w), {x, 0, 1}, {y, 0, 1}, {z, 0, 1}, ContourStyle -> (Directive[Opacity[.3, #]] & /@ {Red, Green, Cyan}), Contours -> {1, 2, 3}, MeshStyle -> None], {w, 0, 1}]


11

Updated with working code (tnx @rasher @mfvonh) Let’s start by importing Fisher’s classic dataset on Iris flower measurements… Fisher’s classic paper can be found here…. Needs["MultivariateStatistics`"] (*Import Data*) irisData = Import["http://aima.cs.berkeley.edu/data/iris.csv", "CSV"]; plotLabels = {"Sepal.Length", "Sepal.Width", "Petal.Length", ...


10

There is a brute-force method: f = 2 #1^2 + 2 #2^2 + #3^2 + #1 #2 &; surface = PolyhedronData["Cube", "RegionFunction"][x, y, z]; r = 0.6; RegionPlot3D[surface, {x, -r, r}, {y, -r, r}, {z, -r, r}, PlotPoints -> 35, NormalsFunction -> None, Mesh -> None, ColorFunction -> (Hue@f[##] &), ColorFunctionScaling -> False] surface ...


10

Generally - arbitrary-angle layout: Rotate[ ... /. x_Framed -> Rotate[x, -angle], angle] Now you can do it like this: Rotate[ToExpression@ToBoxes@TreeForm[a + b^2 + c^3 + d] /. x_Framed -> Rotate[x, -Pi/2], Pi/2] Or like this: P.S. ========================= Manipulate code for the record Manipulate[Show[Rasterize@ ...


9

A tomographic approach: m = Import["http://www.datafilehost.com/get.php?file=3c69e895", "Data"]; getColor[s_List] := Replace[s, {0 -> Black, 1 -> Red, 2 -> Darker[Green], 3 -> Brown, 4 -> Blue, 5 -> Orange, 6 -> Cyan, 7 -> Magenta, 8 -> Yellow, _ -> White}, 1]; nfx = Nearest[m[[All, 1]] -> m]; Manipulate[ ...


9

I found a way to do this thanks to the more simple question I posted here: Wrapping ArrayPlot or MatrixPlot around a circle but it takes a very long time to compute. So I will post the answer but I hope someone will post a faster solution. cwd = ContinuousWaveletTransform[data, GaborWavelet[6], {4, 12}, WaveletScale -> 100]; ws = WaveletScalogram[cwd, ...


9

First take a sample of the real image to get the right color mix: ii = Import@"http://tsgphysics.mit.edu/pics/Q%20Diffraction/Q2-Single-Slit-Diffraction.jpg"; h = ImageTake[ii, {366, 402}, {373, 543}] hd = Transpose[(ImageData@h)[[IntegerPart[ImageDimensions[h][[2]]/2]]]]; Let's see the color curves. It's easy to see that the Red channel is the triple ...


9

(This answer has just the circles, not the box with color scale information) To get circular looking disks I use Offset[r] for the radius, which ignores aspect-ratio and plot scale: Plot[x, {x, 0, 30}, AspectRatio -> 1/10, Epilog -> { {Red, Circle[{5, 5}, 5]}, {Green, Circle[{20, 20}, Offset[10]]} }] When putting Graphics together with ...


9

Borrowing some code from Kuba's: set = {20, 36, 70, 96, 152, 301} Graph[DirectedEdge @@@ #, VertexShapeFunction -> "Square", VertexSize -> {.2, .1}, VertexLabels -> Placed["Name", Center], VertexLabelStyle -> Directive[FontFamily -> "Arial", 10], GraphLayout -> "CircularEmbedding", EdgeLabels -> ((DirectedEdge[##] ...


8

If you only need a cube (possibly with a cutout), and no other shape, we can make a solution similar to ybeltukov's using Image3D: f = {x, y, z} \[Function] x + Sin[5 z] + y^2; data = Table[f[x, y, z], {x, -1, 1, .01}, {y, -1, 1, .01}, {z, -1, 1, .01}]; Image3D[Rescale[data], ColorFunction -> "Rainbow", ClipRange -> {{100, 201}, {0, 100}, {100, ...


8

Not the prettiest, perhaps, but I just wanted to finish what I started. I was able to finish it after having read ssch excellent answer and see how he used Offset. This plot was truly a challenge to me, and the problem is in combining the different graphics. Had I tried this again I would probably do everything with Graphics and not use ListLinePlot at all. ...


8

Using some tricks (for speed and show-off :) b = Normal@LatticeData["FaceCenteredCubic", "Basis"] l1 = Flatten[Table[{i, j, k}.b, {i, -1, 1}, {j, -1, 1}, {k, -1, 1}], 2]; f = Nearest[l1]; RegionPlot3D[ Length@f[{x, y, z}, {1, 1/N@Sqrt@2}] < 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, Mesh -> None, PlotStyle -> Directive[Yellow, Opacity[0.5]], ...


7

I chose to use the Australian data for patriotic reasons. Going to the web site you suggested, it is straightforward to get the data for the Australian roads network. On unpacking the resulting ZIP file, there are four files: AUS_roads.dbf, AUS_roads.prj, AUS_roads.shp and AUS_roads.shx. Mathematica supports .shp import, so it is a simple matter of doing ...


7

We can visualize the wavelet scalogram using ListPolarPlot data = Re[Zeta[1/2 + I Range[0, 100, 0.01]]]; cwd = ContinuousWaveletTransform[data, GaborWavelet[6], {4, 12}, WaveletScale -> 100]; ListPolarPlot[Abs@Reverse[Last /@ cwd[All]], ColorFunction -> "Rainbow"] Additionally we can see the scalogram in 3D using ListPlot3D: ...


7

I am betting that you are seeking Glow. Using Yves's gradient in: Edit: Looking again at your gradient it is closer to leave out Green entirely: ColorFunction -> (Glow @ Blend[{Blue, Cyan, Yellow, Red}, #3] &) We get: Plot3D[ Log[4*((1 + x)^2)*(0.0065^2)*Log[y]/(3*((1 - 2 x))^2*(0.0267^2)) + 1]/Log[y], {x, 0.315, 0.45}, {y, 0, 1}, ...


7

Just tossing a thought out there. Using the following sample data from ListVectorPlot3D, Graphics directives can be applied to VectorStyle to get a shape you desire: vectors = Table[{{x, y, z}, {y, x - x^3, z}}, {x, -1.5, 1.5, 0.2}, {y, -2, 2, 0.2}, {z, -1, 1, 0.1}]; ListVectorPlot3D[vectors, VectorScale -> 0.05, VectorStyle -> ...


6

vars1 = Array[x, {4}]; ka = {35, 10, 20, 25}; objectiveFunction = ka.vars1^5; s = {}; Dynamic@If[Length@s > 3, ListLinePlot[Transpose@s, PlotRange -> {{0, 200}, {0, 100}}, GridLines -> {{Length@s}, {}}],,] k[vars1_] := NMinimize[{objectiveFunction, And @@ Thread[GreaterEqual[vars1, 0]] && ...


5

This is a pragmatic approach, possibly if you understand more about light and lasers, you could do way better. I just use trial and error, with "manual" Blend: DensityPlot[(Sinc[\[Beta]])^2, {\[Beta], -6 \[Pi], 6 \[Pi]}, {y, -6 \[Pi], 6 \[Pi]}, PlotPoints -> 200, ColorFunction -> (Blend[{{0, Black}, {1/3, Red}, {0.4, White}}, #] &), ...


5

I guess what you want with your example input is the following tree = {3, {2, {1, None, None}, None}, None}; TreeForm[tree //. {root_, left_, right_} :> root[left, right]]


5

So, the scalogram is a raster, so what? Why does it deter you from just wrapping it around the pole? ws = WaveletScalogram[cwd, All, Re, ColorFunction -> "CherryTones", Axes -> False, PlotRangePadding -> None, AspectRatio -> 1] ImageTransformation[ws, {(ArcTan @@ (0.5 - #) + Pi)/(2 Pi),2 Norm[0.5 - #]} &]


5

set = {20, 36, 70, 96, 152, 301} Graph[DirectedEdge @@@ #, EdgeLabels -> ((DirectedEdge[##] -> (#2 - #)) & @@@ #), VertexLabels -> Thread[set -> set], EdgeLabelStyle -> Bold, VertexLabelStyle -> Directive[Bold, 20] ] &[Tuples[set, {2}]] Graph[DirectedEdge @@@ #, ...


5

One easy, although not beautiful way relies on the properties of 3D graphics. When you look how the simulated camera works, then you see that only the volume between near- and farplane is rendered. If you put your near plane in the distance, everything which is too close is cut. In Mathematica this can be be adjusted using the ViewRange option of ...


5

I would like to draw your attention to Blend, which is very useful for custom gradient coloring. Taken more or less directly from the documention: Graphics[Table[{Blend[{Blue, Cyan, Green, Yellow, Red}, x], Disk[{8 x, 0}]}, {x, 0, 1, 1/8}]] You may want to adjust/weigh the blending to your liking - see the docs for further enlightment.



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