Hot answers tagged

33

I've taken the liberty of converting the pseudocode from Moreland's paper into a package. I had to change the numerical values of the RGB->XYZ transformation matrix to account for the fact that Mathematica uses different reference white points for the different color spaces. Update I've created a package, and uploaded it on on github. Much thanks to ...


27

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


23

This response defines a function called traceTypes which provides a quick-and-dirty visualization of type system operation. The function is somewhat fragile as it depends upon undocumented implementation details in version 10.2. Despite this fragility, it might be useful for study purposes as it handles many common type system use cases. The code for the ...


23

This package provides couple of functions for plotting commits data from GiHub: Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/Misc/GitHubPlots.m"] GitHubDateListPlot["hadley", "plyr"] GitHubBarChart["hadley", "plyr"] I think these plots are similar enough to the image in the question. There are number of ...


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


18

Here's my take (using some of the new version 10 functions): adjusthue[msat_, ssat_, hsat_, munsat_] := hsat + (1 - 2 UnitStep[-hsat - π/3]) If[munsat == msat, 0., Sqrt[Max[1, munsat/(msat + $MachineEpsilon)]^2 - 1]/Sinc[ssat]] l2m = With[{m = Norm[{##}]}, {m, ArcCos[If[m == 0, 0, #1/m]], Arg[#2 + I #3]}] &; m2l = #1 Prepend[Sin[#2] ...


13

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


13

You ought to use EdgeRenderingFunction to achieve this. First, import a graphic for a brushstroke: BRUSH = Import[NotebookDirectory[] <> "brush.png"] Then use the EdgeRenderingFunction option in GraphPlot to obtain the image. GraphPlot[Graph[{1 -> 2, 2 -> 3, 3 -> 1}], EdgeRenderingFunction -> ({Inset[BRUSH, Mean[#1], Automatic, 1.7, ...


12

Here is a simple-minded smooth homotopy between the two curves in the OP, using a Hermite interpolant for keyframing: hcubic[t_] = InterpolatingPolynomial[{{{0}, 0, 0}, {{1}, 1, 0}}, t]; Animate[ContourPlot[(1 - hcubic[t]) ((x^2 + y^2 - 1)^3 - x^2 y^3) + hcubic[t] (x^2/2 + y^2/3 - 1) == 0, {x, -3/2, 3/2}, {y, -7/4, ...


11

Although this is hardly a debilitating bug I wondered what else might be affected so I decided to trace this further. I found that the bug affects TreeForm by way of TreePlot. Here is a reduced example of the call that originates in the exhibit above: TreePlot[{1 -> 2, 1 -> 3, 1 -> 4}, Top, 1, "VertexNames" -> {List, HoldForm["foo"], ...


10

I would do it like this: The example graph g: g = Graph[{1 <-> 2, 2 <-> 3, 3 <-> 1}]; Desired locations of the vertice in result: vtxPosStore = Association[{ 1 -> {0, 0}, 2 -> {1, 0}, 3 -> {.5, 1} }]; Desired edge-shapes: edgeRoutingStore = Thread[# -> ...


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


9

Code from years ago, adapted for Manipulate, for a pre-calculus course: Move m to see the homotopy. (I used it at the end of the function-graph transformations to show "translating by a function" instead of by a constant.) The other parameters were for finding a good-looking shape for class. You can adapt or add coefficients for the desired "zero." ...


9

In order to make the legend properly, I elected to use the CustomTicks package, available here. The code for the density plotting function is << "CustomTicks`"; Options[nonLinearDensityPlot] = {"SignedData" -> Automatic, "ScalingFactor" -> 100, "Color" -> Automatic, "ScalingFunction" -> (ArcSinh[#1 #2 / #3]/ArcSinh[#2] &)}; ...


8

I often use Dave Green's family of color schemes called cube helix. (https://www.mrao.cam.ac.uk/~dag/CUBEHELIX/) It gets the luminance stuff right, and always converts to gray scale correctly, but has a few tweakable parameters that I can use in different contexts. I've implemented it (inefficiently) as: cubeHelix[z_, rot_: 1.0, start_: 0.5, γ_: 1.0, hue_: ...


8

This is not a protractor, but it is a related application that that serves as an example of rotated text which is the only thing missing in the protractor shown in the question. I did it a while a go and keep it near the kitchen oven: c[f_]:=5/9 (-32+f) f[c_]:=1/5 (160+9 c) cToAngle[c_]:=(c+40)/300*(2\[Pi]-5Degree) ...


8

As this is a special-functions question, I feel justified in using a bit of heavy artillery. Here goes nothing... In effect, what the OP seems to want to do is to evaluate $$\sum_{n=1}^\infty \frac{(q^{n+1};q)_\infty}{(q^n;q)_\infty} q^{n-1}$$ (where $(a;q)_n$ is the $q$-Pochhammer symbol) by approximating it with its partial sums. However, there is a ...


8

You can do this with GeoLabels: GeoRegionValuePlot[Counts[temp], GeoLabels -> (Tooltip[#1, #2] &)]


8

Firstly I'm not sure if Mathematica's Random Tree method has an equivalent max_depth option (I don't know too much about random tree). The options available to the Random Tree method are: "TreeNumber", "LeafSize", and "VariableSampleSize". Now as for plotting the classifier boundaries, one can simply pass the ClassifierFunction for ContourPlot (or ...


7

Use Evaluate[...] rather than Evaluated -> True START EDIT: Attributes[Plot] {HoldAll, Protected, ReadProtected} Since Plot has the attribute HoldAll the first expression is initially interpretted as a single entity. To make the argument a list of two distinct entities it must be evaluated to override the HoldAll attribute. Evaluated is not a ...


7

With the arbitrary datasets datasets = {dataset1, dataset2, dataset3} = RandomReal[#, 100] & /@ {1, 2, 3}; one can pre-render the plots and add an empty plot for the case when no dataset is selected plots = Append[ MapThread[ListPlot[#1, Joined -> True, PlotStyle -> #2] &, {datasets, ColorData[97] /@ Range[3]}], ...


7

Here is some code I used, which may partially answer your question. The key is to calculate efficiently points near the border of the Mandelbrot set. These points have large iteration counts which, when iterated, produce the Buddhabrot form. The algorithm linked to in the question uses an adaptive mesh of squares to locate border points. The alternate code ...


7

Here is a version that builds up the "full Tufte" version of the plot presented above by building up the corresponding Graphics primitives. Quite a few styling decisions must be made with respect to colors, spacings, overall aspect ratio of the plot, etc. I went with choices that were aesthetically pleasing to me, but of course it should be relatively easy ...


6

This is nowhere near as remarkable as Mark McClure's answer (which I have voted for and would upvote more if I could) but I only post it in relation to coloring to illustrated correspondence. spc[x_, y_] := {2 x, 2 y, -1 + x^2 + y^2}/(1 + x^2 + y^2) mt[a_, b_, c_, d_][x_, y_] := Through[{Re, Im}[(a x + a I y + b)/(c x + c I y + d)]] q = Flatten[ ...


6

You just need to change the parameters before and after your Sphere[] like this: {Graphics3D[{Opacity[0.6], GrayLevel[1], Sphere[], GrayLevel[0], Opacity[1.0], globeGrid[6, figure]}]} Opacity[0.6] is about right to partly hide the lines around the back. GrayLevel[1] because you want the sphere to be coloured white/light. GrayLevel[0] because you want ...


6

In version 10.2 there is a new suite of functions that may be helpful: f[x_, y_, z_] := Sin[x/4]*Sin[y/4]*Sin[z/4]; xyzw = Flatten[Table[{x, y, z, f[x, y, z]}, {x, 1, 10}, {y, 1, 10}, {z, 1, 10}] // N, 2]; ListSliceContourPlot3D[xyzw, "CenterPlanes"]


6

Use Kellen Myers's method but with randomly generated brush-style strokes: Clear[baseStroke] baseStroke := Graphics[{ Black, FilledCurve@ BSplineCurve[{{2,0},{1,0},{0,-0.2},{-0.1,0},{0,0.2},{1,.1}}, SplineClosed -> True] }, PlotRange -> {{-.3, 2}, {-.5, ...


5

How about something Image3D-based? grid = First@ ParametricPlot3D[{Cos[u] Cos[v], Sin[u] Cos[v], Sin[v]}, {u, 0, 2 Pi}, {v, -Pi/2, Pi/2}, PlotStyle -> None]; Graphics3D[ {grid, {Red, Thick, Line[1.2 {{-1, 0, 0}, {1, 0, 0}}]}, {Blue, Thick, Line[1.2 {{0, -1, 0}, {0, 1, 0}}]}, {Green, Thick, Line[1.2 {{0, 0, -1}, {0, 0, 1}}]}, ...


5

You could define $a_1,a_2$,.. as graphic primitives (Line) and use Translate: a1 = {Thickness[.01], Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; a2 = {Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; b1 = {Line[{{0, 0}, {1, 0}}], Thickness[.01], Line[{{1/2, -1/2}, {1/2, 1/2}}]}; b2 = {Line[{{1/2, -1/2}, {1/2, 1/2}}], Thickness[.01], Line[{{0, ...


5

A small change to the LabelingFunction seems to do the trick: BarChart[{{0.123, 0.492}, {2.865, 0.055}, {1.03, 1.084}, {4.282, 0.053}}, AxesLabel -> {"", "Value"}, ChartLabels -> {Placed[{"data1", "data2", "data3", "data4"}, {{0.5, 0}, {0.8, 1.2}}, Rotate[#, (1.75/7) Pi] &], Placed[{"", ""}, Above]}, LabelingFunction -> ( ...



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