A message from our CEO about the future of Stack Overflow and Stack Exchange. Read now.
456

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


433

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


322

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


215

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


180

I did a very simple (in fact over-simple) snowflake simulator with CellularAutomaton years before. It's based on the hexagonal grid: and range-1 rules: Initial code First we'll need some functions to display our snowflakes: Clear[vertexFunc] vertexFunc = Compile[{{para, _Real, 1}}, Module[{center, ratio}, center = para[[1 ;; 2]]; ratio = para[[...


119

Here's what I came up with How I did it First we need a list of words. Here, I've taken the original list ordered by size. tally = Tally@ Cases[StringSplit[ExampleData[{"Text", "AliceInWonderland"}], Except@LetterCharacter], _?(StringLength@# > 4 \[And] # =!= "Alice" &)]; tally = Cases[tally, _?(Last@# > 10 &)]; tally = ...


114

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


106

How can this code be improved, for example, by including shadows, raytracing or the effects of gravity to make it more realistic? I felt that this question deserved an answer. The one I describe here is to create a set of confetti "agents" that respond in quasi-physical ways to external forces and "know" how they should be displayed. It is handy, and a ...


96

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


95

Amusingly enough, the images above actually arose as an accidental by-product of browsing inane YouTube conspiracy theory videos. I happened across a rather beautiful video of a "mirror cube" device produced by a man in Germany named Ben Palmer, who apparently produced it in an attempt to bring recognition to a philosopher named Walter Russell (the first ...


93

Here's a quick take on it: Clear[spiralize]; spiralize[p_, d_:10, r_:4, f_:0.8, s_:1, t_:0.005]:=Module[{m,rr=r}, m = Mean @ p[[1]]; Graphics[{EdgeForm[Thickness[t]],FaceForm[White], NestList[GeometricTransformation[ GeometricTransformation[#, RotationTransform[rr++s \[Degree],m]], ScalingTransform[{f,f},m] ]&...


93

Here is one way to come up with "mandalas" -- we generate a segment and then by appropriate number of rotations we produce a "mandala". Here is an example function of a random seed segment generation: Clear[MakeSeedSegment] MakeSeedSegment[radius_, angle_, n_Integer: 10, connectingFunc_: Polygon, keepGridPoints_: False] := Block[{t}, t = Table[ ...


91

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


89

A preview Before I show any code, here's a preview of what is possible with some tweaking: First try Here's a go at implementing Wordle's layout algorithm, described at cormullion's link. First, let's generate the word data (this is pretty arbitrary): punctuation = ",/.<>?;':\"()-_!&" (* boring words: *) common = {"the", "of", "and", "to", "...


88

Let's get a low-res image: And put in in gray-scale mode: gimg = ColorConvert[ImageResize[ Import["http://i.stack.imgur.com/wtgxH.jpg"], 300], "Grayscale"]; Now extract the image data (pixel values) together with pixel indexes: data = MapIndexed[Append[#2, #1] &, ImageData[gimg], {2}]; I, of course, couldn't pass on Voronoi styling. We will ...


84

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 Simon's ...


82

Version 11.1 introduces MengerMesh: MengerMesh[3] This seems the most natural to me: carpet[n_] := Nest[ArrayFlatten[{{#, #, #}, {#, 0, #}, {#, #, #}}] &, 1, n] ArrayPlot[carpet @ 5, PixelConstrained -> 1] Shorter (in InputForm), but perhaps harder to read and slightly slower, though speed hardly matters given the geometric memory usage: carpet[...


82

How to make your eyes hurt Mike asked whether it is possible to recreate the image he posted in his question. Although I haven't searched the web whether the equations for the above image are published somewhere, I will show how you can create such kind of image by pure inspection. By inspecting Mike's original image, one recognizes the following things: ...


78

This approach is based on a random walk of a shrinking disk. Several of these are combined and a Gaussian filter is used to smooth it out. Optionally the smoothed image can be multiplied by the original to restore the tiny "droplets" that are wiped out by the smoothing. There is a streakiness parameter which biases the random walk in a particular direction. ...


76

A simple algorithm that measures the distance of existing disks from a new, candidate disk, while decreasing radius size. The following two functions generate a random point in the unit disk and measures the distance to all existing disks. randomPoint = Compile[{{r, _Real}}, Module[ {u = RandomReal@{0, 1 - 2 r}, a = RandomReal@{0, 2 Pi}}, {Sqrt@u*Cos[...


74

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


74

========== update =========== Remember guys how we can cut out a snowflake from a sheet of paper carving 12th folded part? Like the image below. So I decided to write an app to imitate the process. It also can be used to make random snowflakes (similar to to @bill s' but with reflection to imitate real cutting paper process and reflective symmetry of ...


74

replacing RandomReal function in István's code with u = RandomVariate[UniformDistribution[{0,1 - ((1 - 2 min)/(max - min) (r - min) + 2 min)}]] leads to non-uniform distribution Randomization for the angle can also be non-uniform: randomPoint = Compile[{{r, _Real}}, Module[{u = RandomVariate[ UniformDistribution[{0, 1 ...


71

My original code was crashing when you used too many digits because apparently Mathematica can handle only so many different font sizes. To fix it, I had to borrow george2079's PDF trick to turn each character into a vectorised graphics primitive. I couldn't have solved this issue myself, so give his answer an upvote please. The rest of the code is still my ...


68

Edit: Added the reversal and some refinements ω = 1; posP[t_, φ_] := Sin[ω t + φ] {Cos[φ], Sin[φ]} posL[φ_] := {-#, #} &@{Cos[φ], Sin[φ]} Animate[ Graphics[{PointSize[0.02], Table[{Black, Line[posL[π i]], Hue[i], Point[posP[t, π i]]}, {i, 0, 1, 1/(3π-Abs[9.43-t])}] }, PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}} ], {t, 0, 6π, 0.2} ]


66

A rather crude way of accomplishing this is just to draw multiple shapes layered such that the rings interlock. ringSegment[mid_, deg_, color_] := { Thickness[0.05],CapForm["Butt"], White, Circle[mid, 1, deg], Thickness[0.03], RGBColor @@ (color/255), Circle[mid, 1, deg + {-0.1, 0.1}]} olblue = {0, 129, 188}; olyellow = {255, 177, 49}; olBlack = {...


66

Here is a start. I'm sure others will come up with better solutions, but I think from here it's mostly down to finding a better algorithm to pick the random lines. First, we get ourselves a Region representation of the text we want to stylise (thanks to yode for simplifying this part): textRegion = DiscretizeGraphics[ Text[Style["MUSEUM", FontFamily ->...


65

I'd like to expand on Quantum_Oli's answer to give an intuitive explanation for what's happening, because there's a neat geometric interpretation. At one point in the animation it looks like there is a circle of colored dots moving about the center, this is a special case of so called hypocycloids known as Cardano circles. A hypocyloid is a curve generated ...


64

Let's do it Andy's way So you are Andy. Nice to meet you. And you never got those hands on a computer. It doesn't matter, I will show you! First you need to go to Marilyn's place. Don't worry, JF isn't there right now. Ask her for a nice photograph and the negatives. i = ImageCrop@Import@"http://i.stack.imgur.com/W8hV5.png" Outstanding picture, good ...


63

For this one I've defined three types of layer, a flower, a simple circle and a ring of small circles. You could add more for greater variety. flower[n_, a_, r_] := Module[{b = RandomChoice[{-1/(2 n), 0}]}, Cases[ParametricPlot[ r (a + Cos[n t])/(a + 1) {Cos[t + b Sin[2 n t]], Sin[t + b Sin[2 n t]]}, {t, 0, 2 Pi}], l_Line :> FilledCurve[l], -1]] ...


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