Tag Info

Hot answers tagged

72

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


54

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


47

The idea behind this solution is to construct a superposition of Gaussian surfaces whose amplitude decay in time, and use DensityPlot to plot the trail: trail[fun_, {t_, tmin_, tmax_, dt_}, k_, lam_][xxx_, yyy_] := Module[{trange, xrange, yrange, twindow, trailf, sel, decayf}, decayf[x0_, y0_, t0_] := Exp[-k t0 - lam^2 (x0^2 + y0^2)]; twindow = 6/k; ...


42

Solution 1: Using 3D Texture with Polygons The idea is to use Polygon with 3D texture supported by Texture, but it requires a bit of undocumented hack to make it smooth. The original data set is from Stanford Graphics Group website. The dataset that has been used is CThead, 8-bit tiffs (download). Before proceed, make sure that you have a plenty of memory ...


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


40

Here is a simple approach to create a ghost trail: obj[{xfunc_, yfunc_}, rad_, lag_, npts_][x_] := MapThread[ {Opacity[#1, ColorData["SunsetColors", #1]], Disk[{xfunc@#2, yfunc@#2}, rad Exp[#1 - 1]]} &, Through[{Rescale, Identity}[Range[x - lag, x, lag/npts]]]] frames = Most@Table[Graphics[obj[{Sin[2 #] &, Sin[3 #] &}, 0.1, 1, 500][u], ...


36

The undocumented System`Dump`showStringDiff function neatly does the diff and highlights it for you. The simplest usage is: System`Dump`showStringDiff[text1, text2] You can choose custom colours for the highlights with the Styles option. You can also change the background, font weight, add a strikethrough, etc.: System`Dump`showStringDiff[text1, text2, ...


34

If what you want to visualize is how good the fit is, then you should do as @whuber suggests and plot the residuals, that is, the difference between the data and the fitted function. Below, each data point is drawn as a point with area proportional to the magnitude of the residual. Red means that the data value is higher than the fit; blue means the data is ...


34

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


29

I've taken the liberty of uploading the RGB values for MyCarta's color schemes to pastebin. Mr. Niccoli provides these in CSV downloadable from his website, but I found that I had to change their format if I want Mathematica to read them during initialization. Download the RGB color values for the cube 1, cubeYF, and LinearL from pastebin and put them into ...


28

Based on that outdated notebook, I did the following function: VennDiagram2[n_, ineqs_: {}] := Module[{i, r = .6, R = 1, v, grouprules, x, y, x1, x2, y1, y2, ve}, v = Table[Circle[r {Cos[#], Sin[#]} &[2 Pi (i - 1)/n], R], {i, n}]; {x1, x2} = {Min[#], Max[#]} &[ Flatten@Replace[v, Circle[{xx_, yy_}, rr_] :> {xx - rr, xx + rr}, ...


28

You can also calculate the Coefficient of Determination, R Squared. This is the same as the correlation squared, but by making use of LinearModelFit you can create some additional graphics. To make a sample distribution you can use this: CreateDistribution[] := DynamicModule[{savepts = {{-1, -1}}}, Dynamic[ EventHandler[ ListPlot[pts, AxesOrigin ...


28

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


26

n = 100; (*number of points*) s = RandomSample@Range@n; (*the initial set*) (*some aux functions*) head[{x_, xs___}] := Select[{xs}, # <= x &]; tail[{x_, xs___}] := Select[{xs}, # > x &]; (*qsort function modified for sowing the information needed*) qsort[{}] = {}; qsort[l : {x_, ___}] := Module[{lh, lt}, (Sow@{l, lh = head@l, x, lt = tail@l}; ...


25

Edit: I added more explanations below, because this visualization method is quite different from conventional vector plots For just this purpose I had at some point invented the following visualization technique. I'll reproduce your definition first. It defines a complex vector field on the surface of a unit sphere. Clear[\[Epsilon]];(*Polarization ...


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


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


22

With a bit of blur, but still not the variable-width blur in the example. obj[{xfunc_, yfunc_}, rad_, lag_, npts_][x_] := With[{trail = Range[x - lag, x, lag/npts]}, {ColorData["SunsetColors"]@#1, Opacity@#1, Disk[{xfunc@#2, yfunc@#2}, rad]} & @@@ Transpose[{Rescale[trail], trail}]] frames = Most@ Table[ImageCompose[# ~Blur~ 4, ...


21

You get nice Venn diagrams using W|A, eg.: = (A inter B) un (C inter D) the inter is esc inter esc and the un is esc un esc or skipping the opening = which doesn't work in the midst of a program: WolframAlpha["(A \[Intersection] B) \[Union] (C \[Intersection] D)", \ {{"VennDiagram", 1}, "Content"}]


21

What about perceived co-operative strength (well, at least something derived from counting the times two candidates were mentioned together): t = 1/Table[ Count[votes, _?(MemberQ[#, i] && MemberQ[#, j] &)], {i, 6}, {j, 6}]/. ComplexInfinity -> DirectedInfinity[1] // Quiet Do[t[[i, i]] = DirectedInfinity[1], {i, ...


21

With small tables of values, complex graphics can obscure the data. Ed Tufte has recommended just showing the counts. He also points out the worth of presenting the values in a meaningful order: here, the rows go from first to third place while the columns are (roughly) in order of the standings. raw = Import[ ...


21

This could provide a good starting point, since the structure of the diagrams is simply a cross with four regions that themselves can contain similar crosses, you can simply define a structure to represent this nesting and a recursive function to draw such structures. In my implementation I just use the head c to indicate a cross: dirs = {{1, 0}, {0, 1}, ...


21

Graphics[{Circle[{0, 0}, 1, {0, Pi}], Circle[{0, 0}, .03], Line[{{1, 0}, {1, -.1}, {-1, -.1}, {-1, 0}}], Rotate[ Line[{{.03, 0}, {.6, 0}}] , #, {0, 0}] & /@ {0, Pi/2, Pi}, GeometricTransformation[ Piecewise[{ {{Red, Line[{{.8, 0}, {1, 0}}], Black, Line[{{.2, 0}, {.5, 0}}], Rotate[{Red, Text[#, {.75, 0}, {0, ...


20

(too long for a comment) Plot[{ColorData["VisibleSpectrum"][x][[1]], ColorData["VisibleSpectrum"][x][[2]], ColorData["VisibleSpectrum"][x][[3]]}, {x, 380, 750}, PlotStyle -> {Red, Green, Blue}] It doesn't seem that you'll be able to obtain Yellow (RGBColor[1, 1, 0]) from ColorData["VisibleSpectrum"]; unfortunately, the docs say nothing ...


20

I would try plt=Show[ListPointPlot3D[data, ColorFunction -> "Rainbow"], Plot3D[fit["BestFit"], {x, 0, 180}, {y, 0, 0.1}, PlotStyle -> Directive[Yellow, Specularity[White, 20], Opacity[0.3]]], BoxRatios -> {1, 1, 1}] Then you can change perspective? GraphicsArray[{{plt, Show[plt, ViewPoint -> Front]}, {Show[plt, ViewPoint ...


20

With the set-up you already have, you can do nearbin = Nearest[Table[verttri[[i]] -> i, {i, Length@verttri}]]; counts = BinCounts[nearbin /@ data, {1, Length@verttri + 1, 1}]; which counts the number of data points nearest to each vertex. Then just draw the glyphs directly: With[{maxCount = Max@counts}, Graphics[ Table[Disk[verttri[[i]], 0.5 ...


19

Take $r=1, t=5, d=10$ for example: r = 1; t = 5; d = 10; The parametric equation for the 3-torus is given by: torus3 = {(r + (t + d Cos[a]) Cos[b]) Cos[c], (r + (t + d Cos[a]) Cos[b]) Sin[c], (t + d Cos[a]) Sin[b], d Sin[a]}; Suppose the plane is determined by its normal $\mathbf n$ and a point $\mathbf o$ on it: \[DoubleStruckN] = ...


19

With this function a random integer is inserted in the e-mail address (gmailuser@gmail.com becomes gmailuser+randominteger@gmail.com) and then the hash value is computed. The hash value is used to get the corresponding identicon from the Gravatar website. This approach can address also some privacy concerns. generatePic[email_] := Module[{emailparts, ...



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