Tag Info

Hot answers tagged

300

The code below attempts to apply the XKCD style to a variety of plots and charts. The idea is to first apply cartoon-like styles to the graphics objects (thick lines, silly font etc), and then to apply a distortion using image processing. The final function is xkcdConvert which is simply applied to a standard plot or chart. The font style and size are set ...


289

Mostly thanks to Belisarius's elegant wrapping, you can do h[fun_, divisor_, color_, at_] := Module[{k}, k = BSplineFunction[Table[fun@x + RandomReal[{-0.1, 0.1}/divisor], {x, 0.01, 10, .1}]]; ParametricPlot[k[x], {x,0.1,0.9}, PlotStyle->{color, AbsoluteThickness@at}, Axes-> None]]; Show[{ h[{#, 1.5 + 10 (Sin[#]^2/Sqrt[#]) Exp[-(# - 5)^2/2]} ...


194

I have to confess that I see this as a proper challenge, as I am usually quite creative in finding/combining functions to provide a desired behavior. So I will give it another try. which is generated using box[x_, x1_, x2_, a_, b_] := Tanh[a (x - x1)] + Tanh[-b (x - x2)]; ex[z_, z0_, s_] := Exp[-(z - z0)^2/s] and r[z_, x_] := (*body*).4 (1.0 - .4 ...


148

This might get me suspended from the site butt I cannot resist. The shape you are looking for can probably be approximated (depending how anal you want to be about the outcome) by two assymetric probability distributions. The obvious choices would be a Poasson or a log normal distribution. I will use the latter as it is continuous. Now the bummer is that ...


79

In case you want more flexibility, it's also possible to design your own legends, for example along the lines of this MathGroup post. For your example, the process would start with the function legendMaker. Instead of repeating the same definition as in the above post, I've overhauled legendMaker in response to image_doctor's answer, to separate out the ...


77

Since Mathematica does not have a built-in plot manipulating interface, here is a gui of a plot-manipulator. Updates are indicated with bold text. Functionality: Should work with any plot/graphics (ArrayPlot compatibility added); Drag anywhere in plot zooms in to selected rectangle; can be done repeatedly; Ctrl+drag zooms in/out (along vertical axis); ...


74

Time to join in the fun. version 2 Result Method I produce the basic plot with ticks and labels: Plot[{x/2, (x + Sin[x])/2.2}, {x, 0, 2 Pi}, MaxRecursion -> 0, PlotPoints -> 30, Axes -> False, Frame -> {True, True, False, False}, FrameTicks -> {{{0.2, "Start", 0.07}, {3, "lunch", 0.05}, {6, "Finish", 0.06}}, None}, PlotLabel -> ...


69

This can be done with Overlay if the ImagePadding and the horizontal range for each plot is the same. For example, plot1 = ListLinePlot[ Accumulate[RandomReal[{0, 1}, {100}]], PlotStyle -> Blue, ImagePadding -> 25, Frame -> {True, True, True, False}, FrameStyle -> {Automatic, Blue, Automatic, Automatic} ] plot2 = ...


64

I'm very late to the party, but here's a convenient xkcd guy generator: This was generated as: With[{ h = xkcdGuy[-10, "hat", 0.2, {20, -90}, {-57, -10}, {-20, 0}, {20, 0}], n = xkcdGuy[0, "none", -0.2, {-10, 0}, {50, 10}, {-20, 0}, {20, 0}]}, Graphics[{First@n, Rotate[Translate[First@h, {3.3, 0}], 10 Degree]}] ] // xkcdConvert using ...


63

Parametric Buttocks Manipulator Manipulate[ ParametricPlot3D[{ (e u^p + (1 + (c - a u) (u - 1)) Cos[t]^2) Sin[t], (e u^p + (1 + (d - b u) (u - 1)) Cos[t]^2) Cos[t], 2 u}, {t, -0.2, Pi + 0.2}, {u, 0, 1.1}, Lighting -> "Neutral", Mesh -> None, PlotStyle -> Directive[Specularity[0], RGBColor[0.92, 0.85, 0.73]], Axes -> False], {{a, ...


62

Building on Heike's ColorFunction, I came up with this: z = Transpose@Reverse@Sin@ Outer[Complex, Range[-Pi, Pi, 0.01], Range[-Pi, Pi, 0.01]]; hsbdata = Transpose[{ Rescale[Arg[z], {-Pi, Pi}], 1 - 0.05/Abs[Sin[2 Pi Abs[z]]], 0.02/Abs[Sin[2 Pi Abs[z]]] + Abs[Sin[2 Pi Im@z] Sin[2 Pi Re@z]]^0.25} , {3, 1, 2}]; Image[hsbdata, ColorSpace -> "HSB"] ...


60

To implement datenwolf's suggestion to perturb curves with Perlin noise to give that "hand-drawn" look and feel, here's one way to use one-dimensional Perlin noise for the perturbation: fBm = With[{permutations = Apply[Join, ConstantArray[RandomSample[Range[0, 255]], 2]]}, Compile[{{x, _Real}}, Module[{xf = Floor[x], xi, xa, u, i, j}, xi = ...


46

Yes we can. The following DashedGraphics3D[ ] function is designed to convert ordinary Graphics3D object to the "line-drawing" style raster image. Clear[DashedGraphics3D] DashedGraphics3D::optx = "Invalid options for Graphics3D are omitted: `1`."; Off[OptionValue::nodef]; Options[DashedGraphics3D] = {ViewAngle -> 0.4, ViewPoint ...


43

Consider this: ParametricPlot3D[ RotationTransform[a, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}], {a, 0, 2 Pi}, Evaluated -> True] Now rotate this around a circle, while rotating it at the same time around its' origin: ParametricPlot3D[ RotationTransform[b, {0, 0, 1}][{6, 0, 0} + RotationTransform[a + 3 b, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}]], ...


41

The cure is undocumented, unfortunately. Try adding Method -> {"AxesInFront" -> False}, like so: Plot[2 x - 2, {x, -10, 10}, PlotRange -> {{-10, 10}, {-10, 10}}, PlotStyle -> Directive[Black, AbsoluteThickness[2]], ImageSize -> 300, AxesStyle -> Directive[RGBColor[.8, .8, .8], AbsoluteThickness[2]], AspectRatio -> 1, ...


40

The list structure is not manifest to Plot as it has the attribute HoldAll (to get a function's attributes, either use Attributes[func] or ??func). Hence Plot evaluates the Table functions as one unit and it appears as if there is only one function, not four. Evaluate will make the list structure manifest and each function will be plotted with a separate ...


40

I take zero credit for this. It is a method I learned from Maxim Rytin. ContourPlot3D[{(x^2 + y^2 + z^2 + 8)^2 - 36 (x^2 + y^2), y^2 + (z - 2)^2 - 4}, {x, -4, 4}, {y, -4, 4}, {z, -2, 2}, Contours -> {0}, ContourStyle -> Opacity[0], Mesh -> None, BoundaryStyle -> {1 -> None, 2 -> None, {1, 2} -> {{Green, Tube[.03]}}}, Boxed -> ...


40

Needs["PolyhedronOperations`"] poly = Geodesate[PolyhedronData["Dodecahedron", "Faces"], 4]; amplitude = 0.15; twist = 4; verts = poly[[1]]; faces = poly[[2]]; phases = RandomReal[2 Pi, Length[verts]]; newverts[t_] := MapIndexed[{Sequence @@ (RotationMatrix[twist Last[#1]].Most[#1]), Last[#1]} (1 + amplitude Sin[t + phases[[First@#2]]]) &, ...


39

I'm posting this as a second answer, as it's really a completely different approach. It's also been substantially expanded as of April 25, 2012. While this still doesn't specifically address the question of adding a region, it does plot the countries separately. Of course, each country could be viewed as a region in itself. Our objective is to make a ...


37

Here's my solution, which constructs the three components and uses Inset to combine them into a single graphic. I've taken some care so that: the coordinate systems should line up across the plots (check the gridlines) as many graphics and plotting options are respected without breaking the layout the graphic can be reasonable resized ...


37

Basic method There appears to be a mechanism for doing just that, though I have yet to map its capabilities. As a basic example for the time being: Themes`AddThemeRules["wizard", DefaultPlotStyle -> Thread@Directive[{Purple, Orange, Hue[0.6]}, Thick], LabelStyle -> 18, AxesStyle -> White, TicksStyle -> LightGray, Background -> ...


34

Edit I updated the definitions of reportColorRange and colorLegend: added more comments in the code, allowed more customization options for the legend. Color gradients are produced by VertexColors for better-looking PDF export; gradients can also be replaced by color bands (using the "ColorSwathes" option). The labels on the color bar can be specified by ...


34

Disclaimer: I didn't actually look at the links in the comments because I wanted to see how well I could do on my own, so here's my original Mathematica cartogram creation! First, load the data from various web resources (as is done here): ClearAll["Global`*"] usa = Import[ "http://code.google.com/apis/kml/documentation/us_states.kml", "Data"]; ...


33

An easy way to add a vertical line is by using Epilog. Here is an example: f[x_] := (x^2 z)/((x^2 - y^2)^2 + 4 q^2 x^2) /. {y -> π/15, z -> 1, q -> π/600} Quiet[maxy = FindMaxValue[f[x], x]*1.1] lineStyle = {Thick, Red, Dashed}; line1 = Line[{{π/15 + 1/50, 0}, {π/15 + 1/50, maxy}}]; line2 = Line[{{π/15 - 1/50, 0}, {π/15 - 1/50, maxy}}]; ...


33

Let me elaborate on @stevenvh's answer using Splines instead of Interpolation. The danger of using f'[0] is that the built-in interpolation requires that the (Hermite) polynomials go through each data points. Now if you data is noiseless that's fine, but if your data is noisy, the derivative of the interpolation will be all the more noisy (as a rule its ...


33

You can also use MeshFunctions: Plot[{Cos[x], x Sin[x]}, {x, -3 Pi, 3 Pi}, MeshFunctions -> {(Cos[#] - # Sin[#]) &}, Mesh -> {{0}}, MeshStyle -> Directive[Red, PointSize[Large]]] Update: Dealing with Tan[x] using Exclusions Plot[{Tan[x], x Sin[x]}, {x, -3 Pi, 3 Pi}, MeshFunctions -> {(Tan[#] - # Sin[#]) &}, Mesh ...


33

Edit note: I want to thank to all upvoters, this is really shocking and motivating :). Just to make this answer covering both graphs I've added right graph made with SectorChart like I suggested in comments and to not clone David's solution. data = RandomReal[{1, 5}, 16]; Left graph: For equally spaced (in angle) measurements it is easier to use Mesh for ...


32

Edited to make it a function. For the strange Exclusions specification I use below, see my answer here. Thanks to @Oleksandr and @JM for their great comments. plInters[{f1_, f2_}, {min_, max_}] := Module[{sol, x}, sol = x /. NSolve[f1[x] == f2[x] && min < x < max, x]; Framed@Show[ ListPlot[{#, f1[#]} & ...


31

One possibility is to plot the contour plot with linear scales using ContourPlot and use ListLogLogPlot to transform this plot to one with logarithmic scales: pl = Normal@ ContourPlot[ Sin[3 x] + Cos[3 y] == 1/2, {x, .01 Pi, 3 Pi}, {y, .01 Pi, 3 Pi}, PlotPoints -> 30] ListLogLogPlot[Cases[pl, Line[a_, b___] :> a, Infinity], Joined -> ...


31

Strategy is simple texture map 2D plot on a rectangle under your 3D surface. I took a liberty with some styling that I like - you can always come back to yours. contourPotentialPlot1 = ContourPlot[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 0.125 s^4, {h, -400, 400}, {s, -300, 300}, PlotRange -> {-1.4*10^8, 2*10^7}, Contours -> 15, ...



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