Tag Info

Hot answers tagged

59

TL;DR: package at the bottom of post. UPDATES 6: Tiny update: Import can now use the ".bvh" extension to determine the import type. The code that does this is ugly, but I don't see any other way at the moment. out = Import["C:\\Female1_C03_Run.bvh"] 5: Added error checking and registered the package as an official importer for "BVH" files, so ...


38

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


31

Let you have a function and an initial point f[x_] := Cos[x] x0 = 0.2; Then you can calculate a sequence seq = NestList[f, x0, 10] (* {0.2, 0.980067, 0.556967, 0.848862, 0.660838, 0.789478, \ 0.704216, 0.76212, 0.723374, 0.749577, 0.731977} *) and vizualize it with a so-called Cobweb plot p = Join @@ ({{#, #}, {##}} & @@@ Partition[seq, 2, 1]); ...


20

Some function definitions first. AkimaInterpolation[] stolen from here (Thanks JM, wherever you are!): AkimaInterpolation[data_] := Module[{dy}, dy = #2/#1 & @@@ Differences[data]; Interpolation[Transpose[{List /@ data[[All, 1]], data[[All, -1]], With[{wp = Abs[#4 - #3], wm = Abs[#2 - #1]}, If[wp + wm == 0, (#2 + #3)/2, (wp #2 + wm ...


19

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


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

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


14

Update According to KennyColnago's advice, post-processing is not needed, as StreamColorFunction can handle it essentially by using VertexColors on Line-s: ListStreamPlot[ testdata, StreamPoints -> {samplePoints, Automatic, 10}, StreamStyle -> "Line", Background -> Black, ...


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

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

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


12

You have to create your own mesh and you have to convert your u and v to mesh interpolations. (In the example in the documentation, NDSolveValue does this itself in constructing uif, vif.) Example: Needs["NDSolve`FEM`"] mesh = ToElementMesh[FullRegion[2], {{0, 5}, {0, 1}}]; u = Function[{x, y}, x (y - 0.5)/25]; v = Function[{x, y}, -x^2/50]; uif = ...


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

ListPlot[] isn't the "right" tool. It can be done with Epilog ->, but it's more natural to use Graphics[] and Nearest[]: (* Generate a distribution similar to your example *) n = 1000; rs = RandomVariate[TransformedDistribution[Sqrt@x,x\[Distributed] UniformDistribution[{.1, 1}]], n]; phis = RandomReal[{0, 2 Pi}, n]; pts = #1 {Cos@#2, Sin@#2} & @@@ ...


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


10

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

gr = Normal@StreamPlot[{Cot[θ] Cos[ϕ], -Sin[ϕ]}, {ϕ, -π, π}, {θ, 0, π}, StreamColorFunction -> Hue]; Graphics3D[Cases[gr, _Arrow, Infinity] /. {x_Real, y_Real} :> {Cos[x] Sin[y], Sin[y] Sin[x], Cos[y]}]


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

This seems to work pretty well: r = 0.2/3; regions = RegionPlot[ Evaluate@Table[ Length@clique PDF[SmoothKernelDistribution[data[[clique]], r], {x, y}] > 1/(4 π r^2), {clique, mycliques}], {x, -2 r, 1 + 2 r}, {y, -2 r, 1 + 2 r}, Frame -> False]; Show[regions, Graph[mygraph, GraphStyle -> "BasicBlack"]] Further reading: ...


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


7

Both, DistributionChart and SmoothHistogram are models using a "smooth kernel density estimate". Consider the simplest case with two points only: DistributionChart[{0, 1}, GridLines -> Automatic] SmoothHistogram[{0, 1}, GridLines -> Automatic] For your data we get dat = Flatten[{RandomReal[1., 10000], RandomReal[2., 2000]}]; ...


7

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


7

dottie = FindRoot[Cos[x] == x, {x, 1}] // Values // First 0.739085 Plot[{Cos[x], x}, {x, -5, 5}, Epilog -> {Red, PointSize[0.02], Point[{dottie, dottie}]}] Convergence can be seen with EvaluationMonitor {res, {evx}} = Reap[FindRoot[Cos[x] == x, {x, 0}, EvaluationMonitor :> Sow[x]]] {{x -> 0.739085}, {{0., 1., 0.750364, 0.739113, ...


7

An alternative way to post-process the StreamPlot output into a Graphics3D object using @user18792's trick: sp = StreamPlot[{Cot[θ] Cos[ϕ], -Sin[ϕ]}, {ϕ, -π, π}, {θ, 0, π}, StreamColorFunction -> Hue, ImageSize -> 400]; sp3d = Graphics3D[sp[[1]] /. Arrow[z_] :> Arrow[z /. {x_Real, y_Real} :> {Cos[x] Sin[y], Sin[y] Sin[x], Cos[y]}], ...


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

I tried to use the above mentioned codes for plotting error ellipses for 2D-Data. However, I did not get the anticipated results, because an error occured when Mathematica tried to solve the equality in the function Counterplot for my data. I found another solution based on the explicit calculation of the ellipse by means of covariance analysis. The ellipse ...


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

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