Tag Info

Hot answers tagged

32

Here's a way to morph the boundaries. After finding the boundaries by Thinning of the result of EdgeDetect, FindCurvePath finds a sequence of points that traces a path around each segment. MorphologicalComponents numbers the component left to right, top to bottom, so that 1 is the apple leaf, 2 is the i-dot, 3 is the apple body, and 4 is the i-stem (5, 6 ...


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


15

One way to do it would be to use glyphs. We can extract the curves that make up the two characters as follows: a = First@First@Last@First@First@ ImportString[ExportString[ Style[FromCharacterCode[61440], 24, FontFamily -> "Baskerville Old Face"], "PDF"], "PDF", "TextMode" -> "Outlines"]; b = First@First@Last@First@First@ ...


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


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

Let us do it purely by image-processing. The main idea is to use DistanceTransform here. {img1, img2} = ImageResize[#, Scaled[3]] & /@ Import /@ {"http://i.stack.imgur.com/RKHo5.png", "http://i.stack.imgur.com/MFGR4.png"} The signed distances to the boundaries of all morphological components are dist = ...


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

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[##] ...


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

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


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


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


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


6

One classic way to depict the effect of a plane linear transformation is to see what it does to a stylized drawing of a cat's face. First, a utility to transform points and a function to reflect across the vertical axis: pointQ[p_] := VectorQ[p, NumberQ] && Length[p] == 2 image[T_, object_] := object /. pt_?pointQ :> T[pt] reflect[p_?PointQ] ...


6

Until someone comes up with a less convoluted approach, you can post-process the output of BoxWhiskerChart to color and/or to downsample the outliers as follows: data = Flatten[{RandomReal[1., 10000], RandomReal[2., 2000]}]; b1 = BoxWhiskerChart[data, {"Median", {"MedianMarker", 1, Black}, {"Whiskers", Black}, {"Fences", 0.5, Black}, ...


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.


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

Straightforward approach with controlling related heights. Needs["HierarchicalClustering`"] SeedRandom@2; data = RandomVariate[NormalDistribution[], {10, 20}]; height = 50; label = ListPlot[#, Axes -> False, Joined -> True, ImageSize -> {300, height}, AspectRatio -> height/300] & /@ data; Edit I'm sorry my previous ...


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



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