Tag Info

Hot answers tagged

66

TL;DR: A package (Mathematica v10) can be found at the very bottom of this 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 ...


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


41

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


33

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]); ...


25

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


24

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


23

Since you want the animation to have explanatory content, I thought it might be best to incorporate the explanatory 2D diagram into the 3D scene. So I imagine the 2D plot as a "sticker" that can be put onto the cylinder, like a label on a bottle. That way, you can see the explanatory diagram itself wrap around the cylinder and become identical to the ...


18

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


18

Method 1: FindCurvePath (as mentioned by Yves Klett). This method is simple, but unfortunately, there are small issues (as shown in plots), that the curves are not identified perfectly. arrayData = Flatten[Function[{lst}, {First @ lst, #} & /@ Rest[lst]] /@ originalData, 1]; curvesPosition = FindCurvePath[arrayData]; ListPlot[curves = ...


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

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


13

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


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

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


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

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


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


11

One can use the periodicity over $\theta$ and add one periodic copy of the data. In this case FindCurvePath works much better. I also add an interpolation of the result arrayData = Flatten[Thread@{#, Join[{##2}, {##2} + 2 π]} & @@@ originalData, 1]; curvesPosition = FindCurvePath@arrayData; {t, θ} = Interpolation@Transpose@{Range[0., 1, 1/(Length@# - ...


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


9

There exists a simple trick for your purpose, here is my implementation: f[a][b][c][d] //. g_[x_][y__] :> g[x, y] /; (Print[g[x][y] -> g[x, y]]; True) Log[Sqrt[a (b c^d)^e]] //. {Log[x_ y_] :> Log[x] + Log[y] /; (Print[Log[x y] -> Log[x] + Log[y]]; True), Log[x_^k_] :> k Log[x] /; (Print[Log[x^k] -> k Log[x]]; True)} Not as ...


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

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


8

You can post-process the graphics output to shift the arrows: vp1 = VectorPlot[{-1 - x^2 + y, 1 + x - y^2}, {x, -2, 2}, {y, -2, 2}, VectorPoints -> points, VectorScale -> {.5, .4}, ImageSize -> 400, Prolog -> {Yellow, Opacity[.5], Rectangle[{-1, -1}, {1, 1}], Opacity[1], Red, PointSize[Large], Point[points]}]; vp1b = vp1 ...


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

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

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


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

Rather than making the Histogram larger, I suggest you measure vals in terms of $1000. Replace your last line by pci = GeoRegionValuePlot[Thread[counties -> Quantity[QuantityMagnitude[vals/1000], IndependentUnit["$K per year"]]], PlotLegends -> Histogram] Dividing vals by 1000 expresses quantities in units of $1000. IndependentUnit["$K per ...


5

You can just make your own function, though in most situations you can just pass a list of colors. colors = Table[Hue@h, {h, 0, 0.7, 1/10}]; discrete[x_] := Part[colors, x]; ContourPlot[x + Sin[x^2 + y^2], {x, -4, 4}, {y, -4, 4}, Contours -> 9, ContourShading -> colors] For a gradient, use Blend: gradient[x_] := Blend[colors, x]; ...



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