Tag Info

Hot answers tagged

64

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


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


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


24

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


22

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


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


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


15

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


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

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

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

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

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


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

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

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


7

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


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

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


7

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

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


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


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

Sometimes, the file size and number of frames of a bvh file can be very large, one might skip every other frames to reduce the file size and cut half of the number of frames. The example below, has 3602 frames and 2,559KB in size, one can cut it into half with the following codes: srcFile = "https://www.dropbox.com/s/j4k5f4vfqb592tw/Dance01.bvh?dl=1"; ...



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